From 2c1a0eff7bc0ae19b91f43fce329298fbe1826f5 Mon Sep 17 00:00:00 2001 From: Shawn Boyette Date: Wed, 18 Mar 2009 16:40:30 +0000 Subject: [PATCH] testing and fixes --- Equinox-Migration/Changes | 5 +- Equinox-Migration/MANIFEST | 1 + .../lib/Equinox/Migration/SimpleTagList.pm | 95 +++++++++++++------- Equinox-Migration/t/01-SimpleTagList.t | 44 +++++++++ Equinox-Migration/t/corpus/stl-0.txt | 8 ++ 5 files changed, 117 insertions(+), 36 deletions(-) create mode 100644 Equinox-Migration/t/01-SimpleTagList.t create mode 100644 Equinox-Migration/t/corpus/stl-0.txt diff --git a/Equinox-Migration/Changes b/Equinox-Migration/Changes index 0a0ada6..420574c 100644 --- a/Equinox-Migration/Changes +++ b/Equinox-Migration/Changes @@ -1,5 +1,4 @@ Revision history for Equinox-Migration -0.01 Date/time - First version, released on an unsuspecting world. - +1.000 2009-03-17 + First version, E::M::STL diff --git a/Equinox-Migration/MANIFEST b/Equinox-Migration/MANIFEST index 8c98c80..12f6aff 100644 --- a/Equinox-Migration/MANIFEST +++ b/Equinox-Migration/MANIFEST @@ -3,6 +3,7 @@ MANIFEST Makefile.PL README lib/Equinox/Migration.pm +lib/Equinox/Migration/SimpleTagList.pm t/00-load.t t/pod-coverage.t t/pod.t diff --git a/Equinox-Migration/lib/Equinox/Migration/SimpleTagList.pm b/Equinox-Migration/lib/Equinox/Migration/SimpleTagList.pm index 0fd50db..301094b 100644 --- a/Equinox-Migration/lib/Equinox/Migration/SimpleTagList.pm +++ b/Equinox-Migration/lib/Equinox/Migration/SimpleTagList.pm @@ -18,9 +18,8 @@ our $VERSION = '1.000'; =head1 SYNOPSIS -Using a file as input, E::M::STL generates a set of MARC tags -(three-digit, zero-padded integers) and provides several access -mechanisms to that list. +Using a file as input, E::M::STL generates a set of MARC datafield +tags and provides several access mechanisms to that set. use Equinox::Migration::SimpleTagList; @@ -41,26 +40,31 @@ or =head2 new -Takes one argument, C, which is mandatory. Returns a E::M::STL -object. +Takes one argument, optional argument, C. If this is speficied, +the tag list will be populated as per that file on instantiation. + +Returns a E::M::STL object. =cut sub new { - my ($class,%args) = @_; + my ($class, %args) = @_; my $self = bless { conf => { except => 0, - range => { high => 0, low => 0 }, + range => { high => 0, low => 0 }, + lastwasrange => 0, }, tags => {} }, $class; - if (-r $args{file}) { - $self->{conf}{file} = $args{file} - } else { - die "Can't open tags file: $!\n"; + if ($args{file}) { + if (-r $args{file}) { + $self->{conf}{file} = $args{file}; + $self->generate; + } else { + die "Can't open tags file: $!\n"; + } } - $self->generate; return $self; } @@ -71,9 +75,17 @@ sub new { Passed a data field tag, returns 1 if that tag is in the list and 0 if it is not. +When specifying tags under 100, they must be quoted if you wish to +include the leading zeroes + + $stl->has('011'); # is equivalent to + $stl->has(11); + +or Perl will think you're passing a (possibly malformed) octal value. + =cut -sub has { my ($self, $t) = @_; return (defined $self->{tags}{$t}) ? 1 : 0 } +sub has { my ($self, $t) = @_; $t =~ s/^0+//; return (defined $self->{tags}{$t}) ? 1 : 0 } =head2 as_hashref @@ -85,20 +97,21 @@ sub as_hashref { my ($self) = @_; return $self->{tags} } =head2 as_hashref -Returns a listref of the entire, assembled tag list. +Returns a listref of the entire, assembled tag list (sorted +numerically by tag). =cut -sub as_listref { my ($self) = @_; return \(keys %{$self->{tags}}) } +sub as_listref { my ($self) = @_; return [ sort {$a <=> $b} keys %{$self->{tags}} ] } sub generate { my ($self) = @_; open TAGFILE, '<', $self->{conf}{file}; while () { - my $lastwasrange = 0; - $self->{conf}{range}{high} = 0; - $self->{conf}{range}{low} = 0; + $self->{conf}{lastwasrange} = 0; + $self->{conf}{range}{high} = 0; + $self->{conf}{range}{low} = 0; $self->{conf}{except} = 0; my @chunks = split /\s+/; @@ -107,28 +120,22 @@ sub generate { # single values if ($chunk =~ /^\d{1,3}$/) { $self->add_tag($chunk); - $lastwasrange = 0; next; } # ranges if ($chunk =~ /^\d{1,3}\.\.\d{1,3}$/) { - my ($low, $high) = $self->add_range($chunk); - $lastwasrange = 1; - unless ($self->{conf}{except}) { - $self->{conf}{range}{high} = $high; - $self->{conf}{range}{low} = $low; - } + $self->add_range($chunk); next; } # 'except' if ($chunk eq 'except') { die "Keyword 'except' can only follow a range (line $.)\n" - unless $lastwasrange; + unless $self->{conf}{lastwasrange}; die "Keyword 'except' may only occur once per line (line $.)\n" if $self->{conf}{except}; - $$self->{conf}{except} = 1; + $self->{conf}{except} = 1; next; } @@ -144,16 +151,24 @@ sub generate { sub add_range { my ($self, $chunk) = @_; my ($low,$high) = split /\.\./, $chunk; - die "Ranges must be 'low..high' ($low is greater than $high on line $.)\n" + $low =~ s/^0+//; + $high =~ s/^0+//; + + die "Ranges must be 'low..high' ($low is greater than $high)\n" if ($low > $high); if ($self->{conf}{except}) { - die "Exception ranges must be within last addition range (line $.)\n" + die "Exception ranges must be within last addition range ($low..$high)\n" if ($low < $self->{range}{low} or $high > $self->{range}{high}); } for my $tag ($low..$high) { $self->add_tag($tag) } - return $low, $high; + + unless ($self->{conf}{except}) { + $self->{conf}{range}{high} = $high; + $self->{conf}{range}{low} = $low; + } + $self->{conf}{lastwasrange} = 1; } =head2 add_tag @@ -162,19 +177,33 @@ sub add_range { sub add_tag { my ($self, $tag) = @_; + $tag =~ s/^0+//; - die "Values must be valid tags (000-999)\n" + die "Values must be valid tags (0-999)\n" unless ($tag >= 0 and $tag <= 999); if ($self->{conf}{except}) { - delete $self->{tags}{$tag}; + $self->remove_tag($tag) } else { - die "Trash tag '$tag' specified twice (line $.)\n" + die "Tag '$tag' specified twice\n" if $self->{tags}{$tag}; $self->{tags}{$tag} = 1; } + $self->{conf}{lastwasrange} = 0; } +=head2 remove_tag + +=cut + +sub remove_tag { + my ($self, $tag) = @_; + $tag =~ s/^0+//; + + die "Tag '$tag' isn't in the list\n" + unless $self->{tags}{$tag}; + delete $self->{tags}{$tag}; +} =head1 AUTHOR diff --git a/Equinox-Migration/t/01-SimpleTagList.t b/Equinox-Migration/t/01-SimpleTagList.t new file mode 100644 index 0000000..0e8c2d9 --- /dev/null +++ b/Equinox-Migration/t/01-SimpleTagList.t @@ -0,0 +1,44 @@ +#!perl -T + +use Test::More tests => 25; +use Equinox::Migration::SimpleTagList; + +# baseline object creation +my $stl = Equinox::Migration::SimpleTagList->new(); +is(ref $stl, "Equinox::Migration::SimpleTagList", "self is self"); + +# manual adds and removes +$stl->add_tag(89); +is ($stl->has(89), 1, 'can has tag'); +is ($stl->has(904), 0, 'can not has tag'); +$stl->add_tag(904); +is ($stl->has(904), 1, 'can has tag'); +$stl->remove_tag(904); +is ($stl->has(904), 0, 'can not has tag'); + +# range addition, as_hashref, as_listref +$stl->add_range("198..201"); +is_deeply ($stl->as_hashref, { 89 => 1, 198 => 1, 199 => 1, 200 => 1, 201 => 1 }); +is_deeply ($stl->as_listref, [ 89, 198, 199, 200, 201 ]); +$stl->add_range("008..011"); +is_deeply ($stl->as_listref, [ 8, 9, 10, 11, 89, 198, 199, 200, 201 ]); + +# creation with file +$stl = Equinox::Migration::SimpleTagList->new( file => "./t/corpus/stl-0.txt"); +is ($stl->has(11), 1); +is ($stl->has('011'), 1); +is ($stl->has(12), 1); +is ($stl->has('012'), 1); +is ($stl->has(241), 1); +is ($stl->has(359), 1); +is ($stl->has(652), 1); +is ($stl->has(654), 1); +is ($stl->has(656), 1); +is ($stl->has(658), 1); +is ($stl->has(872), 1); +is ($stl->has(900), 1); +is ($stl->has(999), 1); +is ($stl->has(988), 1); +is ($stl->has(655), 0, 'exception'); +is ($stl->has(987), 0, 'exception'); +is ($stl->has(400), 0, 'not in input set'); diff --git a/Equinox-Migration/t/corpus/stl-0.txt b/Equinox-Migration/t/corpus/stl-0.txt new file mode 100644 index 0000000..57ae957 --- /dev/null +++ b/Equinox-Migration/t/corpus/stl-0.txt @@ -0,0 +1,8 @@ +011 012 016 061 069 071 096 098 +212 214 241 263 +350 359 +652..658 except 655 +696..699 +720 755 796..799 +850 852 870..879 886 890 896..899 +900..999 except 935 987 994 -- 1.7.2.5