7 |
_debug |
_debug |
8 |
_pack_subfields_hash |
_pack_subfields_hash |
9 |
|
|
10 |
|
to |
11 |
search_display search display sorted |
search_display search display sorted |
12 |
|
|
13 |
rec1 rec2 rec |
rec1 rec2 rec |
47 |
marc_template |
marc_template |
48 |
/); |
/); |
49 |
|
|
50 |
|
use Storable qw/dclone/; |
51 |
|
|
52 |
=head1 NAME |
=head1 NAME |
53 |
|
|
54 |
WebPAC::Normalize - describe normalisaton rules using sets |
WebPAC::Normalize - describe normalisaton rules using sets |
55 |
|
|
56 |
=cut |
=cut |
57 |
|
|
58 |
our $VERSION = '0.35'; |
our $VERSION = '0.36'; |
59 |
|
|
60 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
61 |
|
|
150 |
|
|
151 |
sub _get_rec { $rec }; |
sub _get_rec { $rec }; |
152 |
|
|
153 |
|
sub rec_array { |
154 |
|
my $d = $rec->{ $_[0] }; |
155 |
|
return @$d if ref($d) eq 'ARRAY'; |
156 |
|
die "field $_[0] not array: ",dump( $d ); |
157 |
|
} |
158 |
|
|
159 |
=head2 _set_config |
=head2 _set_config |
160 |
|
|
161 |
Set current config hash |
Set current config hash |
278 |
|
|
279 |
Those functions generally have to first in your normalization file. |
Those functions generally have to first in your normalization file. |
280 |
|
|
281 |
|
=head2 to |
282 |
|
|
283 |
|
Generic way to set values for some name |
284 |
|
|
285 |
|
to('field-name', 'name-value' => rec('200','a') ); |
286 |
|
|
287 |
|
There are many helpers defined below which might be easier to use. |
288 |
|
|
289 |
|
=cut |
290 |
|
|
291 |
|
sub to { |
292 |
|
my $type = shift or confess "need type -- BUG?"; |
293 |
|
my $name = shift or confess "needs name as first argument"; |
294 |
|
my @o = grep { defined($_) && $_ ne '' } @_; |
295 |
|
return unless (@o); |
296 |
|
$out->{$name}->{$type} = \@o; |
297 |
|
} |
298 |
|
|
299 |
=head2 search_display |
=head2 search_display |
300 |
|
|
301 |
Define output for L<search> and L<display> at the same time |
Define output for L<search> and L<display> at the same time |
302 |
|
|
303 |
search_display('Title', rec('200','a') ); |
search_display('Title', rec('200','a') ); |
304 |
|
|
|
|
|
305 |
=cut |
=cut |
306 |
|
|
307 |
sub search_display { |
sub search_display { |
314 |
|
|
315 |
=head2 tag |
=head2 tag |
316 |
|
|
317 |
Old name for L<search_display>, but supported |
Old name for L<search_display>, it will probably be removed at one point. |
318 |
|
|
319 |
=cut |
=cut |
320 |
|
|
330 |
|
|
331 |
=cut |
=cut |
332 |
|
|
333 |
sub _field { |
sub display { to( 'display', @_ ) } |
|
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', @_ ) } |
|
334 |
|
|
335 |
=head2 search |
=head2 search |
336 |
|
|
340 |
|
|
341 |
=cut |
=cut |
342 |
|
|
343 |
sub search { _field( 'search', @_ ) } |
sub search { to( 'search', @_ ) } |
344 |
|
|
345 |
=head2 sorted |
=head2 sorted |
346 |
|
|
350 |
|
|
351 |
=cut |
=cut |
352 |
|
|
353 |
sub sorted { _field( 'sorted', @_ ) } |
sub sorted { to( 'sorted', @_ ) } |
354 |
|
|
355 |
|
=head2 row |
356 |
|
|
357 |
|
Insert new row of data into output module |
358 |
|
|
359 |
|
row( column => 'foo', column2 => 'bar' ); |
360 |
|
|
361 |
|
=cut |
362 |
|
|
363 |
|
use Data::Dump qw/dump/; |
364 |
|
|
365 |
|
sub row { |
366 |
|
die "array doesn't have even number of elements but $#_: ",dump( @_ ) if $#_ % 2 != 1; |
367 |
|
|
368 |
|
push @{ $out->{'_rows'} }, {@_}; |
369 |
|
} |
370 |
|
|
371 |
|
|
372 |
=head1 Functions to extract data from input |
=head1 Functions to extract data from input |
388 |
|
|
389 |
warn "## _pack_subfields_hash( ",dump(@_), " )\n" if ($debug > 1); |
warn "## _pack_subfields_hash( ",dump(@_), " )\n" if ($debug > 1); |
390 |
|
|
391 |
my ($h,$include_subfields) = @_; |
my ($hash,$include_subfields) = @_; |
392 |
|
|
393 |
# sanity and ease of use |
# sanity and ease of use |
394 |
return $h if (ref($h) ne 'HASH'); |
return $hash if (ref($hash) ne 'HASH'); |
395 |
|
|
396 |
|
my $h = dclone( $hash ); |
397 |
|
|
398 |
if ( defined($h->{subfields}) ) { |
if ( defined($h->{subfields}) ) { |
399 |
my $sfs = delete $h->{subfields} || die "no subfields?"; |
my $sfs = delete $h->{subfields} || die "no subfields?"; |
484 |
} else { |
} else { |
485 |
$_->{$sf}; |
$_->{$sf}; |
486 |
} |
} |
487 |
} grep { ref($_) eq 'HASH' && $_->{$sf} } @{ $rec->{$f} }; |
} grep { ref($_) eq 'HASH' && defined $_->{$sf} } @{ $rec->{$f} }; |
488 |
} |
} |
489 |
|
|
490 |
=head2 rec |
=head2 rec |