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 |
|
|
266 |
warn "debug level $l",$/ if ($l > 0); |
warn "debug level $l",$/ if ($l > 0); |
267 |
$debug = $l; |
$debug = $l; |
268 |
$WebPAC::Normalize::MARC::debug = $debug; |
$WebPAC::Normalize::MARC::debug = $debug; |
|
warn "#### MARC::debug = ",dump($WebPAC::Normalize::MARC::debug); |
|
269 |
} |
} |
270 |
|
|
271 |
=head1 Functions to create C<data_structure> |
=head1 Functions to create C<data_structure> |
272 |
|
|
273 |
Those functions generally have to first in your normalization file. |
Those functions generally have to first in your normalization file. |
274 |
|
|
275 |
|
=head2 to |
276 |
|
|
277 |
|
Generic way to set values for some name |
278 |
|
|
279 |
|
to('field-name', 'name-value' => rec('200','a') ); |
280 |
|
|
281 |
|
There are many helpers defined below which might be easier to use. |
282 |
|
|
283 |
|
=cut |
284 |
|
|
285 |
|
sub to { |
286 |
|
my $type = shift or confess "need type -- BUG?"; |
287 |
|
my $name = shift or confess "needs name as first argument"; |
288 |
|
my @o = grep { defined($_) && $_ ne '' } @_; |
289 |
|
return unless (@o); |
290 |
|
$out->{$name}->{$type} = \@o; |
291 |
|
} |
292 |
|
|
293 |
=head2 search_display |
=head2 search_display |
294 |
|
|
295 |
Define output for L<search> and L<display> at the same time |
Define output for L<search> and L<display> at the same time |
296 |
|
|
297 |
search_display('Title', rec('200','a') ); |
search_display('Title', rec('200','a') ); |
298 |
|
|
|
|
|
299 |
=cut |
=cut |
300 |
|
|
301 |
sub search_display { |
sub search_display { |
308 |
|
|
309 |
=head2 tag |
=head2 tag |
310 |
|
|
311 |
Old name for L<search_display>, but supported |
Old name for L<search_display>, it will probably be removed at one point. |
312 |
|
|
313 |
=cut |
=cut |
314 |
|
|
324 |
|
|
325 |
=cut |
=cut |
326 |
|
|
327 |
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', @_ ) } |
|
328 |
|
|
329 |
=head2 search |
=head2 search |
330 |
|
|
334 |
|
|
335 |
=cut |
=cut |
336 |
|
|
337 |
sub search { _field( 'search', @_ ) } |
sub search { to( 'search', @_ ) } |
338 |
|
|
339 |
=head2 sorted |
=head2 sorted |
340 |
|
|
344 |
|
|
345 |
=cut |
=cut |
346 |
|
|
347 |
sub sorted { _field( 'sorted', @_ ) } |
sub sorted { to( 'sorted', @_ ) } |
|
|
|
348 |
|
|
349 |
|
|
350 |
=head1 Functions to extract data from input |
=head1 Functions to extract data from input |
366 |
|
|
367 |
warn "## _pack_subfields_hash( ",dump(@_), " )\n" if ($debug > 1); |
warn "## _pack_subfields_hash( ",dump(@_), " )\n" if ($debug > 1); |
368 |
|
|
369 |
my ($h,$include_subfields) = @_; |
my ($hash,$include_subfields) = @_; |
370 |
|
|
371 |
# sanity and ease of use |
# sanity and ease of use |
372 |
return $h if (ref($h) ne 'HASH'); |
return $hash if (ref($hash) ne 'HASH'); |
373 |
|
|
374 |
|
my $h = dclone( $hash ); |
375 |
|
|
376 |
if ( defined($h->{subfields}) ) { |
if ( defined($h->{subfields}) ) { |
377 |
my $sfs = delete $h->{subfields} || die "no subfields?"; |
my $sfs = delete $h->{subfields} || die "no subfields?"; |
462 |
} else { |
} else { |
463 |
$_->{$sf}; |
$_->{$sf}; |
464 |
} |
} |
465 |
} grep { ref($_) eq 'HASH' && $_->{$sf} } @{ $rec->{$f} }; |
} grep { ref($_) eq 'HASH' && defined $_->{$sf} } @{ $rec->{$f} }; |
466 |
} |
} |
467 |
|
|
468 |
=head2 rec |
=head2 rec |