/[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 371 by dpavlin, Sun Jan 8 21:16:27 2006 UTC revision 375 by dpavlin, Sun Jan 8 22:21:24 2006 UTC
# Line 198  sub data_structure { Line 198  sub data_structure {
198    
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->_rec_to_arr($rec,$format,'fill_in');
202                          } else {                          } else {
203                                  @v = $self->parse_to_arr($rec,$format);                                  @v = $self->_rec_to_arr($rec,$format,'parse');
204                          }                          }
205                          if (! @v) {                          if (! @v) {
206                                  $log->debug("$field <",$self->{tag},"> format: $format no values");                                  $log->debug("$field <",$self->{tag},"> format: $format no values");
207  #                               next;                                  next;
208                          } else {                          } else {
209                                  $log->debug("$field <",$self->{tag},"> format: $format values: ", join(",", @v));                                  $log->debug("$field <",$self->{tag},"> format: $format values: ", join(",", @v));
210                          }                          }
# Line 410  sub parse { Line 410  sub parse {
410          return $out;          return $out;
411  }  }
412    
 =head2 parse_to_arr  
   
 Similar to C<parse>, but returns array of all repeatable fields  
   
  my @arr = $webpac->parse_to_arr($rec,'v250^a');  
   
 =cut  
   
 sub parse_to_arr {  
         my $self = shift;  
   
         my ($rec, $format_utf8) = @_;  
   
         my $log = $self->_get_logger();  
   
         $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);  
         return if (! $format_utf8);  
   
         my $i = 0;  
         my @arr;  
   
         my $rec_size = { '_' => '_' };  
   
         while (my $v = $self->parse($rec,$format_utf8,$i++,\$rec_size)) {  
                 push @arr, $v;  
                 warn "parse rec_size = ", Dumper($rec_size);  
         }  
   
         $log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);  
   
         return @arr;  
 }  
   
   
413  =head2 fill_in  =head2 fill_in
414    
415  Workhourse of all: takes record from in-memory structure of database and  Workhourse of all: takes record from in-memory structure of database and
# Line 546  sub fill_in { Line 512  sub fill_in {
512  }  }
513    
514    
515  =head2 fill_in_to_arr  =head2 _rec_to_arr
516    
517  Similar to C<fill_in>, but returns array of all repeatable fields. Usable  Similar to C<parse> and C<fill_in>, but returns array of all repeatable fields. Usable
518  for fields which have lookups, so they shouldn't be parsed but rather  for fields which have lookups, so they shouldn't be parsed but rather
519  C<fill_id>ed.  C<paste>d or C<fill_id>ed. Last argument is name of operation: C<paste> or C<fill_in>.
520    
521   my @arr = $webpac->fill_in_to_arr($rec,'[v900];;[v250^a]');   my @arr = $webpac->fill_in_to_arr($rec,'[v900];;[v250^a]','paste');
522    
523  =cut  =cut
524    
525  sub fill_in_to_arr {  sub _rec_to_arr {
526          my $self = shift;          my $self = shift;
527    
528          my ($rec, $format_utf8) = @_;          my ($rec, $format_utf8, $code) = @_;
529    
530          my $log = $self->_get_logger();          my $log = $self->_get_logger();
531    
532          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
533          return if (! $format_utf8);          return if (! $format_utf8);
534    
535            $log->debug("using $code on $format_utf8");
536    
537          my $i = 0;          my $i = 0;
538            my $max = 0;
539          my @arr;          my @arr;
540            my $rec_size = {};
541    
542          my $rec_size;          while ($i <= $max) {
543                    my @v = $self->$code($rec,$format_utf8,$i++,\$rec_size);
544          while (my $v = $self->fill_in($rec,$format_utf8,$i,\$rec_size)) {                  if ($rec_size) {
545                  push @arr, $v;                          foreach my $f (keys %{ $rec_size }) {
546                  warn "rec_size = ", Dumper($rec_size);                                  $max = $rec_size->{$f} if ($rec_size->{$f} > $max);
547                            }
548                            $log->debug("max set to $max");
549                            undef $rec_size;
550                    }
551                    if (@v) {
552                            push @arr, @v;
553                    } else {
554                            push @arr, '' if ($max > $i);
555                    }
556          }          }
557    
558          $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);

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

  ViewVC Help
Powered by ViewVC 1.1.26