/[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 375 by dpavlin, Sun Jun 20 17:52:41 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);
205    
206          }          }
207    
208          $self->{'current_mfn'} = 1;          $self->{'current_mfn'} = 1;
209            $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;
# Line 228  sub fetch_rec { Line 236  sub fetch_rec {
236                  return;                  return;
237          }          }
238    
239            $self->progress_bar($mfn,$self->{'max_mfn'});
240    
241          return $self->{'data'}->{$mfn};          return $self->{'data'}->{$mfn};
242  }  }
243    
244    =head2 progress_bar
245    
246    Draw progress bar on STDERR.
247    
248     $webpac->progress_bar($current, $max);
249    
250    =cut
251    
252    sub progress_bar {
253            my $self = shift;
254    
255            my ($curr,$max) = @_;
256    
257            my $log = $self->_get_logger();
258    
259            $log->logconfess("no current value!") if (! $curr);
260            $log->logconfess("no maximum value!") if (! $max);
261    
262            if ($curr > $max) {
263                    $max = $curr;
264                    $log->debug("overflow to $curr");
265            }
266    
267            $self->{'last_pcnt'} ||= 1;
268    
269            $self->{'last_pcnt'} = $curr if ($curr < $self->{'last_pcnt'});
270    
271            my $p = int($curr * 100 / $max);
272            if ($p != $self->{'last_pcnt'}) {
273                    printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$curr,$max,"=" x ($p/2).">", $p );
274                    $self->{'last_pcnt'} = $p;
275            }
276            print STDERR "\n" if ($p == 100);
277    }
278    
279  =head2 open_import_xml  =head2 open_import_xml
280    
281  Read file from C<import_xml/> directory and parse it.  Read file from C<import_xml/> directory and parse it.
# Line 290  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 335  sub get_data { Line 382  sub get_data {
382    
383          if ($$rec->{$f}) {          if ($$rec->{$f}) {
384                  return '' if (! $$rec->{$f}->[$i]);                  return '' if (! $$rec->{$f}->[$i]);
385                    no strict 'refs';
386                  if ($sf && $$rec->{$f}->[$i]->{$sf}) {                  if ($sf && $$rec->{$f}->[$i]->{$sf}) {
387                          $$found++ if (defined($$found));                          $$found++ if (defined($$found));
388                          return $$rec->{$f}->[$i]->{$sf};                          return $$rec->{$f}->[$i]->{$sf};
# Line 375  Following example will read second value Line 423  Following example will read second value
423  This function B<does not> perform parsing of format to inteligenty skip  This function B<does not> perform parsing of format to inteligenty skip
424  delimiters before fields which aren't used.  delimiters before fields which aren't used.
425    
426    This method will automatically decode UTF-8 string to local code page
427    if needed.
428    
429  =cut  =cut
430    
431  sub fill_in {  sub fill_in {
# Line 390  sub fill_in { Line 441  sub fill_in {
441          # FIXME remove for speedup?          # FIXME remove for speedup?
442          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
443    
444            if (utf8::is_utf8($format)) {
445                    $format = $self->_x($format);
446            }
447    
448          my $found = 0;          my $found = 0;
449    
450          my $eval_code;          my $eval_code;
# Line 609  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 622  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 659  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 667  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 721  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.375  
changed lines
  Added in v.418

  ViewVC Help
Powered by ViewVC 1.1.26