/[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 434 by dpavlin, Mon Sep 13 14:39:16 2004 UTC
# Line 9  use Config::IniFiles; Line 9  use Config::IniFiles;
9  use XML::Simple;  use XML::Simple;
10  use Template;  use Template;
11  use Log::Log4perl qw(get_logger :levels);  use Log::Log4perl qw(get_logger :levels);
12    use Time::HiRes qw(time);
13    
14  use Data::Dumper;  use Data::Dumper;
15    
# Line 29  This module implements methods used by W Line 30  This module implements methods used by W
30    
31  =head2 new  =head2 new
32    
33  This will create new instance of WebPAC using configuration specified by C<config_file>.  Create new instance of WebPAC using configuration specified by C<config_file>.
34    
35   my $webpac = new WebPAC(   my $webpac = new WebPAC(
36          config_file => 'name.conf',          config_file => 'name.conf',
37          [code_page => 'ISO-8859-2',]          [code_page => 'ISO-8859-2',]
38            [low_mem => 1,]
39   );   );
40    
41  Default C<code_page> is C<ISO-8859-2>.  Default C<code_page> is C<ISO-8859-2>.
42    
43  It will also read configuration files  Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).
44    
45    This method will also read configuration files
46  C<global.conf> (used by indexer and Web font-end)  C<global.conf> (used by indexer and Web font-end)
47  and configuration file specified by C<config_file>  and configuration file specified by C<config_file>
48  which describes databases to be indexed.  which describes databases to be indexed.
# Line 59  sub new { Line 63  sub new {
63          my $self = {@_};          my $self = {@_};
64          bless($self, $class);          bless($self, $class);
65    
66            $self->{'start_t'} = time();
67    
68          my $log_file = $self->{'log'} || "log.conf";          my $log_file = $self->{'log'} || "log.conf";
69          Log::Log4perl->init($log_file);          Log::Log4perl->init($log_file);
70    
# Line 106  sub new { Line 112  sub new {
112                  EVAL_PERL => 1,                  EVAL_PERL => 1,
113          );          );
114    
115            # running with low_mem flag? well, use DBM::Deep then.
116            if ($self->{'low_mem'}) {
117                    $log->info("running with low_mem which impacts performance (<32 Mb memory usage)");
118    
119                    my $db_file = "data.db";
120    
121                    if (-e $db_file) {
122                            unlink $db_file or $log->logdie("can't remove '$db_file' from last run");
123                            $log->debug("removed '$db_file' from last run");
124                    }
125    
126                    require DBM::Deep;
127    
128                    my $db = new DBM::Deep $db_file;
129    
130                    $log->logdie("DBM::Deep error: $!") unless ($db);
131    
132                    if ($db->error()) {
133                            $log->logdie("can't open '$db_file' under low_mem: ",$db->error());
134                    } else {
135                            $log->debug("using file '$db_file' for DBM::Deep");
136                    }
137    
138                    $self->{'db'} = $db;
139            }
140    
141          return $self;          return $self;
142  }  }
143    
# Line 116  Open CDS/ISIS database using OpenIsis mo Line 148  Open CDS/ISIS database using OpenIsis mo
148   $webpac->open_isis(   $webpac->open_isis(
149          filename => '/data/ISIS/ISIS',          filename => '/data/ISIS/ISIS',
150          code_page => '852',          code_page => '852',
151          limit_mfn => '500',          limit_mfn => 500,
152            start_mfn => 6000,
153          lookup => [ ... ],          lookup => [ ... ],
154   );   );
155    
156  By default, ISIS code page is assumed to be C<852>.  By default, ISIS code page is assumed to be C<852>.
157    
158    If optional parametar C<start_mfn> is set, this will be first MFN to read
159    from database (so you can skip beginning of your database if you need to).
160    
161  If optional parametar C<limit_mfn> is set, it will read just 500 records  If optional parametar C<limit_mfn> is set, it will read just 500 records
162  from database in example above.  from database in example above.
163    
# Line 149  sub open_isis { Line 185  sub open_isis {
185          $log->logcroak("need filename") if (! $arg->{'filename'});          $log->logcroak("need filename") if (! $arg->{'filename'});
186          my $code_page = $arg->{'code_page'} || '852';          my $code_page = $arg->{'code_page'} || '852';
187    
188            # store data in object
189            $self->{'isis_filename'} = $arg->{'filename'};
190            $self->{'isis_code_page'} = $code_page;
191    
192          use OpenIsis;          use OpenIsis;
193    
194          #$self->{'isis_code_page'} = $code_page;          #$self->{'isis_code_page'} = $code_page;
# Line 157  sub open_isis { Line 197  sub open_isis {
197          my $cp = Text::Iconv->new($code_page,$self->{'code_page'});          my $cp = Text::Iconv->new($code_page,$self->{'code_page'});
198    
199          $log->info("reading ISIS database '",$arg->{'filename'},"'");          $log->info("reading ISIS database '",$arg->{'filename'},"'");
200            $log->debug("isis code page: $code_page");
201    
202          my $isis_db = OpenIsis::open($arg->{'filename'});          my $isis_db = OpenIsis::open($arg->{'filename'});
203    
204          my $maxmfn = OpenIsis::maxRowid( $isis_db ) || 1;          my $maxmfn = OpenIsis::maxRowid( $isis_db ) || 1;
205            my $startmfn = 1;
206    
207          $maxmfn = $self->{limit_mfn} if ($self->{limit_mfn});          if (my $s = $self->{'start_mfn'}) {
208                    $log->info("skipping to MFN $s");
209                    $startmfn = $s;
210            }
211    
212          $log->info("processing $maxmfn records...");          $maxmfn = $startmfn + $self->{limit_mfn} if ($self->{limit_mfn});
213    
214            $log->info("processing ",($maxmfn-$startmfn)." records...");
215    
216          # read database          # read database
217          for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) {          for (my $mfn = $startmfn; $mfn <= $maxmfn; $mfn++) {
218    
219    
220                    $log->debug("mfn: $mfn\n");
221    
222                    my $rec;
223    
224                  # read record                  # read record
225                  my $row = OpenIsis::read( $isis_db, $mfn );                  my $row = OpenIsis::read( $isis_db, $mfn );
# Line 186  sub open_isis { Line 238  sub open_isis {
238                                                  $val = $l;                                                  $val = $l;
239                                          }                                          }
240    
241                                          push @{$self->{'data'}->{$mfn}->{$k}}, $val;                                          push @{$rec->{$k}}, $val;
242                                  }                                  }
243                          } else {                          } else {
244                                  push @{$self->{'data'}->{$mfn}->{'000'}}, $mfn;                                  push @{$rec->{'000'}}, $mfn;
245                          }                          }
246    
247                  }                  }
248    
249                    $log->confess("record $mfn empty?") unless ($rec);
250    
251                    # store
252                    if ($self->{'low_mem'}) {
253                            $self->{'db'}->put($mfn, $rec);
254                    } else {
255                            $self->{'data'}->{$mfn} = $rec;
256                    }
257    
258                  # create lookup                  # create lookup
                 my $rec = $self->{'data'}->{$mfn};  
