/[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 1037 by dpavlin, Mon Nov 12 11:17:19 2007 UTC revision 1214 by dpavlin, Tue Jun 2 13:14:59 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 20  our @EXPORT = qw/ Line 21  our @EXPORT = qw/
21          get set          get set
22          count          count
23    
24            row
25            rec_array
26    
27  /;  /;
28    
29  use warnings;  use warnings;
# Line 46  push @EXPORT, ( qw/ Line 50  push @EXPORT, ( qw/
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
58    
59  =cut  =cut
60    
61  our $VERSION = '0.35';  our $VERSION = '0.36';
62    
63  =head1 SYNOPSIS  =head1 SYNOPSIS
64    
# Line 263  sub _debug { Line 269  sub _debug {
269          warn "debug level $l",$/ if ($l > 0);          warn "debug level $l",$/ if ($l > 0);
270          $debug = $l;          $debug = $l;
271          $WebPAC::Normalize::MARC::debug = $debug;          $WebPAC::Normalize::MARC::debug = $debug;
 warn "#### MARC::debug = ",dump($WebPAC::Normalize::MARC::debug);  
272  }  }
273    
274  =head1 Functions to create C<data_structure>  =head1 Functions to create C<data_structure>
275    
276  Those functions generally have to first in your normalization file.  Those functions generally have to first in your normalization file.
277    
278    =head2 to
279    
280    Generic way to set values for some name
281    
282      to('field-name', 'name-value' => rec('200','a') );
283    
284    There are many helpers defined below which might be easier to use.
285    
286    =cut
287    
288    sub to {
289            my $type = shift or confess "need type -- BUG?";
290            my $name = shift or confess "needs name as first argument";
291            my @o = grep { defined($_) && $_ ne '' } @_;
292            return unless (@o);
293            $out->{$name}->{$type} = \@o;
294    }
295    
296  =head2 search_display  =head2 search_display
297    
298  Define output for L<search> and L<display> at the same time  Define output for L<search> and L<display> at the same time
299    
300    search_display('Title', rec('200','a') );    search_display('Title', rec('200','a') );
301    
   
302  =cut  =cut
303    
304  sub search_display {  sub search_display {
# Line 289  sub search_display { Line 311  sub search_display {
311    
312  =head2 tag  =head2 tag
313    
314  Old name for L<search_display>, but supported  Old name for L<search_display>, it will probably be removed at one point.
315    
316  =cut  =cut
317    
# Line 305  Define output just for I<display> Line 327  Define output just for I<display>
327    
328  =cut  =cut
329    
330  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', @_ ) }  
331    
332  =head2 search  =head2 search
333    
# Line 323  Prepare values just for I<search> Line 337  Prepare values just for I<search>
337    
338  =cut  =cut
339    
340  sub search { _field( 'search', @_ ) }  sub search { to( 'search', @_ ) }
341    
342  =head2 sorted  =head2 sorted
343    
# Line 333  Insert into lists which will be automati Line 347  Insert into lists which will be automati
347    
348  =cut  =cut
349    
350  sub sorted { _field( '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
# Line 356  sub _pack_subfields_hash { Line 385  sub _pack_subfields_hash {
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?";
# Line 450  sub rec2 { Line 481  sub rec2 {
481                  } else {                  } else {
482                          $_->{$sf};                          $_->{$sf};
483                  }                  }
484          } grep { ref($_) eq 'HASH' && $_->{$sf} } @{ $rec->{$f} };          } grep { ref($_) eq 'HASH' && defined $_->{$sf} } @{ $rec->{$f} };
485  }  }
486    
487  =head2 rec  =head2 rec
# Line 919  sub count { Line 950  sub count {
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;

Legend:
Removed from v.1037  
changed lines
  Added in v.1214

  ViewVC Help
Powered by ViewVC 1.1.26