--- trunk/lib/WebPAC/Normalize.pm 2006/09/08 17:47:58 661 +++ trunk/lib/WebPAC/Normalize.pm 2006/09/29 12:27:47 721 @@ -15,6 +15,7 @@ rec1 rec2 rec regex prefix suffix surround first lookup join_with + save_into_lookup split_rec_on /; @@ -36,11 +37,11 @@ =head1 VERSION -Version 0.18 +Version 0.20 =cut -our $VERSION = '0.18'; +our $VERSION = '0.20'; =head1 SYNOPSIS @@ -66,14 +67,14 @@ Return data structure my $ds = WebPAC::Normalize::data_structure( - lookup => $lookup->lookup_hash, + lookup => $lookup_variable, row => $row, rules => $normalize_pl_config, marc_encoding => 'utf-8', config => $config, ); -Options C, C, C and C are mandatory while all +Options C, C and C are mandatory while all other are optional. This function will B if normalizastion can't be evaled. @@ -90,9 +91,9 @@ die "need normalisation argument" unless ($arg->{rules}); no strict 'subs'; - _set_lookup( $arg->{lookup} ); + _set_lookup( $arg->{lookup} ) if (defined( $arg->{lookup} )); _set_rec( $arg->{row} ); - _set_config( $arg->{config} ); + _set_config( $arg->{config} ) if (defined( $arg->{config} )); _clean_ds( %{ $arg } ); eval "$arg->{rules}"; die "error evaling $arg->{rules}: $@\n" if ($@); @@ -186,6 +187,18 @@ $lookup = shift; } +=head2 _get_lookup + +Get current lookup hash + + my $lookup = _get_lookup(); + +=cut + +sub _get_lookup { + return $lookup; +} + =head2 _get_marc_fields Get all fields defined by calls to C @@ -722,7 +735,11 @@ =head2 _pack_subfields_hash - @values = _pack_subfields_hash( $h, $include_subfields ) + @subfields = _pack_subfields_hash( $h ); + $subfields = _pack_subfields_hash( $h, 1 ); + +Return each subfield value in array or pack them all together and return scalar +with subfields (denoted by C<^>) and values. =cut @@ -732,7 +749,6 @@ my ($h,$include_subfields) = @_; - if ( defined($h->{subfields}) ) { my $sfs = delete $h->{subfields} || die "no subfields?"; my @out; @@ -742,16 +758,34 @@ my $o = shift @$sfs; if ($o == 0 && ref( $h->{$sf} ) ne 'ARRAY' ) { # single element subfields are not arrays +#warn "====> $sf $o / $#$sfs ", dump( $sfs, $h->{$sf} ), "\n"; + push @out, $h->{$sf}; } else { -#warn "====> $f $sf $o $#$sfs ", dump( $sfs ), "\n"; +#warn "====> $sf $o / $#$sfs ", dump( $sfs, $h->{$sf} ), "\n"; push @out, $h->{$sf}->[$o]; } } - return @out; + if ($include_subfields) { + return join('', @out); + } else { + return @out; + } } else { - # FIXME this should probably be in alphabetical order instead of hash order - values %{$h}; + if ($include_subfields) { + my $out = ''; + foreach my $sf (sort keys %$h) { + if (ref($h->{$sf}) eq 'ARRAY') { + $out .= '^' . $sf . join('^' . $sf, @{ $h->{$sf} }); + } else { + $out .= '^' . $sf . $h->{$sf}; + } + } + return $out; + } else { + # FIXME this should probably be in alphabetical order instead of hash order + values %{$h}; + } } } @@ -910,6 +944,8 @@ @v = lookup( $v ); @v = lookup( @v ); +FIXME B + =cut sub lookup { @@ -922,6 +958,31 @@ } } +=head2 save_into_lookup + +Save value into lookup. + + save_into_lookup($database,$input,$key,sub { + # code which produce one or more values + }); + +This function shouldn't be called directly, it's called from code created by L. + +=cut + +sub save_into_lookup { + my ($database,$input,$key,$coderef) = @_; + die "save_into_lookup needs database" unless defined($database); + die "save_into_lookup needs input" unless defined($input); + die "save_into_lookup needs key" unless defined($key); + die "save_into_lookup needs CODE" unless ( defined($coderef) && ref($coderef) eq 'CODE' ); + my $mfn = $rec->{'000'}->[0] || die "mfn not defined or zero"; + foreach my $v ( $coderef->() ) { + $lookup->{$database}->{$input}->{$key}->{$v}->{$mfn}++; + warn "# saved lookup $database/$input/$key [$v] $mfn\n" if ($debug > 1); + } +} + =head2 config Consult config values stored in C