/[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 565 by dpavlin, Sun Jul 2 20:33:13 2006 UTC revision 572 by dpavlin, Mon Jul 3 14:32:40 2006 UTC
# Line 193  sub _get_marc_fields { Line 193  sub _get_marc_fields {
193          # first, sort all existing fields          # first, sort all existing fields
194          # XXX might not be needed, but modern perl might randomize elements in hash          # XXX might not be needed, but modern perl might randomize elements in hash
195          my @sorted_marc_record = sort {          my @sorted_marc_record = sort {
196                  $a->[0] . $a->[3] cmp $b->[0] . $b->[3]                  $a->[0] . ( $a->[3] || '' ) cmp $b->[0] . ( $b->[3] || '')
197          } @{ $marc_record };          } @{ $marc_record };
198    
199          @sorted_marc_record = @{ $marc_record };        ### FIXME disable sorting          @sorted_marc_record = @{ $marc_record };        ### FIXME disable sorting
# Line 203  sub _get_marc_fields { Line 203  sub _get_marc_fields {
203    
204          # count unique field-subfields (used for offset when walking to next subfield)          # count unique field-subfields (used for offset when walking to next subfield)
205          my $u;          my $u;
206          map { $u->{ $_->[0] . $_->[3]  }++ } @sorted_marc_record;          map { $u->{ $_->[0] . ( $_->[3] || '')  }++ } @sorted_marc_record;
207    
208          if ($debug) {          if ($debug) {
209                  warn "## marc_repeatable_subfield ", dump( $marc_repeatable_subfield ), $/;                  warn "## marc_repeatable_subfield ", dump( $marc_repeatable_subfield ), $/;
# Line 231  sub _get_marc_fields { Line 231  sub _get_marc_fields {
231    
232                  # field and subfield which is key for                  # field and subfield which is key for
233                  # marc_repeatable_subfield and u                  # marc_repeatable_subfield and u
234                  my $fsf = $row->[0] . $row->[3];                  my $fsf = $row->[0] . ( $row->[3] || '' );
235    
236                  if ($debug > 1) {                  if ($debug > 1) {
237    
# 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 381  sub marc_leader { Line 381  sub marc_leader {
381  Save value for MARC field  Save value for MARC field
382    
383    marc('900','a', rec('200','a') );    marc('900','a', rec('200','a') );
384      marc('001', rec('000') );
385    
386  =cut  =cut
387    
# Line 388  sub marc { Line 389  sub marc {
389          my $f = shift or die "marc needs field";          my $f = shift or die "marc needs field";
390          die "marc field must be numer" unless ($f =~ /^\d+$/);          die "marc field must be numer" unless ($f =~ /^\d+$/);
391    
392          my $sf = shift or die "marc needs subfield";          my $sf;
393            if ($f >= 10) {
394                    $sf = shift or die "marc needs subfield";
395            }
396    
397          foreach (@_) {          foreach (@_) {
398                  my $v = $_;             # make var read-write for Encode                  my $v = $_;             # make var read-write for Encode
399                  next unless (defined($v) && $v !~ /^\s*$/);                  next unless (defined($v) && $v !~ /^\s*$/);
400                  from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);                  from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
401                  my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');                  my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');
402                  push @{ $marc_record }, [ $f, $i1, $i2, $sf => $v ];                  if (defined $sf) {
403                            push @{ $marc_record }, [ $f, $i1, $i2, $sf => $v ];
404                    } else {
405                            push @{ $marc_record }, [ $f, $v ];
406                    }
407          }          }
408  }  }
409    
# Line 462  sub marc_compose { Line 470  sub marc_compose {
470                  next unless (defined($v) && $v !~ /^\s*$/);                  next unless (defined($v) && $v !~ /^\s*$/);
471                  from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);                  from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
472                  push @$m, ( $sf, $v );                  push @$m, ( $sf, $v );
473                  warn "## ++ marc_compose($f,$sf,$v) ", dump( $m ) if ($debug > 1);                  warn "## ++ marc_compose($f,$sf,$v) ", dump( $m ),$/ if ($debug > 1);
474          }          }
475    
476          warn "## marc_compose(d) ", dump( $m ) if ($debug > 1);          warn "## marc_compose(d) ", dump( $m ),$/ if ($debug > 1);
477    
478          push @{ $marc_record }, $m if ($#{$m} > 2);          push @{ $marc_record }, $m if ($#{$m} > 2);
479  }  }
# Line 488  TODO: order of values is probably same a Line 496  TODO: order of values is probably same a
496    
497  sub rec1 {  sub rec1 {
498          my $f = shift;          my $f = shift;
499            warn "rec1($f) = ", dump( $rec->{$f} ), $/ if ($debug > 1);
500          return unless (defined($rec) && defined($rec->{$f}));          return unless (defined($rec) && defined($rec->{$f}));
501            warn "rec1($f) = ", dump( $rec->{$f} ), $/ if ($debug > 1);
502          if (ref($rec->{$f}) eq 'ARRAY') {          if (ref($rec->{$f}) eq 'ARRAY') {
503                  return map {                  return map {
504                          if (ref($_) eq 'HASH') {                          if (ref($_) eq 'HASH') {
# Line 658  sub split_rec_on { Line 668  sub split_rec_on {
668          die "split_rec_on need (fld,sf,regex[,part]" if ($#_ < 2);          die "split_rec_on need (fld,sf,regex[,part]" if ($#_ < 2);
669    
670          my ($fld, $sf, $regex, $part) = @_;          my ($fld, $sf, $regex, $part) = @_;
671          warn "### regex ", ref($regex), $regex if ($debug > 2);          warn "### regex ", ref($regex), $regex, $/ if ($debug > 2);
672    
673          my @r = rec( $fld, $sf );          my @r = rec( $fld, $sf );
674          my $v = shift @r;          my $v = shift @r;
675          warn "### first rec($fld,$sf) = ",dump($v) if ($debug > 2);          warn "### first rec($fld,$sf) = ",dump($v),$/ if ($debug > 2);
676    
677            return '' if( ! defined($v) || $v =~ /^\s*$/);
678    
679          my @s = split( $regex, $v );          my @s = split( $regex, $v );
680          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);
681          if ($part > 0) {          if ($part && $part > 0) {
682                  return $s[ $part - 1 ];                  return $s[ $part - 1 ];
683          } else {          } else {
684                  return @s;                  return @s;

Legend:
Removed from v.565  
changed lines
  Added in v.572

  ViewVC Help
Powered by ViewVC 1.1.26