/[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 368 by dpavlin, Sun Jan 8 20:32:06 2006 UTC revision 371 by dpavlin, Sun Jan 8 21:16:27 2006 UTC
# Line 308  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 357  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 431  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 462  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 469  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 496  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 558  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 572  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,\$fld_occurances);   my $text = $self->get_data(\$rec,$f,$sf,$i,\$found,\$rec_size);
590    
591  Required arguments are:  Required arguments are:
592    
# Line 592  optional subfield Line 606  optional subfield
606    
607  =item C<$i>  =item C<$i>
608    
609  index offset for repeatable values ( 0 ... $#occurances )  index offset for repeatable values ( 0 ... $rec_size->{'400^a'} )
610    
611  =item C<$found>  =item C<$found>
612    
613  optional variable that will be incremeted if preset  optional variable that will be incremeted if preset
614    
615  =item C<$fld_occurances>  =item C<$rec_size>
616    
617  hash to hold maximum occurances of C<field\tsubfield> combinations  hash to hold maximum occurances of C<field^subfield> combinations
618  (which can be accessed using keys in same format)  (which can be accessed using keys in same format)
619    
620  =back  =back
621    
622  Returns value or empty string, updates C<$found> and C<fld_occurences>  Returns value or empty string, updates C<$found> and C<rec_size>
623  if present.  if present.
624    
625  =cut  =cut
# Line 618  sub get_data { Line 632  sub get_data {
632          return '' unless ($$rec->{$f} && ref($$rec->{$f}) eq 'ARRAY');          return '' unless ($$rec->{$f} && ref($$rec->{$f}) eq 'ARRAY');
633    
634          if (defined($$cache)) {          if (defined($$cache)) {
635                  $$cache->{"$f\t$sf"} ||= $$#rec->{$f};                  $$cache->{ $f . ( $sf ? '^' . $sf : '' ) } ||= scalar @{ $$rec->{$f} };
636          }          }
637    
638          return '' unless ($$rec->{$f}->[$i]);          return '' unless ($$rec->{$f}->[$i]);

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

  ViewVC Help
Powered by ViewVC 1.1.26