/[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 375 by dpavlin, Sun Jan 8 22:21:24 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 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';
                 $just_single = 0;  
         }  
502    
503          # non-repeatable fields                  # do actual replacement of placeholders
504          if ($format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found,$rec_size)/ges) {                  # repeatable fields
505                  return if ($i > 0 && $just_single);                  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
510                    if ($format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found,$rec_size)/ges) {
511                            return if ($i > 0 && $just_single);
512                    }
513          }          }
514    
515          if ($found) {          if ($found) {
# Line 628  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.375  
changed lines
  Added in v.436
  ViewVC Help
Powered by ViewVC 1.1.26