/[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 397 by dpavlin, Wed Feb 15 15:54:12 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 505  sub fill_in { Line 471  sub fill_in {
471          # remove filter{...} from beginning          # remove filter{...} from beginning
472          $filter_name = $1 if ($format =~ s/^filter{([^}]+)}//s);          $filter_name = $1 if ($format =~ s/^filter{([^}]+)}//s);
473    
474          # do actual replacement of placeholders          {
475          # repeatable fields                  # fix warnings
476          if ($format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found,$rec_size)/ges) {                  no warnings 'uninitialized';
477                  $just_single = 0;  
478          }                  # do actual replacement of placeholders
479                    # repeatable fields
480                    if ($format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found,$rec_size)/ges) {
481                            $just_single = 0;
482                    }
483    
484          # non-repeatable fields                  # non-repeatable fields
485          if ($format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found,$rec_size)/ges) {                  if ($format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found,$rec_size)/ges) {
486                  return if ($i > 0 && $just_single);                          return if ($i > 0 && $just_single);
487                    }
488          }          }
489    
490          if ($found) {          if ($found) {
# Line 546  sub fill_in { Line 517  sub fill_in {
517  }  }
518    
519    
520  =head2 fill_in_to_arr  =head2 _rec_to_arr
521    
522  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
523  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
524  C<fill_id>ed.  C<paste>d or C<fill_id>ed. Last argument is name of operation: C<paste> or C<fill_in>.
525    
526   my @arr = $webpac->fill_in_to_arr($rec,'[v900];;[v250^a]');   my @arr = $webpac->fill_in_to_arr($rec,'[v900];;[v250^a]','paste');
527    
528  =cut  =cut
529    
530  sub fill_in_to_arr {  sub _rec_to_arr {
531          my $self = shift;          my $self = shift;
532    
533          my ($rec, $format_utf8) = @_;          my ($rec, $format_utf8, $code) = @_;
534    
535          my $log = $self->_get_logger();          my $log = $self->_get_logger();
536    
537          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
538          return if (! $format_utf8);          return if (! $format_utf8);
539    
540            $log->debug("using $code on $format_utf8");
541    
542          my $i = 0;          my $i = 0;
543            my $max = 0;
544          my @arr;          my @arr;
545            my $rec_size = {};
546    
547          my $rec_size;          while ($i <= $max) {
548                    my @v = $self->$code($rec,$format_utf8,$i++,\$rec_size);
549          while (my $v = $self->fill_in($rec,$format_utf8,$i,\$rec_size)) {                  if ($rec_size) {
550                  push @arr, $v;                          foreach my $f (keys %{ $rec_size }) {
551                  warn "rec_size = ", Dumper($rec_size);                                  $max = $rec_size->{$f} if ($rec_size->{$f} > $max);
552                            }
553                            $log->debug("max set to $max");
554                            undef $rec_size;
555                    }
556                    if (@v) {
557                            push @arr, @v;
558                    } else {
559                            push @arr, '' if ($max > $i);
560                    }
561          }          }
562    
563          $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.397
  ViewVC Help
Powered by ViewVC 1.1.26