259                  $self->create_lookup($rec, @{$arg->{'lookup'}});                  $self->create_lookup($rec, @{$arg->{'lookup'}});
260    
261                  $self->progress_bar($mfn,$maxmfn);                  $self->progress_bar($mfn,$maxmfn);
262    
263          }          }
264    
265          $self->{'current_mfn'} = 1;          $self->{'current_mfn'} = $startmfn;
266          $self->{'last_pcnt'} = 0;          $self->{'last_pcnt'} = 0;
267    
268            $log->debug("max mfn: $maxmfn");
269    
270          # store max mfn and return it.          # store max mfn and return it.
271          return $self->{'max_mfn'} = $maxmfn;          return $self->{'max_mfn'} = $maxmfn;
272  }  }
# Line 233  sub fetch_rec { Line 295  sub fetch_rec {
295    
296          $self->progress_bar($mfn,$self->{'max_mfn'});          $self->progress_bar($mfn,$self->{'max_mfn'});
297    
298          return $self->{'data'}->{$mfn};          if ($self->{'low_mem'}) {
299                    return $self->{'db'}->get($mfn);
300            } else {
301                    return $self->{'data'}->{$mfn};
302            }
303  }  }
304    
305  =head2 progress_bar  =head2 progress_bar
# Line 261  sub progress_bar { Line 327  sub progress_bar {
327    
328          $self->{'last_pcnt'} ||= 1;          $self->{'last_pcnt'} ||= 1;
329    
         $self->{'last_pcnt'} = $curr if ($curr < $self->{'last_pcnt'});  
   
