21 |
get set |
get set |
22 |
count |
count |
23 |
|
|
24 |
|
row |
25 |
|
rec_array |
26 |
|
|
27 |
/; |
/; |
28 |
|
|
29 |
use warnings; |
use warnings; |
50 |
marc_template |
marc_template |
51 |
/); |
/); |
52 |
|
|
53 |
|
use Storable qw/dclone/; |
54 |
|
|
55 |
=head1 NAME |
=head1 NAME |
56 |
|
|
57 |
WebPAC::Normalize - describe normalisaton rules using sets |
WebPAC::Normalize - describe normalisaton rules using sets |
123 |
$load_row_coderef = $arg->{load_row_coderef}; |
$load_row_coderef = $arg->{load_row_coderef}; |
124 |
|
|
125 |
no strict 'subs'; |
no strict 'subs'; |
126 |
no warnings 'redefine'; |
no warnings 'all'; |
127 |
eval "$arg->{rules};"; |
eval "$arg->{rules};"; |
128 |
die "error evaling $arg->{rules}: $@\n" if ($@); |
die "error evaling $arg->{rules}: $@\n" if ($@); |
129 |
|
|
349 |
|
|
350 |
sub sorted { to( 'sorted', @_ ) } |
sub sorted { to( 'sorted', @_ ) } |
351 |
|
|
352 |
|
=head2 row |
353 |
|
|
354 |
|
Insert new row of data into output module |
355 |
|
|
356 |
|
row( column => 'foo', column2 => 'bar' ); |
357 |
|
|
358 |
|
=cut |
359 |
|
|
360 |
|
use Data::Dump qw/dump/; |
361 |
|
|
362 |
|
sub row { |
363 |
|
die "array doesn't have odd number of elements but $#_: ",dump( @_ ) if $#_ % 2 == 1; |
364 |
|
my $table = shift @_; |
365 |
|
push @{ $out->{'_rows'}->{$table} }, {@_}; |
366 |
|
} |
367 |
|
|
368 |
|
|
369 |
=head1 Functions to extract data from input |
=head1 Functions to extract data from input |
370 |
|
|
385 |
|
|
386 |
warn "## _pack_subfields_hash( ",dump(@_), " )\n" if ($debug > 1); |
warn "## _pack_subfields_hash( ",dump(@_), " )\n" if ($debug > 1); |
387 |
|
|
388 |
my ($h,$include_subfields) = @_; |
my ($hash,$include_subfields) = @_; |
389 |
|
|
390 |
# sanity and ease of use |
# sanity and ease of use |
391 |
return $h if (ref($h) ne 'HASH'); |
return $hash if (ref($hash) ne 'HASH'); |
392 |
|
|
393 |
|
my $h = dclone( $hash ); |
394 |
|
|
395 |
if ( defined($h->{subfields}) ) { |
if ( defined($h->{subfields}) ) { |
396 |
my $sfs = delete $h->{subfields} || die "no subfields?"; |
my $sfs = delete $h->{subfields} || die "no subfields?"; |
950 |
return @_ . ''; |
return @_ . ''; |
951 |
} |
} |
952 |
|
|
953 |
|
=head2 rec_array |
954 |
|
|
955 |
|
Always return field as array |
956 |
|
|
957 |
|
foreach my $d ( rec_array('field') ) { |
958 |
|
warn $d; |
959 |
|
} |
960 |
|
|
961 |
|
=cut |
962 |
|
|
963 |
|
sub rec_array { |
964 |
|
my $d = $rec->{ $_[0] }; |
965 |
|
return @$d if ref($d) eq 'ARRAY'; |
966 |
|
return ($d); |
967 |
|
} |
968 |
|
|
969 |
# END |
# END |
970 |
1; |
1; |