--- trunk/lib/WebPAC/Normalize.pm 2006/07/09 15:22:30 592 +++ trunk/lib/WebPAC/Normalize.pm 2006/07/10 10:16:11 595 @@ -35,11 +35,11 @@ =head1 VERSION -Version 0.12 +Version 0.14 =cut -our $VERSION = '0.12'; +our $VERSION = '0.14'; =head1 SYNOPSIS @@ -69,6 +69,7 @@ row => $row, rules => $normalize_pl_config, marc_encoding => 'utf-8', + config => $config, ); Options C, C, C and C are mandatory while all @@ -90,6 +91,7 @@ no strict 'subs'; _set_lookup( $arg->{lookup} ); _set_rec( $arg->{row} ); + _set_config( $arg->{config} ); _clean_ds( %{ $arg } ); eval "$arg->{rules}"; die "error evaling $arg->{rules}: $@\n" if ($@); @@ -111,6 +113,34 @@ $rec = shift or die "no record hash"; } +=head2 _set_config + +Set current config hash + + _set_config( $config ); + +Magic keys are: + +=over 4 + +=item _ + +Code of current database + +=item _mfn + +Current MFN + +=back + +=cut + +my $config; + +sub _set_config { + $config = shift; +} + =head2 _get_ds Return hash formatted as data structure @@ -773,6 +803,78 @@ } } +=head2 config + +Consult config values stored in C + + # return database code (key under databases in yaml) + $database_code = config(); # use _ from hash + $database_name = config('name'); + $database_input_name = config('input name'); + $tag = config('input normalize tag'); + +Up to three levels are supported. + +=cut + +sub config { + return unless ($config); + + my $p = shift; + + $p ||= ''; + + my $v; + + warn "### getting config($p)\n" if ($debug > 1); + + my @p = split(/\s+/,$p); + if ($#p < 0) { + $v = $config->{ '_' }; # special, database code + } else { + + my $c = dclone( $config ); + + foreach my $k (@p) { + warn "### k: $k c = ",dump($c),$/ if ($debug > 1); + if (ref($c) eq 'ARRAY') { + $c = shift @$c; + warn "config($p) taking first occurence of '$k', probably not what you wanted!\n"; + last; + } + + if (! defined($c->{$k}) ) { + $c = undef; + last; + } else { + $c = $c->{$k}; + } + } + $v = $c if ($c); + + } + + warn "## config( '$p' ) = ",dump( $v ),$/ if ($v && $debug); + warn "config( '$p' ) is empty\n" if (! $v); + + return $v; +} + +=head2 id + +Returns unique id of this record + + $id = id(); + +Returns C<42/2> for 2nd occurence of MFN 42. + +=cut + +sub id { + my $mfn = $config->{_mfn} || die "no _mfn in config data"; + return $mfn . $#{$marc_record} ? $#{$marc_record} + 1 : ''; +} + =head2 join_with Joins walues with some delimiter