330          my $p = int($curr * 100 / $max);          my $p = int($curr * 100 / $max);
331    
332            # reset on re-run
333            if ($p < $self->{'last_pcnt'}) {
334                    $self->{'last_pcnt'} = $p;
335                    $self->{'last_t'} = time();
336                    $self->{'last_curr'} = 1;
337            }
338    
339          if ($p != $self->{'last_pcnt'}) {          if ($p != $self->{'last_pcnt'}) {
340                  printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$curr,$max,"=" x ($p/2).">", $p );  
341                    my $last_curr = $self->{'last_curr'} || $curr;
342                    my $t = time();
343                    my $rate = ($curr - $last_curr) / (($t - $self->{'last_t'} || 1));
344                    my $eta = ($max-$curr) / ($rate || 1);
345                    printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta));
346                  $self->{'last_pcnt'} = $p;                  $self->{'last_pcnt'} = $p;
347                    $self->{'last_t'} = time();
348                    $self->{'last_curr'} = $curr;
349          }          }
350            print STDERR "\n" if ($p == 100);
351    }
352    
353    =head2 fmt_time
354    
355    Format time (in seconds) for display.
356    
357     print $webpac->fmt_time(time());
358    
359    This method is called by L<progress_bar> to display remaining time.
360    
361    =cut
362    
363    sub fmt_time {
364            my $self = shift;
365    
366            my $t = shift || 0;
367            my $out = "";
368    
369            my ($ss,$mm,$hh) = gmtime($t);
370            $out .= "${hh}h" if ($hh);
371            $out .= sprintf("%02d:%02d", $mm,$ss);
372            $out .= "  " if ($hh == 0);
373            return $out;
374  }  }
375    
376  =head2 open_import_xml  =head2 open_import_xml
# Line 329  sub create_lookup { Line 432  sub create_lookup {
432          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
433    
434          foreach my $i (@_) {          foreach my $i (@_) {
435                  if ($i->{'eval'}) {                  $log->logconfess("need key") unless defined($i->{'key'});
436                          my $eval = $self->fill_in($rec,$i->{'eval'});                  $log->logconfess("need val") unless defined($i->{'val'});
437                          my $key = $self->fill_in($rec,$i->{'key'});  
438                          my @val = $self->fill_in($rec,$i->{'val'});                  if (defined($i->{'eval'})) {
439                          if ($key && @val && eval $eval) {                          # eval first, so we can skip fill_in for key and val
440                            my $eval = $self->fill_in($rec,$i->{'eval'}) || next;
441                            if ($self->_eval($eval)) {
442                                    my $key = $self->fill_in($rec,$i->{'key'}) || next;
443                                    my @val = $self->fill_in($rec,$i->{'val'}) || next;
444                                  $log->debug("stored $key = ",sub { join(" | ",@val) });                                  $log->debug("stored $key = ",sub { join(" | ",@val) });
445                                  push @{$self->{'lookup'}->{$key}}, @val;                                  push @{$self->{'lookup'}->{$key}}, @val;
446                          }                          }
447                  } else {                  } else {
448                          my $key = $self->fill_in($rec,$i->{'key'});                          my $key = $self->fill_in($rec,$i->{'key'}) || next;
449                          my @val = $self->fill_in($rec,$i->{'val'});                          my @val = $self->fill_in($rec,$i->{'val'}) || next;
450                          if ($key && @val) {                          $log->debug("stored $key = ",sub { join(" | ",@val) });
451                                  $log->debug("stored $key = ",sub { join(" | ",@val) });                          push @{$self->{'lookup'}->{$key}}, @val;
                                 push @{$self->{'lookup'}->{$key}}, @val;  
                         }  
452                  }                  }
453          }          }
454  }  }
# Line 656  It is used later to produce output. Line 761  It is used later to produce output.
761   my @ds = $webpac->data_structure($rec);   my @ds = $webpac->data_structure($rec);
762    
763  This method will also set C<$webpac->{'currnet_filename'}> if there is  This method will also set C<$webpac->{'currnet_filename'}> if there is
764  <filename> tag in C<import_xml>.  <filename> tag in C<import_xml> and C<$webpac->{'headline'}> if there is
765    <headline> tag.
766    
767  =cut  =cut
768    
# Line 669  sub data_structure { Line 775  sub data_structure {
775          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
776    
777          undef $self->{'currnet_filename'};          undef $self->{'currnet_filename'};
778            undef $self->{'headline'};
779    
780          my @sorted_tags;          my @sorted_tags;
781          if ($self->{tags_by_order}) {          if ($self->{tags_by_order}) {
# Line 706  sub data_structure { Line 813  sub data_structure {
813                                  @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v;                                  @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v;
814                          }                          }
815    
816                            if ($field eq 'filename') {
817                                    $self->{'current_filename'} = join('',@v);
818                                    $log->debug("filename: ",$self->{'current_filename'});
819                            } elsif ($field eq 'headline') {
820                                    $self->{'headline'} .= join('',@v);
821                                    $log->debug("headline: ",$self->{'headline'});
822                                    next; # don't return headline in data_structure!
823                            }
824    
825                          # does tag have type?                          # does tag have type?
826                          if ($tag->{'type'}) {                          if ($tag->{'type'}) {
827                                  push @{$row->{$tag->{'type'}}}, @v;                                  push @{$row->{$tag->{'type'}}}, @v;
# Line 714  sub data_structure { Line 830  sub data_structure {
830                                  push @{$row->{'swish'}}, @v;                                  push @{$row->{'swish'}}, @v;
831                          }                          }
832    
                         if ($field eq 'filename') {  
                                 $self->{'current_filename'} = join('',@v);  
                                 $log->debug("filename: ",$self->{'current_filename'});  
                         }  
