/[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 740 by dpavlin, Sat Oct 7 16:33:37 2006 UTC revision 766 by dpavlin, Tue Oct 31 13:19:47 2006 UTC
# Line 39  WebPAC::Normalize - describe normalisato Line 39  WebPAC::Normalize - describe normalisato
39    
40  =head1 VERSION  =head1 VERSION
41    
42  Version 0.22  Version 0.23
43    
44  =cut  =cut
45    
46  our $VERSION = '0.22';  our $VERSION = '0.23';
47    
48  =head1 SYNOPSIS  =head1 SYNOPSIS
49    
# Line 164  Return hash formatted as data structure Line 164  Return hash formatted as data structure
164    
165  =cut  =cut
166    
167  my ($out, $marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators);  my ($out, $marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $leader);
168  my ($marc_record_offset, $marc_fetch_offset) = (0, 0);  my ($marc_record_offset, $marc_fetch_offset) = (0, 0);
169    
170  sub _get_ds {  sub _get_ds {
# Line 181  Clean data structure hash for next recor Line 181  Clean data structure hash for next recor
181    
182  sub _clean_ds {  sub _clean_ds {
183          my $a = {@_};          my $a = {@_};
184          ($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators) = ();          ($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $leader) = ();
185          ($marc_record_offset, $marc_fetch_offset) = (0,0);          ($marc_record_offset, $marc_fetch_offset) = (0,0);
186          $marc_encoding = $a->{marc_encoding};          $marc_encoding = $a->{marc_encoding};
187  }  }
# Line 487  sub marc_leader { Line 487  sub marc_leader {
487          my ($offset,$value) = @_;          my ($offset,$value) = @_;
488    
489          if ($offset) {          if ($offset) {
490                  $out->{' leader'}->{ $offset } = $value;                  $leader->{ $offset } = $value;
491          } else {          } else {
492                  return $out->{' leader'};                  return $leader;
493          }          }
494  }  }
495    
# Line 880  syntaxtic sugar for Line 880  syntaxtic sugar for
880    @v = rec('200')    @v = rec('200')
881    @v = rec('200','a')    @v = rec('200','a')
882    
883    If rec() returns just single value, it will
884    return scalar, not array.
885    
886  =cut  =cut
887    
888  sub rec {  sub rec {
# Line 889  sub rec { Line 892  sub rec {
892          } elsif ($#_ == 1) {          } elsif ($#_ == 1) {
893                  @out = rec2(@_);                  @out = rec2(@_);
894          }          }
895          if (@out) {          if ($#out == 0 && ! wantarray) {
896                    return $out[0];
897            } elsif (@out) {
898                  return @out;                  return @out;
899          } else {          } else {
900                  return '';                  return '';
# Line 1017  Easy as pie, right? Line 1022  Easy as pie, right?
1022  sub lookup {  sub lookup {
1023          my ($what, $database, $input, $key, $having) = @_;          my ($what, $database, $input, $key, $having) = @_;
1024    
1025          confess "lookup needs 5 arguments: what, database, input, key, having" unless ($#_ == 4);          confess "lookup needs 5 arguments: what, database, input, key, having\n" unless ($#_ == 4);
1026    
1027          warn "## lookup ($database, $input, $key)", $/ if ($debug > 1);          warn "## lookup ($database, $input, $key)", $/ if ($debug > 1);
1028          return unless (defined($lookup->{$database}->{$input}->{$key}));          return unless (defined($lookup->{$database}->{$input}->{$key}));
# Line 1031  sub lookup { Line 1036  sub lookup {
1036    
1037          foreach my $h ( @having ) {          foreach my $h ( @having ) {
1038                  if (defined($lookup->{$database}->{$input}->{$key}->{$h})) {                  if (defined($lookup->{$database}->{$input}->{$key}->{$h})) {
1039                          warn "lookup for $database/$input/$key/$h return ",dump($lookup->{$database}->{$input}->{$key}->{$h}),"\n";                          warn "lookup for $database/$input/$key/$h return ",dump($lookup->{$database}->{$input}->{$key}->{$h}),"\n" if ($debug);
1040                          $mfns->{$_}++ foreach keys %{ $lookup->{$database}->{$input}->{$key}->{$h} };                          $mfns->{$_}++ foreach keys %{ $lookup->{$database}->{$input}->{$key}->{$h} };
1041                  }                  }
1042          }          }
# Line 1040  sub lookup { Line 1045  sub lookup {
1045    
1046          my @mfns = sort keys %$mfns;          my @mfns = sort keys %$mfns;
1047    
1048          warn "# lookup loading $database/$input/$key mfn ", join(",",@mfns)," having ",dump(@having),"\n";          warn "# lookup loading $database/$input/$key mfn ", join(",",@mfns)," having ",dump(@having),"\n" if ($debug);
1049    
1050          my $old_rec = $rec;          my $old_rec = $rec;
1051          my @out;          my @out;
# Line 1048  sub lookup { Line 1053  sub lookup {
1053          foreach my $mfn (@mfns) {          foreach my $mfn (@mfns) {
1054                  $rec = $load_row_coderef->( $database, $input, $mfn );                  $rec = $load_row_coderef->( $database, $input, $mfn );
1055    
1056                  warn "got $database/$input/$mfn = ", dump($rec), $/;                  warn "got $database/$input/$mfn = ", dump($rec), $/ if ($debug);
1057    
1058                  my @vals = $what->();                  my @vals = $what->();
1059    
1060                  push @out, ( @vals );                  push @out, ( @vals );
1061    
1062                  warn "lookup for mfn $mfn returned ", dump(@vals), $/;                  warn "lookup for mfn $mfn returned ", dump(@vals), $/ if ($debug);
1063          }          }
1064    
1065  #       if (ref($lookup->{$k}) eq 'ARRAY') {  #       if (ref($lookup->{$k}) eq 'ARRAY') {
# Line 1065  sub lookup { Line 1070  sub lookup {
1070    
1071          $rec = $old_rec;          $rec = $old_rec;
1072    
1073          warn "## lookup returns = ", dump(@out), $/;          warn "## lookup returns = ", dump(@out), $/ if ($debug);
1074    
1075          if ($#out == 0) {          if ($#out == 0) {
1076                  return $out[0];                  return $out[0];

Legend:
Removed from v.740  
changed lines
  Added in v.766

  ViewVC Help
Powered by ViewVC 1.1.26