--- trunk/lib/WebPAC/Normalize/MARC.pm 2007/11/11 11:54:48 1025 +++ trunk/lib/WebPAC/Normalize/MARC.pm 2007/11/11 13:47:43 1026 @@ -42,6 +42,8 @@ ], ); +Returns number of records produced. + =cut sub marc_template { @@ -80,17 +82,15 @@ 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 @@ 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 @@ 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 @@ # 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 @@ 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 @@ 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 @@ 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 @@ } - 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;