/[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 574 by dpavlin, Mon Jul 3 21:08:07 2006 UTC revision 592 by dpavlin, Sun Jul 9 15:22:30 2006 UTC
# Line 35  WebPAC::Normalize - describe normalisato Line 35  WebPAC::Normalize - describe normalisato
35    
36  =head1 VERSION  =head1 VERSION
37    
38  Version 0.10  Version 0.12
39    
40  =cut  =cut
41    
42  our $VERSION = '0.10';  our $VERSION = '0.12';
43    
44  =head1 SYNOPSIS  =head1 SYNOPSIS
45    
# Line 326  sub _get_marc_fields { Line 326  sub _get_marc_fields {
326                  warn "## saved/3 ", dump( $field ),$/ if ($debug);                  warn "## saved/3 ", dump( $field ),$/ if ($debug);
327          }          }
328    
329          return @m;          return \@m;
330  }  }
331    
332  =head2 _debug  =head2 _debug
# Line 504  sub marc_compose { Line 504  sub marc_compose {
504          my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');          my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');
505          my $m = [ $f, $i1, $i2 ];          my $m = [ $f, $i1, $i2 ];
506    
507            warn "### marc_compose input subfields = ", dump(@_),$/ if ($debug > 2);
508    
509          while (@_) {          while (@_) {
510                  my $sf = shift or die "marc_compose $f needs subfield";                  my $sf = shift or die "marc_compose $f needs subfield";
511                  my $v = shift;                  my $v = shift;
# Line 514  sub marc_compose { Line 516  sub marc_compose {
516                  warn "## ++ marc_compose($f,$sf,$v) ", dump( $m ),$/ if ($debug > 1);                  warn "## ++ marc_compose($f,$sf,$v) ", dump( $m ),$/ if ($debug > 1);
517          }          }
518    
519          warn "## marc_compose(d) ", dump( $m ),$/ if ($debug > 1);          warn "## marc_compose current marc = ", dump( $m ),$/ if ($debug > 1);
520    
521          push @{ $marc_record->[ $marc_record_offset ] }, $m if ($#{$m} > 2);          push @{ $marc_record->[ $marc_record_offset ] }, $m if ($#{$m} > 2);
522  }  }
# Line 565  sub marc_remove { Line 567  sub marc_remove {
567    
568          warn "### marc_remove before = ", dump( $marc ), $/ if ($debug > 2);          warn "### marc_remove before = ", dump( $marc ), $/ if ($debug > 2);
569    
570          foreach my $i ( 0 .. $#{ $marc } ) {          my $i = 0;
571            foreach ( 0 .. $#{ $marc } ) {
572                  last unless (defined $marc->[$i]);                  last unless (defined $marc->[$i]);
573                  warn "#### working on ",dump( @{ $marc->[$i] }), $/ if ($debug > 3);                  warn "#### working on ",dump( @{ $marc->[$i] }), $/ if ($debug > 3);
574                  if ($marc->[$i]->[0] eq $f) {                  if ($marc->[$i]->[0] eq $f) {
# Line 591  sub marc_remove { Line 594  sub marc_remove {
594                                  }                                  }
595                          }                          }
596                  }                  }
597                    $i++;
598          }          }
599    
600          warn "### marc_remove($f", $sf ? ",$sf" : "", ") after = ", dump( $marc ), $/ if ($debug > 2);          warn "### marc_remove($f", $sf ? ",$sf" : "", ") after = ", dump( $marc ), $/ if ($debug > 2);
# Line 645  sub rec2 { Line 649  sub rec2 {
649          my $f = shift;          my $f = shift;
650          return unless (defined($rec && $rec->{$f}));          return unless (defined($rec && $rec->{$f}));
651          my $sf = shift;          my $sf = shift;
652          return map { $_->{$sf} } grep { ref($_) eq 'HASH' && $_->{$sf} } @{ $rec->{$f} };          return map {
653                    if (ref($_->{$sf}) eq 'ARRAY') {
654                            @{ $_->{$sf} };
655                    } else {
656                            $_->{$sf};
657                    }
658            } grep { ref($_) eq 'HASH' && $_->{$sf} } @{ $rec->{$f} };
659  }  }
660    
661  =head2 rec  =head2 rec
# Line 658  syntaxtic sugar for Line 668  syntaxtic sugar for
668  =cut  =cut
669    
670  sub rec {  sub rec {
671            my @out;
672          if ($#_ == 0) {          if ($#_ == 0) {
673                  return rec1(@_);                  @out = rec1(@_);
674          } elsif ($#_ == 1) {          } elsif ($#_ == 1) {
675                  return rec2(@_);                  @out = rec2(@_);
676            }
677            if (@out) {
678                    return @out;
679            } else {
680                    return '';
681          }          }
682  }  }
683    
# Line 694  Prefix all values with a string Line 710  Prefix all values with a string
710  =cut  =cut
711    
712  sub prefix {  sub prefix {
713          my $p = shift or die "prefix needs string as first argument";          my $p = shift or return;
714          return map { $p . $_ } grep { defined($_) } @_;          return map { $p . $_ } grep { defined($_) } @_;
715  }  }
716    
# Line 767  Joins walues with some delimiter Line 783  Joins walues with some delimiter
783    
784  sub join_with {  sub join_with {
785          my $d = shift;          my $d = shift;
786          return join($d, grep { defined($_) && $_ ne '' } @_);          warn "### join_with('$d',",dump(@_),")\n" if ($debug > 2);
787            my $v = join($d, grep { defined($_) && $_ ne '' } @_);
788            return '' unless defined($v);
789            return $v;
790  }  }
791    
792  =head2 split_rec_on  =head2 split_rec_on

Legend:
Removed from v.574  
changed lines
  Added in v.592

  ViewVC Help
Powered by ViewVC 1.1.26