--- trunk/lib/WebPAC/Normalize.pm 2007/10/30 20:27:20 915 +++ trunk/lib/WebPAC/Normalize.pm 2007/11/07 09:19:29 1012 @@ -1,13 +1,13 @@ package WebPAC::Normalize; use Exporter 'import'; -@EXPORT = qw/ - _set_rec _set_lookup +our @EXPORT = qw/ + _set_ds _set_lookup _set_load_row _get_ds _clean_ds _debug _pack_subfields_hash - search_display search display + search_display search display sorted marc marc_indicators marc_repeatable_subfield marc_compose marc_leader marc_fixed @@ -15,6 +15,7 @@ marc_original_order rec1 rec2 rec + frec regex prefix suffix surround first lookup join_with save_into_lookup @@ -23,6 +24,7 @@ get set count + /; use warnings; @@ -36,18 +38,16 @@ # debugging warn(s) my $debug = 0; +use WebPAC::Normalize::ISBN; +push @EXPORT, ( 'isbn_10', 'isbn_13' ); =head1 NAME WebPAC::Normalize - describe normalisaton rules using sets -=head1 VERSION - -Version 0.30 - =cut -our $VERSION = '0.30'; +our $VERSION = '0.32'; =head1 SYNOPSIS @@ -79,7 +79,7 @@ marc_encoding => 'utf-8', config => $config, load_row_coderef => sub { - my ($database,$input,$mfn) = shift; + my ($database,$input,$mfn) = @_; $store->load_row( database => $database, input => $input, id => $mfn ); }, ); @@ -105,30 +105,31 @@ die "need row argument" unless ($arg->{row}); die "need normalisation argument" unless ($arg->{rules}); - no strict 'subs'; _set_lookup( $arg->{lookup} ) if defined($arg->{lookup}); - _set_rec( $arg->{row} ); + _set_ds( $arg->{row} ); _set_config( $arg->{config} ) if defined($arg->{config}); _clean_ds( %{ $arg } ); $load_row_coderef = $arg->{load_row_coderef}; - eval "$arg->{rules}"; + no strict 'subs'; + no warnings 'redefine'; + eval "$arg->{rules};"; die "error evaling $arg->{rules}: $@\n" if ($@); return _get_ds(); } -=head2 _set_rec +=head2 _set_ds Set current record hash - _set_rec( $rec ); + _set_ds( $rec ); =cut my $rec; -sub _set_rec { +sub _set_ds { $rec = shift or die "no record hash"; } @@ -172,6 +173,7 @@ my ($marc_record_offset, $marc_fetch_offset) = (0, 0); sub _get_ds { +#warn "## out = ",dump($out); return $out; } @@ -478,13 +480,16 @@ =cut -sub display { - my $name = shift or die "display needs name as first argument"; +sub _field { + my $type = shift or confess "need type -- BUG?"; + my $name = shift or confess "needs name as first argument"; my @o = grep { defined($_) && $_ ne '' } @_; return unless (@o); - $out->{$name}->{display} = \@o; + $out->{$name}->{$type} = \@o; } +sub display { _field( 'display', @_ ) } + =head2 search Prepare values just for I @@ -493,12 +498,18 @@ =cut -sub search { - my $name = shift or die "search needs name as first argument"; - my @o = grep { defined($_) && $_ ne '' } @_; - return unless (@o); - $out->{$name}->{search} = \@o; -} +sub search { _field( 'search', @_ ) } + +=head2 sorted + +Insert into lists which will be automatically sorted + + sorted('Title', rec('200','a') ); + +=cut + +sub sorted { _field( 'sorted', @_ ) } + =head2 marc_leader @@ -1005,6 +1016,21 @@ } } +=head2 frec + +Returns first value from field + + $v = frec('200'); + $v = frec('200','a'); + +=cut + +sub frec { + my @out = rec(@_); + warn "rec(",dump(@_),") has more than one return value, ignoring\n" if $#out > 0; + return shift @out; +} + =head2 regex Apply regex to some or all values