--- trunk/lib/WebPAC/Normalize.pm 2006/10/08 13:24:46 750 +++ trunk/lib/WebPAC/Normalize.pm 2006/12/10 12:56:59 788 @@ -19,6 +19,8 @@ save_into_lookup split_rec_on + + get set /; use warnings; @@ -39,11 +41,11 @@ =head1 VERSION -Version 0.23 +Version 0.25 =cut -our $VERSION = '0.23'; +our $VERSION = '0.25'; =head1 SYNOPSIS @@ -635,6 +637,10 @@ This will erase field C<200> or C<200^a> from current MARC record. + marc_remove('*'); + +Will remove all fields in current MARC record. + This is useful after calling C or on it's own (but, you should probably just remove that subfield definition if you are not using C). @@ -652,39 +658,47 @@ warn "### marc_remove before = ", dump( $marc ), $/ if ($debug > 2); - my $i = 0; - foreach ( 0 .. $#{ $marc } ) { - last unless (defined $marc->[$i]); - warn "#### working on ",dump( @{ $marc->[$i] }), $/ if ($debug > 3); - if ($marc->[$i]->[0] eq $f) { - if (! defined $sf) { - # remove whole field - splice @$marc, $i, 1; - warn "#### slice \@\$marc, $i, 1 = ",dump( @{ $marc }), $/ if ($debug > 3); - $i--; - } else { - foreach my $j ( 0 .. (( $#{ $marc->[$i] } - 3 ) / 2) ) { - my $o = ($j * 2) + 3; - if ($marc->[$i]->[$o] eq $sf) { - # remove subfield - splice @{$marc->[$i]}, $o, 2; - warn "#### slice \@{\$marc->[$i]}, $o, 2 = ", dump( @{ $marc }), $/ if ($debug > 3); - # is record now empty? - if ($#{ $marc->[$i] } == 2) { - splice @$marc, $i, 1; - warn "#### slice \@\$marc, $i, 1 = ", dump( @{ $marc }), $/ if ($debug > 3); - $i--; - }; + if ($f eq '*') { + + delete( $marc_record->[ $marc_record_offset ] ); + warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1); + + } else { + + my $i = 0; + foreach ( 0 .. $#{ $marc } ) { + last unless (defined $marc->[$i]); + warn "#### working on ",dump( @{ $marc->[$i] }), $/ if ($debug > 3); + if ($marc->[$i]->[0] eq $f) { + if (! defined $sf) { + # remove whole field + splice @$marc, $i, 1; + warn "#### slice \@\$marc, $i, 1 = ",dump( @{ $marc }), $/ if ($debug > 3); + $i--; + } else { + foreach my $j ( 0 .. (( $#{ $marc->[$i] } - 3 ) / 2) ) { + my $o = ($j * 2) + 3; + if ($marc->[$i]->[$o] eq $sf) { + # remove subfield + splice @{$marc->[$i]}, $o, 2; + warn "#### slice \@{\$marc->[$i]}, $o, 2 = ", dump( @{ $marc }), $/ if ($debug > 3); + # is record now empty? + if ($#{ $marc->[$i] } == 2) { + splice @$marc, $i, 1; + warn "#### slice \@\$marc, $i, 1 = ", dump( @{ $marc }), $/ if ($debug > 3); + $i--; + }; + } } } } + $i++; } - $i++; - } - warn "### marc_remove($f", $sf ? ",$sf" : "", ") after = ", dump( $marc ), $/ if ($debug > 2); + warn "### marc_remove($f", $sf ? ",$sf" : "", ") after = ", dump( $marc ), $/ if ($debug > 2); - $marc_record->[ $marc_record_offset ] = $marc; + $marc_record->[ $marc_record_offset ] = $marc; + } warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1); } @@ -1022,7 +1036,7 @@ sub lookup { my ($what, $database, $input, $key, $having) = @_; - confess "lookup needs 5 arguments: what, database, input, key, having" unless ($#_ == 4); + confess "lookup needs 5 arguments: what, database, input, key, having\n" unless ($#_ == 4); warn "## lookup ($database, $input, $key)", $/ if ($debug > 1); return unless (defined($lookup->{$database}->{$input}->{$key})); @@ -1036,7 +1050,7 @@ foreach my $h ( @having ) { if (defined($lookup->{$database}->{$input}->{$key}->{$h})) { - warn "lookup for $database/$input/$key/$h return ",dump($lookup->{$database}->{$input}->{$key}->{$h}),"\n"; + warn "lookup for $database/$input/$key/$h return ",dump($lookup->{$database}->{$input}->{$key}->{$h}),"\n" if ($debug); $mfns->{$_}++ foreach keys %{ $lookup->{$database}->{$input}->{$key}->{$h} }; } } @@ -1053,13 +1067,13 @@ foreach my $mfn (@mfns) { $rec = $load_row_coderef->( $database, $input, $mfn ); - warn "got $database/$input/$mfn = ", dump($rec), $/; + warn "got $database/$input/$mfn = ", dump($rec), $/ if ($debug); my @vals = $what->(); push @out, ( @vals ); - warn "lookup for mfn $mfn returned ", dump(@vals), $/; + warn "lookup for mfn $mfn returned ", dump(@vals), $/ if ($debug); } # if (ref($lookup->{$k}) eq 'ARRAY') { @@ -1248,5 +1262,33 @@ } } +my $hash; + +=head2 set + + set( key => 'value' ); + +=cut + +sub set { + my ($k,$v) = @_; + warn "## set ( $k => ", dump($v), " )", $/; + $hash->{$k} = $v; +}; + +=head2 get + + get( 'key' ); + +=cut + +sub get { + my $k = shift || return; + my $v = $hash->{$k}; + warn "## get $k = ", dump( $v ), $/; + return $v; +} + + # END 1;