r1590@llin: dpavlin | 2007-11-11 14:47:42 +0100

 finally marc_template( ... isis_template => [] ) works

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

diff --git a/lib/WebPAC/Normalize/MARC.pm b/lib/WebPAC/Normalize/MARC.pm
index b931f45..90271be 100644 (file)
--- a/lib/WebPAC/Normalize/MARC.pm
+++ b/lib/WebPAC/Normalize/MARC.pm
@@ -42,6 +42,8 @@ WebPAC::Normalize::MARC - create MARC/ISO2709 records
                ],
        );
 
+Returns number of records produced.
+
 =cut
 
 sub marc_template {
@@ -80,17 +82,15 @@ sub marc_template {
 
        our $_template;
 
-       $_template->{fields_re} = {
-               isis => join('|', keys %$from_subfields ),
-               marc => join('|', keys %$to_subfields ),
-       };
+       $_template->{isis}->{fields_re} = join('|', keys %$from_subfields );
+       $_template->{marc}->{fields_re} = join('|', keys %$to_subfields );
 
        my @marc_out;
 
        sub _parse_template {
                my ( $name, $templates ) = @_;
 
-               my $fields_re = $_template->{fields_re}->{ $name } || die "can't find $name in ",dump( $_template->{fields_re} );
+               my $fields_re = $_template->{$name}->{fields_re} || die "can't find $name in ",dump( $_template->{$name}->{fields_re} );
 
                foreach my $template ( @{ $templates } ) {
                        our $count = {};
@@ -125,7 +125,7 @@ sub marc_template {
 
                warn "### r = ",dump( $r );
 
-               my ( $new_r, $from_count, $to_count );
+               my ( $from_mapping, $to_mapping, $from_count, $to_count );
                foreach my $sf ( keys %{$r} ) {
                        # skip everything which isn't one char subfield (e.g. 'subfields')
                        next unless $sf =~ m/^\w$/;
@@ -134,12 +134,13 @@ sub marc_template {
                                die "can't find subfield rename for $sf/$nr in ", dump( $subfields_rename );
                        warn "### rename $sf/$nr to ", dump( $rename_to->[$nr] ), $/;
                        my ( $to_sf, $to_nr ) = @{ $rename_to->[$nr] };
-                       $new_r->{ $to_sf }->[ $to_nr ] = [ $sf => $nr ];
+                       $from_mapping->{ $sf }->[ $nr ] = [ $to_sf => $to_nr ];
+                       $to_mapping->{ $to_sf }->[ $to_nr ] = [ $sf => $nr ];
 
                        $to_count->{ $to_sf }++;
                }
 
-               warn "### new_r = ",dump( $new_r );
+               warn "### to_mapping = ",dump( $to_mapping );
 
                my $count_key = {
                        from => dump( $from_count ),
@@ -153,14 +154,13 @@ sub marc_template {
                # this defines order of traversal
                foreach ( qw/isis:from marc:to/ ) {
                        my ($name,$count_name) = split(/:/);
-                       warn "## traverse $name $count_name\n";
 
                        my $ckey = $count_key->{$count_name} || die "can't find count_key $count_name in ",dump( $count_key );
 
                        my $template = $_template->{$name}->{pos}->{ $ckey } || next;
                        $processed_templates++;
 
-                       warn "### selected template: |$template|\n";
+                       warn "### traverse $name $count_name selected template: |$template|\n";
 
                        our $fill_in = {};
 
@@ -172,7 +172,7 @@ sub marc_template {
                                        my ( $name, $r, $sf, $nr ) = @_;
                                        my ( $from_sf, $from_nr, $v );
                                        if ( $name eq 'marc' ) {
-                                               ( $from_sf, $from_nr ) = @{ $new_r->{$sf}->[$nr] };
+                                               ( $from_sf, $from_nr ) = @{ $to_mapping->{$sf}->[$nr] };
                                        } else {
                                                ( $from_sf, $from_nr ) = ( $sf, $nr );
                                        }
@@ -188,7 +188,7 @@ sub marc_template {
                                                die "requested subfield $from_sf/$from_nr but it's ",dump( $v );
                                        }
                                }
-                               my $fields_re = $_template->{fields_re}->{ $name } || die "can't find $name in ",dump( $_template->{fields_re} );
+                               my $fields_re = $_template->{$name}->{fields_re} || die "can't find $name in ",dump( $_template->{$name}->{fields_re} );
                                warn "#### $sf <<<< $fields_re\n";
                                $sf =~ s/($fields_re)(\d+)/fill_in($name,$r,$1,$2)/ge;
                                warn "#### >>>> $sf with fill_in = ",dump( $fill_in ),$/;
@@ -196,11 +196,12 @@ sub marc_template {
 
                        warn "## template: |$template|\n## _template->$name = ",dump( $_template->{$name} );
 
-                       $sf_pos = $#m;
-
                        foreach my $sf ( @{ $_template->{$name}->{order}->{$template} } ) {
                                my ( $sf, $nr ) = @$sf;
                                my $v = $fill_in->{$sf}->[$nr] || die "can't find fill_in $sf/$nr";
+                               if ( $name eq 'isis') {
+                                       ( $sf, $nr ) = @{ $from_mapping->{$sf}->[$nr] };
+                               }
                                warn "++ $sf/$nr |$v|\n";
                                push @$m, ( $sf, $v );
                        }
@@ -215,12 +216,15 @@ sub marc_template {
        }
 
 
-       warn "### marc_template produced following MARC records: ",dump( @marc_out );
+       my $recs = 0;
 
        foreach my $marc ( @marc_out ) {
-               warn "+++ ",dump( $marc );
+               warn "+++ ",dump( $marc ),$/;
                WebPAC::Normalize::_marc_push( $marc );
+               $recs++;
        }
+
+       warn "### marc_template produced $recs MARC records: ",dump( @marc_out ), $/;
 }
 
 1;

diff --git a/t/3-normalize-marc.t b/t/3-normalize-marc.t
index 4d720ab..5d3b62e 100755 (executable)
--- a/t/3-normalize-marc.t
+++ b/t/3-normalize-marc.t
@@ -3,7 +3,7 @@
 use strict;
 use blib;
 
-use Test::More tests => 4;
+use Test::More tests => 7;
 
 BEGIN {
        use_ok( 'WebPAC::Test' );
@@ -33,13 +33,15 @@ my $rec = {
                'i' => 'i-4-1',
                'w' => 'w-4-1',
        },{
-               'a' => 'a-4-1',
-               'v' => 'v-4-1',
-               'i' => 'i-4-1',
+               'a' => 'a-5-1',
+               'v' => 'v-5-1',
+               'i' => 'i-5-1',
        },{
-               'a' => 'a-4-1',
-               'i' => 'i-4-1',
-               'w' => 'w-4-1',
+               'a' => 'a-6-1',
+               'i' => 'i-6-1',
+               'w' => 'w-6-1',
+       },{
+               'a' => 'a-7-1',
        }],
 };
 
@@ -72,9 +74,11 @@ diag 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", "p", "i-2-1", "v", "v-2-1"],
-               [440, " ", " ", "a", "a-3-1", "p", "i-3-1", "v", "v-3-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"],
+               [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');