r1600@llin: dpavlin | 2007-11-11 20:59:01 +0100

 added pre and post formatting, which was half of the reason for whole thing :-)

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@1031 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/lib/WebPAC/Normalize/MARC.pm b/lib/WebPAC/Normalize/MARC.pm
index 56fdd3b..cbc705e 100644 (file)
--- a/lib/WebPAC/Normalize/MARC.pm
+++ b/lib/WebPAC/Normalize/MARC.pm
@@ -12,7 +12,7 @@ use Carp qw/confess/;
 
 use WebPAC::Normalize;
 
-my $debug = 1;
+my $debug = 0;
 
 =head1 NAME
 
@@ -164,16 +164,19 @@ sub marc_template {
                        my $template = $_template->{$name}->{pos}->{ $ckey } || next;
                        $processed_templates++;
 
-                       warn "### traverse $name $count_name selected template: |$template|\n",$/ if $debug;
+                       warn "### traverse $name $count_name selected template: |$template|\n" if $debug;
 
                        our $fill_in = {};
 
                        my @templates = split(/\|/, $template );
-                       @templates = ( $template );
+                       @templates = ( $template ) unless @templates;
+
+                       warn "### templates = ",dump( @templates );
 
                        foreach my $sf ( @templates ) {
                                sub fill_in {
-                                       my ( $name, $r, $sf, $nr ) = @_;
+                                       my ( $name, $r, $pre, $sf, $nr, $post ) = @_;
+                                       warn "#### fill_in( $name, r, '$pre', $sf, $nr, '$post' )\n" if $debug;
                                        my ( $from_sf, $from_nr );
                                        if ( $name eq 'marc' ) {
                                                die "no $sf/$nr in to_mapping: ",dump( $to_mapping ), " form record ",dump( $r ) unless defined $to_mapping->{$sf}->[$nr];
@@ -182,20 +185,20 @@ sub marc_template {
                                                ( $from_sf, $from_nr ) = ( $sf, $nr );
                                        }
                                        my $v = $r->{ $from_sf }; # || die "no $from_sf/$from_nr";
-                                       warn "#### fill_in( $sf, $nr ) = $from_sf/$from_nr >>>> ",dump( $v ),$/ if $debug;
                                        if ( ref( $v ) eq 'ARRAY' ) {
-                                               $fill_in->{$sf}->[$nr] = $v->[$from_nr];
-                                               return $v->[$from_nr];
+                                               $v = $pre . $v->[$from_nr] . $post;
                                        } elsif ( $from_nr == 0 ) {
-                                               $fill_in->{$sf}->[$nr] = $v;
-                                               return $v;
+                                               $v = $pre . $v . $post;
                                        } else {
                                                die "requested subfield $from_sf/$from_nr but it's ",dump( $v );
                                        }
+                                       warn "#### fill_in( $sf, $nr ) = $from_sf/$from_nr >>>> ",dump( $v ),$/ if $debug;
+                                       $fill_in->{$sf}->[$nr] = $v;
+                                       return $v;
                                }
                                my $fields_re = $_template->{$name}->{fields_re} || die "can't find $name in ",dump( $_template->{$name}->{fields_re} );
-                               warn "#### $sf <<<< $fields_re\n",$/ if $debug;
-                               $sf =~ s/($fields_re)(\d+)/fill_in($name,$r,$1,$2)/ge;
+                               warn "#### $sf <<<< $fields_re\n" if $debug;
+                               $sf =~ s/^(.*?)($fields_re)(\d+)(.*?)$/fill_in($name,$r,$1,$2,$3,$4)/ge;
                                warn "#### >>>> $sf with fill_in = ",dump( $fill_in ),$/ if $debug;
                        }
 

diff --git a/t/3-normalize-marc.t b/t/3-normalize-marc.t
index 1c79dc3..a636b91 100755 (executable)
--- a/t/3-normalize-marc.t
+++ b/t/3-normalize-marc.t
@@ -77,16 +77,16 @@ ok( marc_template(
 ), 'marc_template' );
 
 ok(my $marc = WebPAC::Normalize::_get_marc_fields(), "_get_marc_fields");
-diag dump( $marc ) if $debug;
+diag " _get_marc_fields = ",dump( $marc ) if $debug;
 
-is_deeply( $marc,
-       [
-               [440, " ", " ", "a", "a-1-1", "x", "x-1-1", "v", "v-1-1", "n", "h-1-1", "p", "i-1-1", "v", "w-1-1", ],
-               [440, " ", " ", "a", "a-2-1", "v", "v-2-1", "p", "i-2-1"],
-               [440, " ", " ", "a", "a-3-1", "v", "v-3-1", "p", "i-3-1"],
-               [440, " ", " ", "a", "a-4-1", "v", "v-4-1", "p", "i-4-1", "v", "w-4-1"],
-               [440, " ", " ", "a", "a-5-1", "v", "v-5-1", "p", "i-5-1"],
-               [440, " ", " ", "a", "a-6-1", "p", "i-6-1", "v", "w-6-1"],
-               [440, " ", " ", "a", "a-7-1"],
-       ],
-'is_deeply');
+is_deeply( $marc, [
+       [440, " ", " ", "a", "a-1-1, ", "x", "x-1-1 ; ", "v", "v-1-1. ", "n", "h-1-1, ", "p", "i-1-1 ; ", "v", "w-1-1"],
+       [440, " ", " ", "v", "v-9-1"],
+       [440, " ", " ", "a", "a-2-1 ; ", "v", "v-2-1. ", "p", "i-2-1"],
+       [440, " ", " ", "a", "a-3-1 ; ", "v", "v-3-1. ", "p", "i-3-1"],
+       [440, " ", " ", "a", "a-4-1 ; ", "v", "v-4-1. ", "p", "i-4-1 ; ", "v", "w-4-1"],
+       [440, " ", " ", "a", "a-5-1 ; ", "v", "v-5-1. ", "p", "i-5-1"],
+       [440, " ", " ", "a", "a-6-1. ", "p", "i-6-1 ; ", "v", "w-6-1"],
+       [440, " ", " ", "a", "a-7-1"],
+       [440, " ", " ", "a", "a-8-1 ;", "v", "v-8-1"],
+], 'is_deeply');