/[webpac]/trunk2/lib/WebPAC.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 /trunk2/lib/WebPAC.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 389 by dpavlin, Tue Jul 20 17:15:48 2004 UTC revision 418 by dpavlin, Thu Sep 9 18:08:38 2004 UTC
# Line 169  sub open_isis { Line 169  sub open_isis {
169          # read database          # read database
170          for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) {          for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) {
171    
172    
173                    $log->debug("mfn: $mfn\n");
174    
175                  # read record                  # read record
176                  my $row = OpenIsis::read( $isis_db, $mfn );                  my $row = OpenIsis::read( $isis_db, $mfn );
177                  foreach my $k (keys %{$row}) {                  foreach my $k (keys %{$row}) {
# Line 195  sub open_isis { Line 198  sub open_isis {
198                  }                  }
199    
200                  # create lookup                  # create lookup
201                  my $rec = $self->{'data'}->{$mfn};                  my $rec = $self->{'data'}->{$mfn} || $log->confess("record $mfn empty?");
202                  $self->create_lookup($rec, @{$arg->{'lookup'}});                  $self->create_lookup($rec, @{$arg->{'lookup'}});
203    
204                  $self->progress_bar($mfn,$maxmfn);                  $self->progress_bar($mfn,$maxmfn);
# Line 205  sub open_isis { Line 208  sub open_isis {
208          $self->{'current_mfn'} = 1;          $self->{'current_mfn'} = 1;
209          $self->{'last_pcnt'} = 0;          $self->{'last_pcnt'} = 0;
210    
211            $log->debug("max mfn: $maxmfn");
212    
213          # store max mfn and return it.          # store max mfn and return it.
214          return $self->{'max_mfn'} = $maxmfn;          return $self->{'max_mfn'} = $maxmfn;
215  }  }
# Line 268  sub progress_bar { Line 273  sub progress_bar {
273                  printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$curr,$max,"=" x ($p/2).">", $p );                  printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$curr,$max,"=" x ($p/2).">", $p );
274                  $self->{'last_pcnt'} = $p;                  $self->{'last_pcnt'} = $p;
275          }          }
276            print STDERR "\n" if ($p == 100);
277  }  }
278    
279  =head2 open_import_xml  =head2 open_import_xml
# Line 329  sub create_lookup { Line 335  sub create_lookup {
335          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
336    
337          foreach my $i (@_) {          foreach my $i (@_) {
338                  if ($i->{'eval'}) {                  $log->logconfess("need key") unless defined($i->{'key'});
339                          my $eval = $self->fill_in($rec,$i->{'eval'});                  $log->logconfess("need val") unless defined($i->{'val'});
340                          my $key = $self->fill_in($rec,$i->{'key'});  
341                          my @val = $self->fill_in($rec,$i->{'val'});                  if (defined($i->{'eval'})) {
342                          if ($key && @val && eval $eval) {                          # eval first, so we can skip fill_in for key and val
343                            my $eval = $self->fill_in($rec,$i->{'eval'}) || next;
344                            if ($self->_eval($eval)) {
345                                    my $key = $self->fill_in($rec,$i->{'key'}) || next;
346                                    my @val = $self->fill_in($rec,$i->{'val'}) || next;
347                                  $log->debug("stored $key = ",sub { join(" | ",@val) });                                  $log->debug("stored $key = ",sub { join(" | ",@val) });
348                                  push @{$self->{'lookup'}->{$key}}, @val;                                  push @{$self->{'lookup'}->{$key}}, @val;
349                          }                          }
350                  } else {                  } else {
351                          my $key = $self->fill_in($rec,$i->{'key'});                          my $key = $self->fill_in($rec,$i->{'key'}) || next;
352                          my @val = $self->fill_in($rec,$i->{'val'});                          my @val = $self->fill_in($rec,$i->{'val'}) || next;
353                          if ($key && @val) {                          $log->debug("stored $key = ",sub { join(" | ",@val) });
354                                  $log->debug("stored $key = ",sub { join(" | ",@val) });                          push @{$self->{'lookup'}->{$key}}, @val;
                                 push @{$self->{'lookup'}->{$key}}, @val;  
                         }  
355                  }                  }
356          }          }
357  }  }
# Line 656  It is used later to produce output. Line 664  It is used later to produce output.
664   my @ds = $webpac->data_structure($rec);   my @ds = $webpac->data_structure($rec);
665    
666  This method will also set C<$webpac->{'currnet_filename'}> if there is  This method will also set C<$webpac->{'currnet_filename'}> if there is
667  <filename> tag in C<import_xml>.  <filename> tag in C<import_xml> and C<$webpac->{'headline'}> if there is
668    <headline> tag.
669    
670  =cut  =cut
671    
# Line 669  sub data_structure { Line 678  sub data_structure {
678          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
679    
680          undef $self->{'currnet_filename'};          undef $self->{'currnet_filename'};
681            undef $self->{'headline'};
682    
683          my @sorted_tags;          my @sorted_tags;
684          if ($self->{tags_by_order}) {          if ($self->{tags_by_order}) {
# Line 706  sub data_structure { Line 716  sub data_structure {
716                                  @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v;                                  @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v;
717                          }                          }
718    
719                            if ($field eq 'filename') {
720                                    $self->{'current_filename'} = join('',@v);
721                                    $log->debug("filename: ",$self->{'current_filename'});
722                            } elsif ($field eq 'headline') {
723                                    $self->{'headline'} .= join('',@v);
724                                    $log->debug("headline: ",$self->{'headline'});
725                                    next; # don't return headline in data_structure!
726                            }
727    
728                          # does tag have type?                          # does tag have type?
729                          if ($tag->{'type'}) {                          if ($tag->{'type'}) {
730                                  push @{$row->{$tag->{'type'}}}, @v;                                  push @{$row->{$tag->{'type'}}}, @v;
# Line 714  sub data_structure { Line 733  sub data_structure {
733                                  push @{$row->{'swish'}}, @v;                                  push @{$row->{'swish'}}, @v;
734                          }                          }
735    
                         if ($field eq 'filename') {  
                                 $self->{'current_filename'} = join('',@v);  
                                 $log->debug("filename: ",$self->{'current_filename'});  
                         }  
736    
737                  }                  }
738    
# Line 768  sub output { Line 783  sub output {
783          return $out;          return $out;
784  }  }
785    
786    =head2 output_file
787    
788    Create output from in-memory data structure using Template Toolkit template
789    to a file.
790    
791     $webpac->output_file(
792            file => 'out.txt',
793            template => 'text.tt',
794            data => @ds
795     );
796    
797    =cut
798    
799    sub output_file {
800            my $self = shift;
801    
802            my $args = {@_};
803    
804            my $log = $self->_get_logger();
805    
806            $log->logconfess("need file name") if (! $args->{'file'});
807    
808            $log->debug("creating file ",$args->{'file'});
809    
810            open(my $fh, ">", $args->{'file'}) || $log->logdie("can't open output file '$self->{'file'}': $!");
811            print $fh $self->output(
812                    template => $args->{'template'},
813                    data => $args->{'data'},
814            ) || $log->logdie("print: $!");
815            close($fh) || $log->logdie("close: $!");
816    }
817    
818  =head2 apply_format  =head2 apply_format
819    
820  Apply format specified in tag with C<format_name="name"> and  Apply format specified in tag with C<format_name="name"> and

Legend:
Removed from v.389  
changed lines
  Added in v.418

  ViewVC Help
Powered by ViewVC 1.1.26