--- trunk/lib/WebPAC/Normalize.pm 2006/10/08 00:38:04 741 +++ trunk/lib/WebPAC/Normalize.pm 2007/01/30 18:21:17 791 @@ -19,6 +19,9 @@ save_into_lookup split_rec_on + + get set + count /; use warnings; @@ -39,11 +42,11 @@ =head1 VERSION -Version 0.22 +Version 0.26 =cut -our $VERSION = '0.22'; +our $VERSION = '0.26'; =head1 SYNOPSIS @@ -635,6 +638,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 +659,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); } @@ -880,6 +895,9 @@ @v = rec('200') @v = rec('200','a') +If rec() returns just single value, it will +return scalar, not array. + =cut sub rec { @@ -889,7 +907,9 @@ } elsif ($#_ == 1) { @out = rec2(@_); } - if (@out) { + if ($#out == 0 && ! wantarray) { + return $out[0]; + } elsif (@out) { return @out; } else { return ''; @@ -1017,7 +1037,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})); @@ -1031,7 +1051,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} }; } } @@ -1040,7 +1060,7 @@ my @mfns = sort keys %$mfns; - warn "# lookup loading $database/$input/$key mfn ", join(",",@mfns)," having ",dump(@having),"\n"; + warn "# lookup loading $database/$input/$key mfn ", join(",",@mfns)," having ",dump(@having),"\n" if ($debug); my $old_rec = $rec; my @out; @@ -1048,13 +1068,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') { @@ -1065,7 +1085,7 @@ $rec = $old_rec; - warn "## lookup returns = ", dump(@out), $/; + warn "## lookup returns = ", dump(@out), $/ if ($debug); if ($#out == 0) { return $out[0]; @@ -1243,5 +1263,45 @@ } } +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; +} + +=head2 count + + if ( count( @result ) == 1 ) { + # do something if only 1 result is there + } + +=cut + +sub count { + warn "## count ",dump(@_),$/; + return @_ . ''; +} + # END 1;