/[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 564 by dpavlin, Sun Jul 2 20:14:21 2006 UTC revision 568 by dpavlin, Sun Jul 2 21:30:00 2006 UTC
# Line 299  Change level of debug warnings Line 299  Change level of debug warnings
299  sub _debug {  sub _debug {
300          my $l = shift;          my $l = shift;
301          return $debug unless defined($l);          return $debug unless defined($l);
302          warn "debug level $l" if ($l > 0);          warn "debug level $l",$/ if ($l > 0);
303          $debug = $l;          $debug = $l;
304  }  }
305    
# Line 457  sub marc_compose { Line 457  sub marc_compose {
457    
458          while (@_) {          while (@_) {
459                  my $sf = shift or die "marc_compose $f needs subfield";                  my $sf = shift or die "marc_compose $f needs subfield";
460                  my $v = shift or die "marc_compose $f needs value for subfield $sf";                  my $v = shift;
461    
462                  next unless (defined($v) && $v !~ /^\s*$/);                  next unless (defined($v) && $v !~ /^\s*$/);
463                  from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);                  from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
464                  push @$m, ( $sf, $v );                  push @$m, ( $sf, $v );
465                  warn "## ++ marc_compose($f,$sf,$v) ", dump( $m ) if ($debug > 1);                  warn "## ++ marc_compose($f,$sf,$v) ", dump( $m ),$/ if ($debug > 1);
466          }          }
467    
468          warn "## marc_compose(d) ", dump( $m ) if ($debug > 1);          warn "## marc_compose(d) ", dump( $m ),$/ if ($debug > 1);
469    
470          push @{ $marc_record }, $m;          push @{ $marc_record }, $m if ($#{$m} > 2);
471  }  }
472    
473    
# Line 658  sub split_rec_on { Line 658  sub split_rec_on {
658          die "split_rec_on need (fld,sf,regex[,part]" if ($#_ < 2);          die "split_rec_on need (fld,sf,regex[,part]" if ($#_ < 2);
659    
660          my ($fld, $sf, $regex, $part) = @_;          my ($fld, $sf, $regex, $part) = @_;
661          warn "### regex ", ref($regex), $regex if ($debug > 2);          warn "### regex ", ref($regex), $regex, $/ if ($debug > 2);
662    
663          my @r = rec( $fld, $sf );          my @r = rec( $fld, $sf );
664          my $v = shift @r;          my $v = shift @r;
665          warn "### first rec($fld,$sf) = ",dump($v) if ($debug > 2);          warn "### first rec($fld,$sf) = ",dump($v),$/ if ($debug > 2);
666    
667            return '' if( ! defined($v) || $v =~ /^\s*$/);
668    
669          my @s = split( $regex, $v );          my @s = split( $regex, $v );
670          warn "## split_rec_on($fld,$sf,$regex,$part) = ",dump(@s) if ($debug > 1);          warn "## split_rec_on($fld,$sf,$regex,$part) = ",dump(@s),$/ if ($debug > 1);
671          if ($part > 0) {          if ($part && $part > 0) {
672                  return $s[ $part - 1 ];                  return $s[ $part - 1 ];
673          } else {          } else {
674                  return @s;                  return [ @s ];
675          }          }
676  }  }
677    

Legend:
Removed from v.564  
changed lines
  Added in v.568

  ViewVC Help
Powered by ViewVC 1.1.26