/[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 344 by dpavlin, Sat Jan 7 02:05:55 2006 UTC revision 371 by dpavlin, Sun Jan 8 21:16:27 2006 UTC
# Line 2  package WebPAC::Normalize; Line 2  package WebPAC::Normalize;
2    
3  use warnings;  use warnings;
4  use strict;  use strict;
5    use blib;
6    use WebPAC::Common;
7  use base 'WebPAC::Common';  use base 'WebPAC::Common';
8  use Data::Dumper;  use Data::Dumper;
9    
# Line 194  sub data_structure { Line 196  sub data_structure {
196                          $log->logdie("expected tag HASH and got $tag") unless (ref($tag) eq 'HASH');                          $log->logdie("expected tag HASH and got $tag") unless (ref($tag) eq 'HASH');
197                          $format = $tag->{'value'} || $tag->{'content'};                          $format = $tag->{'value'} || $tag->{'content'};
198    
                         $log->debug("format: $format");  
   
199                          my @v;                          my @v;
200                          if ($self->{'lookup_regex'} && $format =~ $self->{'lookup_regex'}) {                          if ($self->{'lookup_regex'} && $format =~ $self->{'lookup_regex'}) {
201                                  @v = $self->fill_in_to_arr($rec,$format);                                  @v = $self->fill_in_to_arr($rec,$format);
202                          } else {                          } else {
203                                  @v = $self->parse_to_arr($rec,$format);                                  @v = $self->parse_to_arr($rec,$format);
204                          }                          }
205                          next if (! @v);                          if (! @v) {
206                                    $log->debug("$field <",$self->{tag},"> format: $format no values");
207    #                               next;
208                            } else {
209                                    $log->debug("$field <",$self->{tag},"> format: $format values: ", join(",", @v));
210                            }
211    
212                          if ($tag->{'sort'}) {                          if ($tag->{'sort'}) {
213                                  @v = $self->sort_arr(@v);                                  @v = $self->sort_arr(@v);
# Line 225  sub data_structure { Line 230  sub data_structure {
230    
231                          foreach my $type (@types) {                          foreach my $type (@types) {
232                                  # append to previous line?                                  # append to previous line?
233                                  $log->debug("type: $type ",sub { join(" ",@v) }, " ", $row->{'append'} || 'no append');                                  $log->debug("tag $field / $type [",sub { join(",",@v) }, "] ", $row->{'append'} || 'no append');
234                                  if ($tag->{'append'}) {                                  if ($tag->{'append'}) {
235    
236                                          # I will delimit appended part with                                          # I will delimit appended part with
# Line 303  my $warn_once; Line 308  my $warn_once;
308  sub parse {  sub parse {
309          my $self = shift;          my $self = shift;
310    
311          my ($rec, $format_utf8, $i) = @_;          my ($rec, $format_utf8, $i, $rec_size) = @_;
312    
313          return if (! $format_utf8);          return if (! $format_utf8);
314    
# Line 352  sub parse { Line 357  sub parse {
357                  }                  }
358    
359                  my $found = 0;                  my $found = 0;
360                  my $tmp = $self->get_data(\$rec,$3,$4,$r,\$found);                  my $tmp = $self->get_data(\$rec,$3,$4,$r,\$found,$rec_size);
361    
362                  if ($found) {                  if ($found) {
363                          $found_any->{$fld_type} += $found;                          $found_any->{$fld_type} += $found;
# Line 426  sub parse_to_arr { Line 431  sub parse_to_arr {
431          my $i = 0;          my $i = 0;
432          my @arr;          my @arr;
433    
434          while (my $v = $self->parse($rec,$format_utf8,$i++)) {          my $rec_size = { '_' => '_' };
435    
436            while (my $v = $self->parse($rec,$format_utf8,$i++,\$rec_size)) {
437                  push @arr, $v;                  push @arr, $v;
438                    warn "parse rec_size = ", Dumper($rec_size);
439          }          }
440    
441          $log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);          $log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);
# Line 457  delimiters before fields which aren't us Line 465  delimiters before fields which aren't us
465  This method will automatically decode UTF-8 string to local code page  This method will automatically decode UTF-8 string to local code page
466  if needed.  if needed.
467    
468    There is optional parametar C<$record_size> which can be used to get sizes of
469    all C<field^subfield> combinations in this format.
470    
471     my $text = $webpac->fill_in($rec,'got: v900^a v900^x',0,\$rec_size);
472    
473  =cut  =cut
474    
475  sub fill_in {  sub fill_in {
# Line 464  sub fill_in { Line 477  sub fill_in {
477    
478          my $log = $self->_get_logger();          my $log = $self->_get_logger();
479    
480          my $rec = shift || $log->logconfess("need data record");          my ($rec,$format,$i,$rec_size) = @_;
481          my $format = shift || $log->logconfess("need format to parse");  
482            $log->logconfess("need data record") unless ($rec);
483            $log->logconfess("need format to parse") unless($format);
484    
485          # iteration (for repeatable fields)          # iteration (for repeatable fields)
486          my $i = shift || 0;          $i ||= 0;
487    
488          $log->logdie("infitite loop in format $format") if ($i > ($self->{'max_mfn'} || 9999));          $log->logdie("infitite loop in format $format") if ($i > ($self->{'max_mfn'} || 9999));
489    
# Line 491  sub fill_in { Line 507  sub fill_in {
507    
508          # do actual replacement of placeholders          # do actual replacement of placeholders
509          # repeatable fields          # repeatable fields
510          if ($format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found)/ges) {          if ($format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found,$rec_size)/ges) {
511                  $just_single = 0;                  $just_single = 0;
512          }          }
513            
514          # non-repeatable fields          # non-repeatable fields
515          if ($format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found)/ges) {          if ($format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found,$rec_size)/ges) {
516                  return if ($i > 0 && $just_single);                  return if ($i > 0 && $just_single);
517          }          }
518    
# Line 553  sub fill_in_to_arr { Line 569  sub fill_in_to_arr {
569          my $i = 0;          my $i = 0;
570          my @arr;          my @arr;
571    
572          while (my @v = $self->fill_in($rec,$format_utf8,$i++)) {          my $rec_size;
573                  push @arr, @v;  
574            while (my $v = $self->fill_in($rec,$format_utf8,$i,\$rec_size)) {
575                    push @arr, $v;
576                    warn "rec_size = ", Dumper($rec_size);
577          }          }
578    
579          $log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);          $log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);
# Line 567  sub fill_in_to_arr { Line 586  sub fill_in_to_arr {
586    
587  Returns value from record.  Returns value from record.
588    
589   my $text = $self->get_data(\$rec,$f,$sf,$i,\$found);   my $text = $self->get_data(\$rec,$f,$sf,$i,\$found,\$rec_size);
590    
591    Required arguments are:
592    
593    =over 8
594    
595    =item C<$rec>
596    
597    record reference
598    
599    =item C<$f>
600    
601  Arguments are:  field
 record reference C<$rec>,  
 field C<$f>,  
 optional subfiled C<$sf>,  
 index for repeatable values C<$i>.  
602    
603  Optinal variable C<$found> will be incremeted if there  =item C<$sf>
 is field.  
604    
605  Returns value or empty string.  optional subfield
606    
607    =item C<$i>
608    
609    index offset for repeatable values ( 0 ... $rec_size->{'400^a'} )
610    
611    =item C<$found>
612    
613    optional variable that will be incremeted if preset
614    
615    =item C<$rec_size>
616    
617    hash to hold maximum occurances of C<field^subfield> combinations
618    (which can be accessed using keys in same format)
619    
620    =back
621    
622    Returns value or empty string, updates C<$found> and C<rec_size>
623    if present.
624    
625  =cut  =cut
626    
627  sub get_data {  sub get_data {
628          my $self = shift;          my $self = shift;
629    
630          my ($rec,$f,$sf,$i,$found) = @_;          my ($rec,$f,$sf,$i,$found,$cache) = @_;
631    
632          if ($$rec->{$f}) {          return '' unless ($$rec->{$f} && ref($$rec->{$f}) eq 'ARRAY');
633                  return '' if (! $$rec->{$f}->[$i]);  
634            if (defined($$cache)) {
635                    $$cache->{ $f . ( $sf ? '^' . $sf : '' ) } ||= scalar @{ $$rec->{$f} };
636            }
637    
638            return '' unless ($$rec->{$f}->[$i]);
639    
640            {
641                  no strict 'refs';                  no strict 'refs';
642                  if ($sf && $$rec->{$f}->[$i]->{$sf}) {                  if (defined($sf)) {
643                          $$found++ if (defined($$found));                          $$found++ if (defined($$found) && $$rec->{$f}->[$i]->{$sf});
644                          return $$rec->{$f}->[$i]->{$sf};                          return $$rec->{$f}->[$i]->{$sf};
645                  } elsif (! $sf && $$rec->{$f}->[$i]) {                  } else {
646                          $$found++ if (defined($$found));                          $$found++ if (defined($$found));
647                          # it still might have subfield, just                          # it still might have subfields, just
648                          # not specified, so we'll dump all                          # not specified, so we'll dump some debug info
649                          if ($$rec->{$f}->[$i] =~ /HASH/o) {                          if ($$rec->{$f}->[$i] =~ /HASH/o) {
650                                  my $out;                                  my $out;
651                                  foreach my $k (keys %{$$rec->{$f}->[$i]}) {                                  foreach my $k (keys %{$$rec->{$f}->[$i]}) {
652                                          $out .= $$rec->{$f}->[$i]->{$k}." ";                                          $out .= '$' . $k .':' . $$rec->{$f}->[$i]->{$k}." ";
653                                  }                                  }
654                                  return $out;                                  return $out;
655                          } else {                          } else {
656                                  return $$rec->{$f}->[$i];                                  return $$rec->{$f}->[$i];
657                          }                          }
                 } else {  
                         return '';  
658                  }                  }
         } else {  
                 return '';  
659          }          }
660  }  }
661    

Legend:
Removed from v.344  
changed lines
  Added in v.371

  ViewVC Help
Powered by ViewVC 1.1.26