--- trunk/lib/WebPAC/Normalize.pm 2006/09/29 18:55:41 725 +++ trunk/lib/WebPAC/Normalize.pm 2006/12/06 23:44:36 785 @@ -2,7 +2,7 @@ use Exporter 'import'; @EXPORT = qw/ _set_rec _set_lookup - _set_load_ds + _set_load_row _get_ds _clean_ds _debug _pack_subfields_hash @@ -19,6 +19,8 @@ save_into_lookup split_rec_on + + get set /; use warnings; @@ -39,11 +41,11 @@ =head1 VERSION -Version 0.21 +Version 0.24 =cut -our $VERSION = '0.21'; +our $VERSION = '0.24'; =head1 SYNOPSIS @@ -74,16 +76,16 @@ rules => $normalize_pl_config, marc_encoding => 'utf-8', config => $config, - load_ds_coderef => sub { + load_row_coderef => sub { my ($database,$input,$mfn) = shift; - $store->load_ds( database => $database, input => $input, id => $mfn ); + $store->load_row( database => $database, input => $input, id => $mfn ); }, ); Options C, C and C are mandatory while all other are optional. -C is closure only used when executing lookups, so they will +C is closure only used when executing lookups, so they will die if it's not defined. This function will B if normalizastion can't be evaled. @@ -93,7 +95,7 @@ =cut -my $load_ds_coderef; +my $load_row_coderef; sub data_structure { my $arg = {@_}; @@ -102,11 +104,11 @@ 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 } ); - $load_ds_coderef = $arg->{load_ds_coderef}; + $load_row_coderef = $arg->{load_row_coderef}; eval "$arg->{rules}"; die "error evaling $arg->{rules}: $@\n" if ($@); @@ -164,7 +166,7 @@ =cut -my ($out, $marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators); +my ($out, $marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $leader); my ($marc_record_offset, $marc_fetch_offset) = (0, 0); sub _get_ds { @@ -181,7 +183,7 @@ sub _clean_ds { my $a = {@_}; - ($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators) = (); + ($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $leader) = (); ($marc_record_offset, $marc_fetch_offset) = (0,0); $marc_encoding = $a->{marc_encoding}; } @@ -212,23 +214,23 @@ return $lookup; } -=head2 _set_load_ds +=head2 _set_load_row Setup code reference which will return L from L - _set_load_ds(sub { + _set_load_row(sub { my ($database,$input,$mfn) = @_; - $store->load_ds( database => $database, input => $input, id => $mfn ); + $store->load_row( database => $database, input => $input, id => $mfn ); }); =cut -sub _set_load_ds { +sub _set_load_row { my $coderef = shift; confess "argument isn't CODE" unless ref($coderef) eq 'CODE'; - $load_ds_coderef = $coderef; + $load_row_coderef = $coderef; } =head2 _get_marc_fields @@ -487,9 +489,9 @@ my ($offset,$value) = @_; if ($offset) { - $out->{' leader'}->{ $offset } = $value; + $leader->{ $offset } = $value; } else { - return $out->{' leader'}; + return $leader; } } @@ -880,6 +882,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 +894,9 @@ } elsif ($#_ == 1) { @out = rec2(@_); } - if (@out) { + if ($#out == 0 && ! wantarray) { + return $out[0]; + } elsif (@out) { return @out; } else { return ''; @@ -1017,21 +1024,21 @@ 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)\n"; + warn "## lookup ($database, $input, $key)", $/ if ($debug > 1); return unless (defined($lookup->{$database}->{$input}->{$key})); - confess "lookup really need load_ds_coderef added to data_structure\n" unless ($load_ds_coderef); + confess "lookup really need load_row_coderef added to data_structure\n" unless ($load_row_coderef); my $mfns; my @having = $having->(); - warn "## having = ", dump( @having ); + warn "## having = ", dump( @having ) if ($debug > 2); 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,21 +1047,21 @@ 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; foreach my $mfn (@mfns) { - $rec = $load_ds_coderef->( $database, $input, $mfn ); + $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,9 +1072,13 @@ $rec = $old_rec; - warn "## lookup returns = ", dump(@out), $/; + warn "## lookup returns = ", dump(@out), $/ if ($debug); - return @out; + if ($#out == 0) { + return $out[0]; + } else { + return @out; + } } =head2 save_into_lookup @@ -1097,7 +1108,7 @@ die "save_into_lookup needs key" unless defined($key); die "save_into_lookup needs CODE" unless ( defined($coderef) && ref($coderef) eq 'CODE' ); -warn "## save_into_lookup rec = ", dump($rec), " config = ", dump($config),"\n"; + warn "## save_into_lookup rec = ", dump($rec), " config = ", dump($config), $/ if ($debug > 2); my $mfn = defined($rec->{'000'}->[0]) ? $rec->{'000'}->[0] : @@ -1239,5 +1250,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;