/[webpac2]/trunk/lib/WebPAC/Normalize.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Normalize.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1036 by dpavlin, Mon Nov 12 11:10:48 2007 UTC revision 1118 by dpavlin, Sun Oct 26 15:57:37 2008 UTC
# Line 7  our @EXPORT = qw/ Line 7  our @EXPORT = qw/
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
# Line 27  use strict; Line 28  use strict;
28    
29  #use base qw/WebPAC::Common/;  #use base qw/WebPAC::Common/;
30  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
 use Storable qw/dclone/;  
31  use Carp qw/confess/;  use Carp qw/confess/;
32    
33  # debugging warn(s)  # debugging warn(s)
34  my $debug = 0;  my $debug = 0;
35    _debug( $debug );
36    
37  # FIXME  # FIXME
38  use WebPAC::Normalize::ISBN;  use WebPAC::Normalize::ISBN;
# Line 46  push @EXPORT, ( qw/ Line 47  push @EXPORT, ( qw/
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    
# Line 269  sub _debug { Line 272  sub _debug {
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 {
# Line 288  sub search_display { Line 308  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    
# Line 304  Define output just for I<display> Line 324  Define output just for I<display>
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    
# Line 322  Prepare values just for I<search> Line 334  Prepare values just for I<search>
334    
335  =cut  =cut
336    
337  sub search { _field( 'search', @_ ) }  sub search { to( 'search', @_ ) }
338    
339  =head2 sorted  =head2 sorted
340    
# Line 332  Insert into lists which will be automati Line 344  Insert into lists which will be automati
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
# Line 355  sub _pack_subfields_hash { Line 366  sub _pack_subfields_hash {
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?";
# Line 449  sub rec2 { Line 462  sub rec2 {
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

Legend:
Removed from v.1036  
changed lines
  Added in v.1118

  ViewVC Help
Powered by ViewVC 1.1.26