--- trunk/lib/WebPAC/Normalize.pm 2007/11/12 11:10:48 1036 +++ trunk/lib/WebPAC/Normalize.pm 2009/06/02 13:17:24 1216 @@ -7,6 +7,7 @@ _debug _pack_subfields_hash + to search_display search display sorted rec1 rec2 rec @@ -20,6 +21,9 @@ get set count + row + rec_array + /; use warnings; @@ -27,11 +31,11 @@ #use base qw/WebPAC::Common/; use Data::Dump qw/dump/; -use Storable qw/dclone/; use Carp qw/confess/; # debugging warn(s) my $debug = 0; +_debug( $debug ); # FIXME use WebPAC::Normalize::ISBN; @@ -46,13 +50,15 @@ marc_template /); +use Storable qw/dclone/; + =head1 NAME WebPAC::Normalize - describe normalisaton rules using sets =cut -our $VERSION = '0.35'; +our $VERSION = '0.36'; =head1 SYNOPSIS @@ -269,13 +275,30 @@ Those functions generally have to first in your normalization file. +=head2 to + +Generic way to set values for some name + + to('field-name', 'name-value' => rec('200','a') ); + +There are many helpers defined below which might be easier to use. + +=cut + +sub to { + 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}->{$type} = \@o; +} + =head2 search_display Define output for L and L at the same time search_display('Title', rec('200','a') ); - =cut sub search_display { @@ -288,7 +311,7 @@ =head2 tag -Old name for L, but supported +Old name for L, it will probably be removed at one point. =cut @@ -304,15 +327,7 @@ =cut -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}->{$type} = \@o; -} - -sub display { _field( 'display', @_ ) } +sub display { to( 'display', @_ ) } =head2 search @@ -322,7 +337,7 @@ =cut -sub search { _field( 'search', @_ ) } +sub search { to( 'search', @_ ) } =head2 sorted @@ -332,8 +347,23 @@ =cut -sub sorted { _field( 'sorted', @_ ) } +sub sorted { to( 'sorted', @_ ) } + +=head2 row + +Insert new row of data into output module + row( column => 'foo', column2 => 'bar' ); + +=cut + +use Data::Dump qw/dump/; + +sub row { + die "array doesn't have odd number of elements but $#_: ",dump( @_ ) if $#_ % 2 == 1; + my $table = shift @_; + push @{ $out->{'_rows'}->{$table} }, {@_}; +} =head1 Functions to extract data from input @@ -355,10 +385,12 @@ warn "## _pack_subfields_hash( ",dump(@_), " )\n" if ($debug > 1); - my ($h,$include_subfields) = @_; + my ($hash,$include_subfields) = @_; # sanity and ease of use - return $h if (ref($h) ne 'HASH'); + return $hash if (ref($hash) ne 'HASH'); + + my $h = dclone( $hash ); if ( defined($h->{subfields}) ) { my $sfs = delete $h->{subfields} || die "no subfields?"; @@ -449,7 +481,7 @@ } else { $_->{$sf}; } - } grep { ref($_) eq 'HASH' && $_->{$sf} } @{ $rec->{$f} }; + } grep { ref($_) eq 'HASH' && defined $_->{$sf} } @{ $rec->{$f} }; } =head2 rec @@ -918,5 +950,21 @@ return @_ . ''; } +=head2 rec_array + +Always return field as array + + foreach my $d ( rec_array('field') ) { + warn $d; + } + +=cut + +sub rec_array { + my $d = $rec->{ $_[0] }; + return @$d if ref($d) eq 'ARRAY'; + return ($d); +} + # END 1;