/[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 819 by dpavlin, Wed Apr 11 10:09:34 2007 UTC revision 915 by dpavlin, Tue Oct 30 20:27:20 2007 UTC
# Line 7  use Exporter 'import'; Line 7  use Exporter 'import';
7          _debug          _debug
8          _pack_subfields_hash          _pack_subfields_hash
9    
10          tag search display          search_display search display
11    
12          marc marc_indicators marc_repeatable_subfield          marc marc_indicators marc_repeatable_subfield
13          marc_compose marc_leader marc_fixed          marc_compose marc_leader marc_fixed
14          marc_duplicate marc_remove marc_count          marc_duplicate marc_remove marc_count
# Line 42  WebPAC::Normalize - describe normalisato Line 43  WebPAC::Normalize - describe normalisato
43    
44  =head1 VERSION  =head1 VERSION
45    
46  Version 0.29  Version 0.30
47    
48  =cut  =cut
49    
50  our $VERSION = '0.29';  our $VERSION = '0.30';
51    
52  =head1 SYNOPSIS  =head1 SYNOPSIS
53    
# Line 59  means that you check it's validity befor Line 60  means that you check it's validity befor
60  C<perl -c normalize.pl>.  C<perl -c normalize.pl>.
61    
62  Normalisation can generate multiple output normalized data. For now, supported output  Normalisation can generate multiple output normalized data. For now, supported output
63  types (on the left side of definition) are: C<tag>, C<display>, C<search> and  types (on the left side of definition) are: C<search_display>, C<display>, C<search> and
64  C<marc>.  C<marc>.
65    
66  =head1 FUNCTIONS  =head1 FUNCTIONS
# Line 442  sub _debug { Line 443  sub _debug {
443    
444  Those functions generally have to first in your normalization file.  Those functions generally have to first in your normalization file.
445    
446  =head2 tag  =head2 search_display
447    
448  Define new tag for I<search> and I<display>.  Define output for L<search> and L<display> at the same time
449    
450    tag('Title', rec('200','a') );    search_display('Title', rec('200','a') );
451    
452    
453  =cut  =cut
454    
455  sub tag {  sub search_display {
456          my $name = shift or die "tag needs name as first argument";          my $name = shift or die "search_display needs name as first argument";
457          my @o = grep { defined($_) && $_ ne '' } @_;          my @o = grep { defined($_) && $_ ne '' } @_;
458          return unless (@o);          return unless (@o);
         $out->{$name}->{tag} = $name;  
459          $out->{$name}->{search} = \@o;          $out->{$name}->{search} = \@o;
460          $out->{$name}->{display} = \@o;          $out->{$name}->{display} = \@o;
461  }  }
462    
463    =head2 tag
464    
465    Old name for L<search_display>, but supported
466    
467    =cut
468    
469    sub tag {
470            search_display( @_ );
471    }
472    
473  =head2 display  =head2 display
474    
475  Define tag just for I<display>  Define output just for I<display>
476    
477    @v = display('Title', rec('200','a') );    @v = display('Title', rec('200','a') );
478    
# Line 472  sub display { Line 482  sub display {
482          my $name = shift or die "display needs name as first argument";          my $name = shift or die "display needs name as first argument";
483          my @o = grep { defined($_) && $_ ne '' } @_;          my @o = grep { defined($_) && $_ ne '' } @_;
484          return unless (@o);          return unless (@o);
         $out->{$name}->{tag} = $name;  
485          $out->{$name}->{display} = \@o;          $out->{$name}->{display} = \@o;
486  }  }
487    
# Line 488  sub search { Line 497  sub search {
497          my $name = shift or die "search needs name as first argument";          my $name = shift or die "search needs name as first argument";
498          my @o = grep { defined($_) && $_ ne '' } @_;          my @o = grep { defined($_) && $_ ne '' } @_;
499          return unless (@o);          return unless (@o);
         $out->{$name}->{tag} = $name;  
500          $out->{$name}->{search} = \@o;          $out->{$name}->{search} = \@o;
501  }  }
502    
# Line 535  sub marc_fixed { Line 543  sub marc_fixed {
543          my ($f, $pos, $val) = @_;          my ($f, $pos, $val) = @_;
544          die "need marc(field, position, value)" unless defined($f) && defined($pos);          die "need marc(field, position, value)" unless defined($f) && defined($pos);
545    
546            confess "need val" unless defined $val;
547    
548          my $update = 0;          my $update = 0;
549    
550          map {          map {
551                  if ($_->[0] eq $f) {                  if ($_->[0] eq $f) {
552                          my $old = $_->[1];                          my $old = $_->[1];
553                          if (length($old) < $pos) {                          if (length($old) <= $pos) {
554                                  $_->[1] .= ' ' x ( $pos - length($old) ) . $val;                                  $_->[1] .= ' ' x ( $pos - length($old) ) . $val;
555                                  warn "## marc_fixed($f,$pos,'$val') append '$old' -> '$_->[1]'\n" if ($debug > 1);                                  warn "## marc_fixed($f,$pos,'$val') append '$old' -> '$_->[1]'\n" if ($debug > 1);
556                          } else {                          } else {
# Line 872  sub _pack_subfields_hash { Line 882  sub _pack_subfields_hash {
882    
883          my ($h,$include_subfields) = @_;          my ($h,$include_subfields) = @_;
884    
885            # sanity and ease of use
886            return $h if (ref($h) ne 'HASH');
887    
888          if ( defined($h->{subfields}) ) {          if ( defined($h->{subfields}) ) {
889                  my $sfs = delete $h->{subfields} || die "no subfields?";                  my $sfs = delete $h->{subfields} || die "no subfields?";
890                  my @out;                  my @out;
# Line 1227  Consult config values stored in C<config Line 1240  Consult config values stored in C<config
1240    $database_code = config();    # use _ from hash    $database_code = config();    # use _ from hash
1241    $database_name = config('name');    $database_name = config('name');
1242    $database_input_name = config('input name');    $database_input_name = config('input name');
   $tag = config('input normalize tag');  
1243    
1244  Up to three levels are supported.  Up to three levels are supported.
1245    

Legend:
Removed from v.819  
changed lines
  Added in v.915

  ViewVC Help
Powered by ViewVC 1.1.26