/[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 364 by dpavlin, Sun Jan 8 20:27:11 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 306  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 355  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 429  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 460  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 467  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 494  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 556  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    
574            while (my $v = $self->fill_in($rec,$format_utf8,$i,\$rec_size)) {
575                  push @arr, $v;                  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 570  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    field
602    
603    =item C<$sf>
604    
605    optional subfield
606    
607  Arguments are:  =item C<$i>
 record reference C<$rec>,  
 field C<$f>,  
 optional subfiled C<$sf>,  
 index for repeatable values C<$i>.  
608    
609  Optinal variable C<$found> will be incremeted if there  index offset for repeatable values ( 0 ... $rec_size->{'400^a'} )
 is field.  
610    
611  Returns value or empty string.  =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            return '' unless ($$rec->{$f} && ref($$rec->{$f}) eq 'ARRAY');
633    
634          if ($$rec->{$f}) {          if (defined($$cache)) {
635                  return '' if (! $$rec->{$f}->[$i]);                  $$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                                          my $v = $$rec->{$f}->[$i]->{$k};                                          $out .= '$' . $k .':' . $$rec->{$f}->[$i]->{$k}." ";
                                         $out .= "$v " if ($v);  
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.364  
changed lines
  Added in v.371

  ViewVC Help
Powered by ViewVC 1.1.26