1 package Equinox::Migration::SimpleTagList;
3 # Copyright 2009-2012, Equinox Software, Inc.
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
24 Equinox::Migration::SimpleTagList - Generate taglist from file
32 our $VERSION = '1.001';
37 Using a file as input, E::M::STL generates a set of MARC datafield
38 tags and provides several access mechanisms to that set.
40 use Equinox::Migration::SimpleTagList;
42 my $stl = Equinox::Migration::SimpleTagList->new( file => "trashtags.txt" );
43 my $tags = $stl->as_hashref;
47 my $stl = Equinox::Migration::SimpleTagList->new( file => "trashtags.txt" );
48 if ( $stl->has($foo) ) {
49 # if $foo is an element of $stl's parsed list
59 Takes one optional argument, C<file>. If this is speficied, the tag
60 list will be populated as per that file on instantiation.
62 Returns a E::M::STL object.
67 my ($class, %args) = @_;
69 my $self = bless { conf => { except => 0,
70 range => { high => 0, low => 0 },
77 $self->generate($args{file});
79 die "Can't open tags file '", $args{file}, "': $!\n";
82 $self->generate($args{str},'scalar');
92 Passed a data field tag, returns 1 if that tag is in the list and 0 if
95 When specifying tags under 100, they must be quoted if you wish to
96 include the leading zeroes
98 $stl->has('011'); # is equivalent to
101 or Perl will think you're passing a (possibly malformed) octal value.
105 sub has { my ($self, $t) = @_; return 0 unless $t; $t =~ s/^0+//; return (defined $self->{tags}{$t}) ? 1 : 0 }
109 Returns a hashref of the entire, assembled tag list.
113 sub as_hashref { my ($self) = @_; return $self->{tags} }
117 Returns a listref of the entire, assembled tag list (sorted
122 sub as_listref { my ($self) = @_; return [ sort {$a <=> $b} keys %{$self->{tags}} ] }
125 my ($self, $file, $scalar) = @_;
128 open TAGFILE, '<', \$file;
130 open TAGFILE, '<', $file;
136 $self->{conf}{lastwasrange} = 0;
137 $self->{conf}{range}{high} = 0;
138 $self->{conf}{range}{low} = 0;
140 my @chunks = split /\s+/;
141 while (my $chunk = shift @chunks) {
142 last if ($chunk =~ /^#/);
145 if ($chunk =~ /^\d{1,3}$/) {
146 $self->add_tag($chunk);
147 $self->{conf}{except} = 0;
152 if ($chunk =~ /^\d{1,3}\.\.\d{1,3}$/) {
153 $self->add_range($chunk);
154 $self->{conf}{except} = 0;
159 if ($chunk eq 'except') {
160 die "Keyword 'except' can only follow a range (line $.)\n"
161 unless $self->{conf}{lastwasrange};
162 $self->{conf}{except} = 1;
166 die "Unknown chunk $chunk in tags file (line $.)\n";
176 my ($self, $chunk) = @_;
177 my ($low,$high) = split /\.\./, $chunk;
181 die "Ranges must be 'low..high' ($low is greater than $high)\n"
183 if ($self->{conf}{except}) {
184 die "Exception ranges must be within last addition range ($low..$high)\n"
185 if ($low < $self->{conf}{range}{low} or $high > $self->{conf}{range}{high});
187 for my $tag ($low..$high) {
191 unless ($self->{conf}{except}) {
192 $self->{conf}{range}{high} = $high;
193 $self->{conf}{range}{low} = $low;
195 $self->{conf}{lastwasrange} = 1;
203 my ($self, $tag) = @_;
206 die "Values must be numeric\n" if ($tag =~ /[^\d\-]/);
208 die "Values must be valid tags (0-999)\n"
209 unless ($tag >= 0 and $tag <= 999);
211 if ($self->{conf}{except}) {
212 $self->remove_tag($tag);
214 die "Tag '$tag' specified twice\n"
215 if $self->{tags}{$tag};
216 $self->{tags}{$tag} = 1;
217 $self->{conf}{lastwasrange} = 0;
226 my ($self, $tag) = @_;
229 die "Tag '$tag' isn't in the list\n"
230 unless $self->{tags}{$tag};
231 delete $self->{tags}{$tag};
236 Shawn Boyette, C<< <sboyette at esilibrary.com> >>
240 Please report any bugs or feature requests to the above email address.
244 You can find documentation for this module with the perldoc command.
246 perldoc Equinox::Migration::SimpleTagList
249 =head1 COPYRIGHT & LICENSE
251 Copyright 2009 Equinox, all rights reserved.
253 This program is free software; you can redistribute it and/or modify it
254 under the same terms as Perl itself.
259 1; # End of Equinox::Migration::SimpleTagList