833    
834                  }                  }
835    
# Line 768  sub output { Line 880  sub output {
880          return $out;          return $out;
881  }  }
882    
883    =head2 output_file
884    
885    Create output from in-memory data structure using Template Toolkit template
886    to a file.
887    
888     $webpac->output_file(
889            file => 'out.txt',
890            template => 'text.tt',
891            data => @ds
892     );
893    
894    =cut
895    
896    sub output_file {
897            my $self = shift;
898    
899            my $args = {@_};
900    
901            my $log = $self->_get_logger();
902    
903            my $file = $args->{'file'} || $log->logconfess("need file name");
904    
905            $log->debug("creating file ",$file);
906    
907            open(my $fh, ">", $file) || $log->logdie("can't open output file '$file': $!");
908            print $fh $self->output(
909                    template => $args->{'template'},
910                    data => $args->{'data'},
911            ) || $log->logdie("print: $!");
912            close($fh) || $log->logdie("close: $!");
913    }
914    
915  =head2 apply_format  =head2 apply_format
916    
917  Apply format specified in tag with C<format_name="name"> and  Apply format specified in tag with C<format_name="name"> and
# Line 911  B<This is different from normal Log4perl Line 1055  B<This is different from normal Log4perl
1055  also use method names, and not only classes (which are just few)  also use method names, and not only classes (which are just few)
1056  to filter logging.  to filter logging.
1057    
1058    
1059    =head1 MEMORY USAGE
1060    
1061    C<low_mem> options is double-edged sword. If enabled, WebPAC
1062    will run on memory constraint machines (which doesn't have enough
1063    physical RAM to create memory structure for whole source database).
1064    
1065    If your machine has 512Mb or more of RAM and database is around 10000 records,
1066    memory shouldn't be an issue. If you don't have enough physical RAM, you
1067    might consider using virtual memory (if your operating system is handling it
1068    well, like on FreeBSD or Linux) instead of dropping to L<DBD::Deep> to handle
1069    parsed structure of ISIS database (this is what C<low_mem> option does).
1070    
1071    Hitting swap at end of reading source database is probably o.k. However,
1072    hitting swap before 90% will dramatically decrease performance and you will
1073    be better off with C<low_mem> and using rest of availble memory for
1074    operating system disk cache (Linux is particuallary good about this).
1075    However, every access to database record will require disk access, so
1076    generation phase will be slower 10-100 times.
1077    
1078    Parsed structures are essential - you just have option to trade RAM memory
1079    (which is fast) for disk space (which is slow). Be sure to have planty of
1080    disk space if you are using C<low_mem> and thus L<DBD::Deep>.
1081    
1082    However, when WebPAC is running on desktop machines (or laptops :-), it's
1083    highly undesireable for system to start swapping. Using C<low_mem> option can
1084    reduce WecPAC memory usage to around 64Mb for same database with lookup
1085    fields and sorted indexes which stay in RAM. Performance will suffer, but
1086    memory usage will really be minimal. It might be also more confortable to
1087    run WebPAC reniced on those machines.
1088    
1089  =cut  =cut
1090    
1091  1;  1;
Legend:
Removed from v.389  
changed lines
  Added in v.434
  ViewVC Help
Powered by ViewVC 1.1.26