Equinox-Migration/lib/Equinox/Migration/SimpleTagList.pm

   1 package Equinox::Migration::SimpleTagList;
   2
   3 use warnings;
   4 use strict;
   5
   6 =head1 NAME
   7
   8 Equinox::Migration::SimpleTagList - Generate taglist from file
   9
  10 =head1 VERSION
  11
  12 Version 1.000
  13
  14 =cut
  15
  16 our $VERSION = '1.000';
  17
  18
  19 =head1 SYNOPSIS
  20
  21 Using a file as input, E::M::STL generates a set of MARC tags
  22 (three-digit, zero-padded integers) and provides several access
  23 mechanisms to that list.
  24
  25     use Equinox::Migration::SimpleTagList;
  26
  27     my $stl = Equinox::Migration::SimpleTagList->new( file => "trashtags.txt" );
  28     my $tags = $stl->as_hashref;
  29
  30 or
  31
  32     my $stl = Equinox::Migration::SimpleTagList->new( file => "trashtags.txt" );
  33     if ( $stl->has($foo) ) {
  34         # if $foo is an element of $stl's parsed list
  35         # do stuff ...
  36     }
  37
  38
  39 =head1 ROUTINES
  40
  41
  42 =head2 new
  43
  44 Takes one argument, C<file>, which is mandatory. Returns a E::M::STL
  45 object.
  46
  47 =cut
  48
  49 sub new {
  50     my ($class,%args) = @_;
  51
  52     my $self = bless { conf => { except => 0,
  53                                  range => { high => 0, low => 0 },
  54                                },
  55                        tags => {} }, $class;
  56
  57     if (-r $args{file}) {
  58         $self->{conf}{file} = $args{file}
  59     } else {
  60         die "Can't open tags file: $!\n";
  61     }
  62
  63     $self->generate;
  64     return $self;
  65 }
  66
  67
  68
  69 =head2 has
  70
  71 Passed a data field tag, returns 1 if that tag is in the list and 0 if
  72 it is not.
  73
  74 =cut
  75
  76 sub has { my ($self, $t) = @_; return (defined $self->{tags}{$t}) ? 1 : 0 }
  77
  78 =head2 as_hashref
  79
  80 Returns a hashref of the entire, assembled tag list.
  81
  82 =cut
  83
  84 sub as_hashref { my ($self) = @_; return $self->{tags} }
  85
  86 =head2 as_hashref
  87
  88 Returns a listref of the entire, assembled tag list.
  89
  90 =cut
  91
  92 sub as_listref { my ($self) = @_; return \(keys %{$self->{tags}}) }
  93
  94 sub generate {
  95     my ($self) = @_;
  96
  97     open TAGFILE, '<', $self->{conf}{file};
  98     while (<TAGFILE>) {
  99         my $lastwasrange = 0;
 100         $self->{conf}{range}{high} = 0;
 101         $self->{conf}{range}{low}  = 0;
 102         $self->{conf}{except} = 0;
 103
 104         my @chunks = split /\s+/;
 105         while (my $chunk = shift @chunks) {
 106
 107             # single values
 108             if ($chunk =~ /^\d{1,3}$/) {
 109                 $self->add_tag($chunk);
 110                 $lastwasrange = 0;
 111                 next;
 112             }
 113
 114             # ranges
 115             if ($chunk =~ /^\d{1,3}\.\.\d{1,3}$/) {
 116                 my ($low, $high) = $self->add_range($chunk);
 117                 $lastwasrange = 1;
 118                 unless ($self->{conf}{except}) {
 119                     $self->{conf}{range}{high} = $high;
 120                     $self->{conf}{range}{low}  = $low;
 121                 }
 122                 next;
 123             }
 124
 125             # 'except'
 126             if ($chunk eq 'except') {
 127                 die "Keyword 'except' can only follow a range (line $.)\n"
 128                   unless $lastwasrange;
 129                 die "Keyword 'except' may only occur once per line (line $.)\n"
 130                   if $self->{conf}{except};
 131                 $$self->{conf}{except} = 1;
 132                 next;
 133             }
 134
 135             die "Unknown chunk $chunk in tags file (line $.)\n";
 136         }
 137     }
 138 }
 139
 140 =head2 add_range
 141
 142 =cut
 143
 144 sub add_range {
 145     my ($self, $chunk) = @_;
 146     my ($low,$high) = split /\.\./, $chunk;
 147     die "Ranges must be 'low..high' ($low is greater than $high on line $.)\n"
 148       if ($low > $high);
 149     if ($self->{conf}{except}) {
 150         die "Exception ranges must be within last addition range (line $.)\n"
 151           if ($low < $self->{range}{low} or $high > $self->{range}{high});
 152     }
 153     for my $tag ($low..$high) {
 154         $self->add_tag($tag)
 155     }
 156     return $low, $high;
 157 }
 158
 159 =head2 add_tag
 160
 161 =cut
 162
 163 sub add_tag {
 164     my ($self, $tag) = @_;
 165
 166     die "Values must be valid tags (000-999)\n"
 167       unless ($tag >= 0 and $tag <= 999);
 168
 169     if ($self->{conf}{except}) {
 170         delete $self->{tags}{$tag};
 171     } else {
 172         die "Trash tag '$tag' specified twice (line $.)\n"
 173           if $self->{tags}{$tag};
 174         $self->{tags}{$tag} = 1;
 175     }
 176 }
 177
 178
 179 =head1 AUTHOR
 180
 181 Shawn Boyette, C<< <sboyette at esilibrary.com> >>
 182
 183 =head1 TODO
 184
 185 =over
 186
 187 =item * Remove single-except rule?
 188
 189 =back
 190
 191 =head1 BUGS
 192
 193 Please report any bugs or feature requests to the above email address.
 194
 195 =head1 SUPPORT
 196
 197 You can find documentation for this module with the perldoc command.
 198
 199     perldoc Equinox::Migration::TrashTags
 200
 201
 202 =head1 COPYRIGHT & LICENSE
 203
 204 Copyright 2009 Shawn Boyette, all rights reserved.
 205
 206 This program is free software; you can redistribute it and/or modify it
 207 under the same terms as Perl itself.
 208
 209
 210 =cut
 211
 212 1; # End of Equinox::Migration::SimpleTagList