/[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 1205 by dpavlin, Fri May 29 20:32:13 2009 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 147  sub _set_ds { Line 150  sub _set_ds {
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
# Line 269  sub _debug { Line 278  sub _debug {
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 {
# Line 288  sub search_display { Line 314  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    
# Line 304  Define output just for I<display> Line 330  Define output just for I<display>
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    
# Line 322  Prepare values just for I<search> Line 340  Prepare values just for I<search>
340    
341  =cut  =cut
342    
343  sub search { _field( 'search', @_ ) }  sub search { to( 'search', @_ ) }
344    
345  =head2 sorted  =head2 sorted
346    
# Line 332  Insert into lists which will be automati Line 350  Insert into lists which will be automati
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
# Line 355  sub _pack_subfields_hash { Line 388  sub _pack_subfields_hash {
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?";
# Line 449  sub rec2 { Line 484  sub rec2 {
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

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

  ViewVC Help
Powered by ViewVC 1.1.26