From: Dobrica Pavlinusic Date: Sun, 11 Nov 2007 14:22:57 +0000 (+0000) Subject: r1594@llin: dpavlin | 2007-11-11 15:22:56 +0100 X-Git-Url: http://git.rot13.org/?p=webpac2;a=commitdiff_plain;h=f41b4e9855737825ce5037acf33a6560a10f5ab4 r1594@llin: dpavlin | 2007-11-11 15:22:56 +0100 hush debug chatter git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@1028 07558da8-63fa-0310-ba24-9fe276d99e06 --- diff --git a/lib/WebPAC/Normalize/MARC.pm b/lib/WebPAC/Normalize/MARC.pm index 90271be..cafd045 100644 --- a/lib/WebPAC/Normalize/MARC.pm +++ b/lib/WebPAC/Normalize/MARC.pm @@ -12,6 +12,8 @@ use Carp qw/confess/; use WebPAC::Normalize; +my $debug = 0; + =head1 NAME WebPAC::Normalize::MARC - create MARC/ISO2709 records @@ -48,10 +50,10 @@ Returns number of records produced. sub marc_template { my $args = {@_}; - warn "## marc_template(",dump($args),")"; + warn "## marc_template(",dump($args),")",$/ if $debug; foreach ( qw/subfields_rename isis_template marc_template/ ) { -# warn "ref($_) = ",ref($args->{$_}); +# warn "ref($_) = ",ref($args->{$_}) if $debug; die "$_ not ARRAY" if defined($args->{$_}) && ref($args->{$_}) ne 'ARRAY'; } @@ -63,7 +65,7 @@ sub marc_template { die "record field ", $args->{from}, " isn't array ",dump( $rec ) unless (ref($r) eq 'ARRAY'); my @subfields_rename = @{ $args->{subfields_rename} }; -# warn "### subfields_rename [$#subfields_rename] = ",dump( @subfields_rename ); +# warn "### subfields_rename [$#subfields_rename] = ",dump( @subfields_rename ) if $debug; confess "need mapping in pairs for subfields_rename" if $#subfields_rename % 2 != 1; @@ -76,9 +78,9 @@ sub marc_template { ); $subfields_rename->{ $from }->[ $f ] = [ $to => $t ]; } - warn "### subfields_rename = ",dump( $subfields_rename ),$/; - warn "### from_subfields = ", dump( $from_subfields ),$/; - warn "### to_subfields = ", dump( $to_subfields ),$/; + warn "### subfields_rename = ",dump( $subfields_rename ),$/ if $debug; + warn "### from_subfields = ", dump( $from_subfields ),$/ if $debug; + warn "### to_subfields = ", dump( $to_subfields ),$/ if $debug; our $_template; @@ -104,16 +106,16 @@ sub marc_template { my $pos_template = $template; $pos_template =~ s/($fields_re)/my_count($1)/ge; my $count_key = dump( $count ); - warn "### template: |$template| -> |$pos_template| count = $count_key order = ",dump( @order ),$/; + warn "### template: |$template| -> |$pos_template| count = $count_key order = ",dump( @order ),$/ if $debug; $_template->{$name}->{pos}->{ $count_key } = $pos_template; $_template->{$name}->{order}->{ $pos_template } = [ @order ]; } - warn "### from ",dump( $templates ), " using $fields_re created ", dump( $_template ); + warn "### from ",dump( $templates ), " using $fields_re created ", dump( $_template ),$/ if $debug; } _parse_template( 'marc', $args->{marc_template} ); _parse_template( 'isis', $args->{isis_template} ); - warn "### _template = ",dump( $_template ); + warn "### _template = ",dump( $_template ),$/ if $debug; my $m; @@ -123,7 +125,7 @@ sub marc_template { my $i2 = $r->{i2} || ' '; $m = [ $args->{to}, $i1, $i2 ]; - warn "### r = ",dump( $r ); + warn "### r = ",dump( $r ),$/ if $debug; my ( $from_mapping, $to_mapping, $from_count, $to_count ); foreach my $sf ( keys %{$r} ) { @@ -132,7 +134,7 @@ sub marc_template { 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] ), $/; + 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 ]; @@ -140,14 +142,14 @@ sub marc_template { $to_count->{ $to_sf }++; } - warn "### to_mapping = ",dump( $to_mapping ); + warn "### to_mapping = ",dump( $to_mapping ),$/ if $debug; my $count_key = { from => dump( $from_count ), to => dump( $to_count), }; - warn "### count_key = ",dump( $count_key ), $/; + warn "### count_key = ",dump( $count_key ),$/ if $debug; my $processed_templates = 0; @@ -160,7 +162,7 @@ sub marc_template { my $template = $_template->{$name}->{pos}->{ $ckey } || next; $processed_templates++; - warn "### traverse $name $count_name selected template: |$template|\n"; + warn "### traverse $name $count_name selected template: |$template|\n",$/ if $debug; our $fill_in = {}; @@ -170,14 +172,14 @@ sub marc_template { foreach my $sf ( @templates ) { sub fill_in { my ( $name, $r, $sf, $nr ) = @_; - my ( $from_sf, $from_nr, $v ); + my ( $from_sf, $from_nr ); if ( $name eq 'marc' ) { ( $from_sf, $from_nr ) = @{ $to_mapping->{$sf}->[$nr] }; } else { ( $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 ), $/; + 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]; @@ -189,12 +191,12 @@ sub marc_template { } } my $fields_re = $_template->{$name}->{fields_re} || die "can't find $name in ",dump( $_template->{$name}->{fields_re} ); - warn "#### $sf <<<< $fields_re\n"; + warn "#### $sf <<<< $fields_re\n",$/ if $debug; $sf =~ s/($fields_re)(\d+)/fill_in($name,$r,$1,$2)/ge; - warn "#### >>>> $sf with fill_in = ",dump( $fill_in ),$/; + warn "#### >>>> $sf with fill_in = ",dump( $fill_in ),$/ if $debug; } - warn "## template: |$template|\n## _template->$name = ",dump( $_template->{$name} ); + warn "## template: |$template|\n## _template->$name = ",dump( $_template->{$name} ),$/ if $debug; foreach my $sf ( @{ $_template->{$name}->{order}->{$template} } ) { my ( $sf, $nr ) = @$sf; @@ -202,29 +204,31 @@ sub marc_template { if ( $name eq 'isis') { ( $sf, $nr ) = @{ $from_mapping->{$sf}->[$nr] }; } - warn "++ $sf/$nr |$v|\n"; + warn "++ $sf/$nr |$v|\n" if $debug; push @$m, ( $sf, $v ); } - warn "#### >>>> created MARC record: ", dump( $m ); + warn "#### >>>> created MARC record: ", dump( $m ),$/ if $debug; push @marc_out, $m; } die "I don't have template for fields ",dump( $count_key ), "\n## available templates\n", dump( $_template ) unless $processed_templates; - warn ">>> $processed_templates templates applied to data\n"; + warn ">>> $processed_templates templates applied to data\n",$/ if $debug; } my $recs = 0; foreach my $marc ( @marc_out ) { - warn "+++ ",dump( $marc ),$/; + warn "+++ ",dump( $marc ),$/ if $debug; WebPAC::Normalize::_marc_push( $marc ); $recs++; } - warn "### marc_template produced $recs MARC records: ",dump( @marc_out ), $/; + warn "### marc_template produced $recs MARC records: ",dump( @marc_out ),$/ if $debug; + + return $recs; } 1;