/[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 411 by dpavlin, Sun Sep 5 22:22:37 2004 UTC
# Line 198  sub open_isis { Line 198  sub open_isis {
198                  my $rec = $self->{'data'}->{$mfn};                  my $rec = $self->{'data'}->{$mfn};
199                  $self->create_lookup($rec, @{$arg->{'lookup'}});                  $self->create_lookup($rec, @{$arg->{'lookup'}});
200    
201                    $self->progress_bar($mfn,$maxmfn);
202    
203          }          }
204    
205          $self->{'current_mfn'} = 1;          $self->{'current_mfn'} = 1;
206            $self->{'last_pcnt'} = 0;
207    
208          # store max mfn and return it.          # store max mfn and return it.
209          return $self->{'max_mfn'} = $maxmfn;          return $self->{'max_mfn'} = $maxmfn;
# Line 228  sub fetch_rec { Line 231  sub fetch_rec {
231                  return;                  return;
232          }          }
233    
234            $self->progress_bar($mfn,$self->{'max_mfn'});
235    
236          return $self->{'data'}->{$mfn};          return $self->{'data'}->{$mfn};
237  }  }
238    
239    =head2 progress_bar
240    
241    Draw progress bar on STDERR.
242    
243     $webpac->progress_bar($current, $max);
244    
245    =cut
246    
247    sub progress_bar {
248            my $self = shift;
249    
250            my ($curr,$max) = @_;
251    
252            my $log = $self->_get_logger();
253    
254            $log->logconfess("no current value!") if (! $curr);
255            $log->logconfess("no maximum value!") if (! $max);
256    
257            if ($curr > $max) {
258                    $max = $curr;
259                    $log->debug("overflow to $curr");
260            }
261    
262            $self->{'last_pcnt'} ||= 1;
263    
264            $self->{'last_pcnt'} = $curr if ($curr < $self->{'last_pcnt'});
265    
266            my $p = int($curr * 100 / $max);
267            if ($p != $self->{'last_pcnt'}) {
268                    printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$curr,$max,"=" x ($p/2).">", $p );
269                    $self->{'last_pcnt'} = $p;
270            }
271    }
272    
273  =head2 open_import_xml  =head2 open_import_xml
274    
275  Read file from C<import_xml/> directory and parse it.  Read file from C<import_xml/> directory and parse it.
# Line 335  sub get_data { Line 374  sub get_data {
374    
375          if ($$rec->{$f}) {          if ($$rec->{$f}) {
376                  return '' if (! $$rec->{$f}->[$i]);                  return '' if (! $$rec->{$f}->[$i]);
377                    no strict 'refs';
378                  if ($sf && $$rec->{$f}->[$i]->{$sf}) {                  if ($sf && $$rec->{$f}->[$i]->{$sf}) {
379                          $$found++ if (defined($$found));                          $$found++ if (defined($$found));
380                          return $$rec->{$f}->[$i]->{$sf};                          return $$rec->{$f}->[$i]->{$sf};
# Line 375  Following example will read second value Line 415  Following example will read second value
415  This function B<does not> perform parsing of format to inteligenty skip  This function B<does not> perform parsing of format to inteligenty skip
416  delimiters before fields which aren't used.  delimiters before fields which aren't used.
417    
418    This method will automatically decode UTF-8 string to local code page
419    if needed.
420    
421  =cut  =cut
422    
423  sub fill_in {  sub fill_in {
# Line 390  sub fill_in { Line 433  sub fill_in {
433          # FIXME remove for speedup?          # FIXME remove for speedup?
434          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
435    
436            if (utf8::is_utf8($format)) {
437                    $format = $self->_x($format);
438            }
439    
440          my $found = 0;          my $found = 0;
441    
442          my $eval_code;          my $eval_code;
# Line 609  It is used later to produce output. Line 656  It is used later to produce output.
656   my @ds = $webpac->data_structure($rec);   my @ds = $webpac->data_structure($rec);
657    
658  This method will also set C<$webpac->{'currnet_filename'}> if there is  This method will also set C<$webpac->{'currnet_filename'}> if there is
659  <filename> tag in C<import_xml>.  <filename> tag in C<import_xml> and C<$webpac->{'headline'}> if there is
660    <headline> tag.
661    
662  =cut  =cut
663    
# Line 622  sub data_structure { Line 670  sub data_structure {
670          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
671    
672          undef $self->{'currnet_filename'};          undef $self->{'currnet_filename'};
673            undef $self->{'headline'};
674    
675          my @sorted_tags;          my @sorted_tags;
676          if ($self->{tags_by_order}) {          if ($self->{tags_by_order}) {
# Line 659  sub data_structure { Line 708  sub data_structure {
708                                  @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v;                                  @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v;
709                          }                          }
710    
711                            if ($field eq 'filename') {
712                                    $self->{'current_filename'} = join('',@v);
713                                    $log->debug("filename: ",$self->{'current_filename'});
714                            } elsif ($field eq 'headline') {
715                                    $self->{'headline'} .= join('',@v);
716                                    $log->debug("headline: ",$self->{'headline'});
717                                    next; # don't return headline in data_structure!
718                            }
719    
720                          # does tag have type?                          # does tag have type?
721                          if ($tag->{'type'}) {                          if ($tag->{'type'}) {
722                                  push @{$row->{$tag->{'type'}}}, @v;                                  push @{$row->{$tag->{'type'}}}, @v;
# Line 667  sub data_structure { Line 725  sub data_structure {
725                                  push @{$row->{'swish'}}, @v;                                  push @{$row->{'swish'}}, @v;
726                          }                          }
727    
                         if ($field eq 'filename') {  
                                 $self->{'current_filename'} = join('',@v);  
                                 $log->debug("filename: ",$self->{'current_filename'});  
                         }  
728    
729                  }                  }
730    
# Line 721  sub output { Line 775  sub output {
775          return $out;          return $out;
776  }  }
777    
778    =head2 output_file
779    
780    Create output from in-memory data structure using Template Toolkit template
781    to a file.
782    
783     $webpac->output_file(
784            file => 'out.txt',
785            template => 'text.tt',
786            data => @ds
787     );
788    
789    =cut
790    
791    sub output_file {
792            my $self = shift;
793    
794            my $args = {@_};
795    
796            my $log = $self->_get_logger();
797    
798            $log->logconfess("need file name") if (! $args->{'file'});
799    
800            $log->debug("creating file ",$args->{'file'});
801    
802            open(my $fh, ">", $args->{'file'}) || $log->logdie("can't open output file '$self->{'file'}': $!");
803            print $fh $self->output(
804                    template => $args->{'template'},
805                    data => $args->{'data'},
806            ) || $log->logdie("print: $!");
807            close($fh) || $log->logdie("close: $!");
808    }
809    
810  =head2 apply_format  =head2 apply_format
811    
812  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.411

  ViewVC Help
Powered by ViewVC 1.1.26