more tweaks for subfield re-ordering

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

diff --git a/lib/WebPAC/Normalize/MARC.pm b/lib/WebPAC/Normalize/MARC.pm
index cafd045..56fdd3b 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;
 
 
 use WebPAC::Normalize;
 

-my $debug = 0;
+my $debug = 1;

 
 =head1 NAME
 
 
 =head1 NAME
 


@@ -70,7 +70,8 @@ sub marc_template {
        confess "need mapping in pairs for subfields_rename"
                if $#subfields_rename % 2 != 1;
        
        confess "need mapping in pairs for subfields_rename"
                if $#subfields_rename % 2 != 1;
        

-       my ( $subfields_rename, $from_subfields, $to_subfields );
+       my ( $subfields_rename, $from_subfields );
+       our $to_subfields = {};

        while ( my ( $from, $to ) = splice(@subfields_rename, 0, 2) ) {
                my ( $f, $t ) = (
                        $from_subfields->{ $from }++,
        while ( my ( $from, $to ) = splice(@subfields_rename, 0, 2) ) {
                my ( $f, $t ) = (
                        $from_subfields->{ $from }++,


@@ -128,21 +129,22 @@ sub marc_template {
                warn "### r = ",dump( $r ),$/ if $debug;
 
                my ( $from_mapping, $to_mapping, $from_count, $to_count );
                warn "### r = ",dump( $r ),$/ if $debug;
 
                my ( $from_mapping, $to_mapping, $from_count, $to_count );

-               foreach my $sf ( keys %{$r} ) {
+               foreach my $from_sf ( keys %{$r} ) {

                        # skip everything which isn't one char subfield (e.g. 'subfields')
                        # skip everything which isn't one char subfield (e.g. 'subfields')

-                       next unless $sf =~ m/^\w$/;
-                       my $nr = $from_count->{$sf}++;
-                       my $rename_to = $subfields_rename->{ $sf } ||
-                               die "can't find subfield rename for $sf/$nr in ", dump( $subfields_rename );
-                       warn "### rename $sf/$nr to ", dump( $rename_to->[$nr] ),$/ if $debug;
-                       my ( $to_sf, $to_nr ) = @{ $rename_to->[$nr] };
-                       $from_mapping->{ $sf }->[ $nr ] = [ $to_sf => $to_nr ];
-                       $to_mapping->{ $to_sf }->[ $to_nr ] = [ $sf => $nr ];
-
-                       $to_count->{ $to_sf }++;
+                       next unless $from_sf =~ m/^\w$/;
+                       my $from_nr = $from_count->{$from_sf}++;
+                       my $rename_to = $subfields_rename->{ $from_sf } ||
+                               die "can't find subfield rename for $from_sf/$from_nr in ", dump( $subfields_rename );
+                       my ( $to_sf, $to_nr ) = @{ $rename_to->[$from_nr] };
+                       $to_mapping->{ $to_sf }->[ $to_nr ] = [ $from_sf => $from_nr ];
+
+                       my $to_nr2 = $to_count->{ $to_sf }++;
+                       $from_mapping->{ $from_sf }->[ $from_nr ] = [ $to_sf => $to_nr2 ];
+
+                       warn "### from $from_sf/$from_nr -> $to_sf/$to_nr\tto $from_sf/$from_nr -> $to_sf/$to_nr2\n" if $debug;

                }
 
                }
 

-               warn "### to_mapping = ",dump( $to_mapping ),$/ if $debug;
+               warn "### from_mapping = ",dump( $from_mapping ), "\n### to_mapping = ",dump( $to_mapping ),$/ if $debug;

 
                my $count_key = {
                        from => dump( $from_count ),
 
                my $count_key = {
                        from => dump( $from_count ),


@@ -174,6 +176,7 @@ sub marc_template {
                                        my ( $name, $r, $sf, $nr ) = @_;
                                        my ( $from_sf, $from_nr );
                                        if ( $name eq 'marc' ) {
                                        my ( $name, $r, $sf, $nr ) = @_;
                                        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];

                                                ( $from_sf, $from_nr ) = @{ $to_mapping->{$sf}->[$nr] };
                                        } else {
                                                ( $from_sf, $from_nr ) = ( $sf, $nr );
                                                ( $from_sf, $from_nr ) = @{ $to_mapping->{$sf}->[$nr] };
                                        } else {
                                                ( $from_sf, $from_nr ) = ( $sf, $nr );


@@ -211,6 +214,8 @@ sub marc_template {
                        warn "#### >>>> created MARC record: ", dump( $m ),$/ if $debug;
 
                        push @marc_out, $m;
                        warn "#### >>>> created MARC record: ", dump( $m ),$/ if $debug;
 
                        push @marc_out, $m;

+
+                       last;

                }
        
                die "I don't have template for fields ",dump( $count_key ), "\n## available templates\n", dump( $_template ) unless $processed_templates;
                }
        
                die "I don't have template for fields ",dump( $count_key ), "\n## available templates\n", dump( $_template ) unless $processed_templates;

diff --git a/t/3-normalize-marc.t b/t/3-normalize-marc.t
index 5d3b62e..1c79dc3 100755 (executable)
--- a/t/3-normalize-marc.t
+++ b/t/3-normalize-marc.t
@@ -42,6 +42,11 @@ my $rec = {
                'w' => 'w-6-1',
        },{
                'a' => 'a-7-1',
                'w' => 'w-6-1',
        },{
                'a' => 'a-7-1',

+       },{
+               'a' => 'a-8-1',
+               'v' => 'v-8-1',
+       },{
+               'v' => 'v-9-1',

        }],
 };
 
        }],
 };
 


@@ -63,8 +68,11 @@ ok( marc_template(
        ],
        marc_template => [
                'a',
        ],
        marc_template => [
                'a',

+               'a ;|v',
+               'a.|p',

                'a, |x ; |v. |n, |p ; |v',
                'a ; |v. |p ; |v',
                'a, |x ; |v. |n, |p ; |v',
                'a ; |v. |p ; |v',

+               'v',

        ],
 ), 'marc_template' );
 
        ],
 ), 'marc_template' );