single-chunk tokens being quoted is ok now. misc other fixes

[migration-tools.git] / Equinox-Migration / lib / Equinox / Migration / SubfieldMapper.pm

diff --git a/Equinox-Migration/lib/Equinox/Migration/SubfieldMapper.pm b/Equinox-Migration/lib/Equinox/Migration/SubfieldMapper.pm
index 5071a85..cb8decd 100644 (file)
--- a/Equinox-Migration/lib/Equinox/Migration/SubfieldMapper.pm
+++ b/Equinox-Migration/lib/Equinox/Migration/SubfieldMapper.pm
@@ -9,11 +9,11 @@ Equinox::Migration::SubfieldMapper - Generate named-field to MARC tag map from f
 
 =head1 VERSION
 
-Version 1.000
+Version 1.004
 
 =cut
 
-our $VERSION = '1.000';
+our $VERSION = '1.004';
 
 
 =head1 SYNOPSIS
@@ -23,28 +23,17 @@ to arbitrary field names, and provides several access mechanisms to
 that set.
 
     use Equinox::Migration::SubfieldMapper;
-    
-    my $stl = Equinox::Migration::SubfieldMapper->new( file => ".txt" );
-    my $tags = $stl->as_hashref;
+    ...
 
-or
-
-    my $stl = Equinox::Migration::SubfieldMapper->new( file => ".txt" );
-    if ( $stl->has($foo) ) {
-        # if $foo is an element of $stl's parsed list
-        # do stuff ...
-    }
-
-
-=head1 ROUTINES
 
+=head1 METHODS
 
 =head2 new
 
 Takes one optional argument, C<file>. If this is speficied, the tag
 list will be populated as per that file on instantiation.
 
-Returns a E::M::STL object.
+Returns a E::M::SM object.
 
 =cut
 
@@ -55,6 +44,13 @@ sub new {
                        fields => {},
                        tags   => {} }, $class;
 
+    if ($args{mods}) {
+        die "Argument 'mods' is wrong type\n"
+          unless (ref $args{mods} eq "ARRAY");
+        for my $mod ( @{$args{mods}} )
+          { $self->{conf}{mods}{$mod} = 1 }
+    }
+
     if ($args{file}) {
         if (-r $args{file}) {
             $self->{conf}{file} = $args{file};
@@ -64,13 +60,6 @@ sub new {
         }
     }
 
-    if ($args{mods}) {
-        die "Argument 'mods' is wrong type\n"
-          unless (ref $args{mods} eq "ARRAY");
-        for my $mod ( @{$args{mods}} )
-          { $self->{conf}{mods}{$mod} = 1 }
-    }
-
     return $self;
 }
 
@@ -116,6 +105,44 @@ sub has {
     }
 }
 
+=head2 tags
+
+Returns an arrayref containing the tags defined in the map.
+
+    my $tags = $sfm->tags;
+    for my tag ( @{$tags} ) {
+        my $subs = $sfm->subfields($tag);
+        ...
+    }
+
+=cut
+
+sub tags {
+    my ($self) = @_;
+    return [ keys %{$self->{tags}} ];
+}
+
+=head2 subfields
+
+Given a tag, return an arrayref of the subfields mapped with that tag.
+
+    my $tags = $sfm->tags;
+    for my tag ( @{$tags} ) {
+        my $subs = $sfm->subfields($tag);
+        ...
+    }
+
+Returns C<undef> if C<tag> is not mapped.
+
+=cut
+
+sub subfields {
+    my ($self, $tag) = @_;
+    return undef unless $self->has($tag);
+    return [ keys %{$self->{tags}{$tag}} ];
+}
+
+
 =head2 field
 
 Given a tag and subfield code,
@@ -135,18 +162,29 @@ sub field {
 
 =head2 mods
 
-Returns the modifiers set on a mapping.
+With no argument, returns a hashref containing all modifiers for the entire map:
+
+    {
+      modifier => {
+                    tag => [ list_of subs ],
+                    ...
+                  },
+      ...
+    }
+
+Given a fieldname, returns a hashref of the modifiers set on that mapping.
 
     $self->mods('fieldname')
 
-If there are no modifiers, C<undef> will be returned. Else a listref
-will be returned.
+Returns undef is nothing is defined.
 
 =cut
 
 sub mods {
     my ($self, $field) = @_;
+    return $self->{allmods} unless defined $field;
     return undef unless $self->has($field);
+    return undef unless (%{ $self->{fields}{$field}{mods} });
     return $self->{fields}{$field}{mods};
 }
 
@@ -164,10 +202,13 @@ will be returned.
 sub filters {
     my ($self, $field) = @_;
     return undef unless $self->has($field);
+    return undef unless ($self->{fields}{$field}{filt});
     return $self->{fields}{$field}{filt};
 }
 
+=head1 MAP CONSTRUCTION METHODS
 
+These methods are not generally accessed from user code.
 
 =head2 generate
 
@@ -191,11 +232,11 @@ sub generate {
         $map->{tag}   = shift @tokens;
         while (my $tok = shift @tokens) {
             last if ($tok =~ m/^#/);
-            if ($tok =~ m/^[a-z]:'/) {
+            if ($tok =~ m/^[a-z]:'/ and $tok !~ /'$/) {
                 $tok .= ' ' . shift @tokens
                   until ($tokens[0] =~ m/'$/);
                 $tok .= ' ' . shift @tokens;
-                $tok =~ s/'//;
+                $tok =~ s/^'//;
                 $tok =~ s/'$//;
             }
             if ($tok =~ m/^m:/)
@@ -232,15 +273,16 @@ sub add {
     my ($self, $map) = @_;
 
     # trim the mods and filters
-    my $mods = []; my %mods = ();
+    my $mods = {};
     my $filt = []; my %filt = ();
     for my $m (@{$map->{mods}}) {
-        die "Modifier collision '$m' at line $." if $mods{$m};
+        die "Modifier collision '$m' at line $." if $mods->{$m};
         $m =~ s/^m://;
-        push @{$mods}, $m; $mods{$m} = 1;
+        $mods->{$m} = 1;
+        push @{$self->{allmods}{$m}{ $map->{tag} }}, $map->{sub};
     }
     for my $f (@{$map->{filt}}) {
-        die "Modifier collision '$f' at line $." if $filt{$f};
+        die "Filter collision '$f' at line $." if $filt{$f};
         $f =~ s/^f://;
         push @{$filt}, $f; $filt{$f} = 1;
     }
@@ -295,7 +337,7 @@ sub validate {
 
     # test mod names if we have a set to check against
     if (defined $self->{conf}{mods}) {
-        for my $mod ( @{$map->{mods}} ) {
+        for my $mod ( keys %{$map->{mods}} ) {
             die "Modifier '$mod' not allowed\n"
               unless $self->{conf}{mods}{$mod};
         }