/[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 372 by dpavlin, Sun Jan 8 21:50:34 2006 UTC revision 436 by dpavlin, Sun Apr 30 12:17:19 2006 UTC
# Line 13  WebPAC::Normalize - data mungling for no Line 13  WebPAC::Normalize - data mungling for no
13    
14  =head1 VERSION  =head1 VERSION
15    
16  Version 0.08  Version 0.09
17    
18  =cut  =cut
19    
20  our $VERSION = '0.08';  our $VERSION = '0.09';
21    
22  =head1 SYNOPSIS  =head1 SYNOPSIS
23    
# Line 137  sub new { Line 137  sub new {
137          $self ? return $self : return undef;          $self ? return $self : return undef;
138  }  }
139    
140    =head2 all_tags
141    
142    Returns all tags in document in specified order
143    
144      my $sorted_tags = $self->all_tags();
145    
146    =cut
147    
148    sub all_tags {
149            my $self = shift;
150    
151            if (! $self->{_tags_by_order}) {
152    
153                    my $log = $self->_get_logger;
154                    # sanity check
155                    $log->logdie("can't find self->{inport_xml}->{indexer}") unless ($self->{import_xml}->{indexer});
156    
157                    my @tags = keys %{ $self->{'import_xml'}->{'indexer'}};
158                    $log->debug("unsorted tags: " . join(", ", @tags));
159    
160                    @tags = sort { $self->_sort_by_order } @tags;
161    
162                    $log->debug("sorted tags: " . join(",", @tags) );
163    
164                    $self->{_tags_by_order} = \@tags;
165            }
166    
167            return $self->{_tags_by_order};
168    }
169    
170    
171    
172  =head2 data_structure  =head2 data_structure
173    
# Line 172  sub data_structure { Line 203  sub data_structure {
203                  $log->debug("cache miss, creating");                  $log->debug("cache miss, creating");
204          }          }
205    
206          my @sorted_tags;          my $tags = $self->all_tags();
         if ($self->{tags_by_order}) {  
                 @sorted_tags = @{$self->{tags_by_order}};  
         } else {  
                 @sorted_tags = sort { $self->_sort_by_order } keys %{$self->{'import_xml'}->{'indexer'}};  
                 $self->{tags_by_order} = \@sorted_tags;  
         }  
207    
208          my $ds;          $log->debug("tags: ",sub { join(", ",@{ $tags }) });
209    
210          $log->debug("tags: ",sub { join(", ",@sorted_tags) });          my $ds;
211    
212          foreach my $field (@sorted_tags) {          foreach my $field (@{ $tags }) {
213    
214                  my $row;                  my $row;
215    
# Line 204  sub data_structure { Line 229  sub data_structure {
229                          }                          }
230                          if (! @v) {                          if (! @v) {
231                                  $log->debug("$field <",$self->{tag},"> format: $format no values");                                  $log->debug("$field <",$self->{tag},"> format: $format no values");
232  #                               next;                                  next;
233                          } else {                          } else {
234                                  $log->debug("$field <",$self->{tag},"> format: $format values: ", join(",", @v));                                  $log->debug("$field <",$self->{tag},"> format: $format values: ", join(",", @v));
235                          }                          }
# Line 364  sub parse { Line 389  sub parse {
389    
390                          # we will skip delimiter before first occurence of field!                          # we will skip delimiter before first occurence of field!
391                          push @out, $del unless($found_any->{$fld_type} == 1);                          push @out, $del unless($found_any->{$fld_type} == 1);
392                          push @out, $tmp;                          push @out, $tmp if ($tmp);
393                  }                  }
394                  $f_step++;                  $f_step++;
395          }          }
# Line 471  sub fill_in { Line 496  sub fill_in {
496          # remove filter{...} from beginning          # remove filter{...} from beginning
497          $filter_name = $1 if ($format =~ s/^filter{([^}]+)}//s);          $filter_name = $1 if ($format =~ s/^filter{([^}]+)}//s);
498    
499          # do actual replacement of placeholders          {
500          # repeatable fields                  # fix warnings
501          if ($format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found,$rec_size)/ges) {                  no warnings 'uninitialized';
502                  $just_single = 0;  
503          }                  # do actual replacement of placeholders
504                    # repeatable fields
505                    if ($format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found,$rec_size)/ges) {
506                            $just_single = 0;
507                    }
508    
509          # non-repeatable fields                  # non-repeatable fields
510          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) {
511                  return if ($i > 0 && $just_single);                          return if ($i > 0 && $just_single);
512                    }
513          }          }
514    
515          if ($found) {          if ($found) {
# Line 532  sub _rec_to_arr { Line 562  sub _rec_to_arr {
562          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
563          return if (! $format_utf8);          return if (! $format_utf8);
564    
565            $log->debug("using $code on $format_utf8");
566    
567          my $i = 0;          my $i = 0;
568          my $max = 0;          my $max = 0;
569          my @arr;          my @arr;
570          my $rec_size = {};          my $rec_size = {};
571    
572          while ($i <= $max) {          while ($i <= $max) {
573                  my $v = $self->$code($rec,$format_utf8,$i++,\$rec_size) || next;                  my @v = $self->$code($rec,$format_utf8,$i++,\$rec_size);
                 push @arr, $v;  
574                  if ($rec_size) {                  if ($rec_size) {
575                          foreach my $f (keys %{ $rec_size }) {                          foreach my $f (keys %{ $rec_size }) {
576                                  $max = $rec_size->{$f} if ($rec_size->{$f} > $max);                                  $max = $rec_size->{$f} if ($rec_size->{$f} > $max);
577                          }                          }
578                          warn "max set to $max, rec_size = ", Dumper($rec_size);                          $log->debug("max set to $max");
579                          undef $rec_size;                          undef $rec_size;
580                  }                  }
581                    if (@v) {
582                            push @arr, @v;
583                    } else {
584                            push @arr, '' if ($max > $i);
585                    }
586          }          }
587    
588          $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 622  sub get_data { Line 658  sub get_data {
658                          if ($$rec->{$f}->[$i] =~ /HASH/o) {                          if ($$rec->{$f}->[$i] =~ /HASH/o) {
659                                  my $out;                                  my $out;
660                                  foreach my $k (keys %{$$rec->{$f}->[$i]}) {                                  foreach my $k (keys %{$$rec->{$f}->[$i]}) {
661                                          $out .= '$' . $k .':' . $$rec->{$f}->[$i]->{$k}." ";                                          my $v = $$rec->{$f}->[$i]->{$k};
662                                            $out .= '$' . $k .':' . $v if ($v);
663                                  }                                  }
664                                  return $out;                                  return $out;
665                          } else {                          } else {
Legend:
Removed from v.372  
changed lines
  Added in v.436
  ViewVC Help
Powered by ViewVC 1.1.26