/[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 454 by dpavlin, Wed Sep 15 22:36:23 2004 UTC revision 616 by dpavlin, Fri Dec 31 03:34:33 2004 UTC
# Line 36  Create new instance of WebPAC using conf Line 36  Create new instance of WebPAC using conf
36          config_file => 'name.conf',          config_file => 'name.conf',
37          code_page => 'ISO-8859-2',          code_page => 'ISO-8859-2',
38          low_mem => 1,          low_mem => 1,
39            filter => {
40                    'lower' => sub { lc($_[0]) },
41            },
42   );   );
43    
44  Default C<code_page> is C<ISO-8859-2>.  Default C<code_page> is C<ISO-8859-2>.
45    
46  Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).  Default is not to use C<low_mem> options (see L<MEMORY USAGE> below).
47    
48    There is optinal parametar C<filter> which specify different filters which
49    can be applied using C<filter{name}> notation.
50    Same filters can be used in Template Toolkit files.
51    
52  This method will also read configuration files  This method will also read configuration files
53  C<global.conf> (used by indexer and Web font-end)  C<global.conf> (used by indexer and Web font-end)
54  and configuration file specified by C<config_file>  and configuration file specified by C<config_file>
# Line 106  sub new { Line 113  sub new {
113          # create Template toolkit instance          # create Template toolkit instance
114          $self->{'tt'} = Template->new(          $self->{'tt'} = Template->new(
115                  INCLUDE_PATH => ($self->{'global_config_file'}->{'output_template'} || './output_template'),                  INCLUDE_PATH => ($self->{'global_config_file'}->{'output_template'} || './output_template'),
116  #               FILTERS => {                  FILTERS => $self->{'filter'},
 #                       'foo' => \&foo_filter,  
 #               },  
117                  EVAL_PERL => 1,                  EVAL_PERL => 1,
118          );          );
119    
# Line 138  sub new { Line 143  sub new {
143                  $self->{'db'} = $db;                  $self->{'db'} = $db;
144          }          }
145    
146            $log->debug("filters defined: ",Dumper($self->{'filter'}));
147    
148          return $self;          return $self;
149  }  }
150    
151  =head2 open_isis  =head2 open_isis
152    
153  Open CDS/ISIS database using OpenIsis module and read all records to memory.  Open CDS/ISIS, WinISIS or IsisMarc database using IsisDB or OpenIsis module
154    and read all records to memory.
155    
156   $webpac->open_isis(   $webpac->open_isis(
157          filename => '/data/ISIS/ISIS',          filename => '/data/ISIS/ISIS',
# Line 191  sub open_isis { Line 199  sub open_isis {
199          $self->{'isis_filename'} = $arg->{'filename'};          $self->{'isis_filename'} = $arg->{'filename'};
200          $self->{'isis_code_page'} = $code_page;          $self->{'isis_code_page'} = $code_page;
201    
         use OpenIsis;  
   
202          #$self->{'isis_code_page'} = $code_page;          #$self->{'isis_code_page'} = $code_page;
203    
204          # create Text::Iconv object          # create Text::Iconv object
# Line 201  sub open_isis { Line 207  sub open_isis {
207          $log->info("reading ISIS database '",$arg->{'filename'},"'");          $log->info("reading ISIS database '",$arg->{'filename'},"'");
208          $log->debug("isis code page: $code_page");          $log->debug("isis code page: $code_page");
209    
210          my $isis_db = OpenIsis::open($arg->{'filename'});          my $use_openisis = 1;
211    
212            eval { use IsisDB 0.06; };
213            $use_openisis = 0 unless ($@);
214    
215            my ($isis_db,$maxmfn);
216    
217            if ($use_openisis) {
218                    use OpenIsis;
219                    $isis_db = OpenIsis::open($arg->{'filename'});
220                    $maxmfn = OpenIsis::maxRowid( $isis_db ) || 1;
221            } else {
222                    $isis_db = new IsisDB(
223                            isisdb => $arg->{'filename'},
224                            include_deleted => 1,
225                            hash_filter => sub {
226                                    my $l = shift || return;
227                                    $l = $cp->convert($l);
228                                    return $l;
229                            },
230                    );
231                    $maxmfn = $isis_db->{'maxmfn'};
232            }
233    
234    
         my $maxmfn = OpenIsis::maxRowid( $isis_db ) || 1;  
235          my $startmfn = 1;          my $startmfn = 1;
236    
237          if (my $s = $self->{'start_mfn'}) {          if (my $s = $self->{'start_mfn'}) {
# Line 215  sub open_isis { Line 243  sub open_isis {
243    
244          $maxmfn = $startmfn + $self->{limit_mfn} if ($self->{limit_mfn});          $maxmfn = $startmfn + $self->{limit_mfn} if ($self->{limit_mfn});
245    
246          $log->info("processing ",($maxmfn-$startmfn)." records...");          $log->info("processing ",($maxmfn-$startmfn)." records using ",( $use_openisis ? 'OpenIsis' : 'IsisDB'));
247    
248    
249          # read database          # read database
250          for (my $mfn = $startmfn; $mfn <= $maxmfn; $mfn++) {          for (my $mfn = $startmfn; $mfn <= $maxmfn; $mfn++) {
# Line 225  sub open_isis { Line 254  sub open_isis {
254    
255                  my $rec;                  my $rec;
256    
257                  # read record                  if ($use_openisis) {
258                  my $row = OpenIsis::read( $isis_db, $mfn );  
259                  foreach my $k (keys %{$row}) {                          # read record using OpenIsis
260                          if ($k ne "mfn") {                          my $row = OpenIsis::read( $isis_db, $mfn );
261                                  foreach my $l (@{$row->{$k}}) {                          foreach my $k (keys %{$row}) {
262                                          $l = $cp->convert($l);                                  if ($k ne "mfn") {
263                                          # has subfields?                                          foreach my $l (@{$row->{$k}}) {
264                                          my $val;                                                  $l = $cp->convert($l);
265                                          if ($l =~ m/\^/) {                                                  # has subfields?
266                                                  foreach my $t (split(/\^/,$l)) {                                                  my $val;
267                                                          next if (! $t);                                                  if ($l =~ m/\^/) {
268                                                          $val->{substr($t,0,1)} = substr($t,1);                                                          foreach my $t (split(/\^/,$l)) {
269                                                                    next if (! $t);
270                                                                    $val->{substr($t,0,1)} = substr($t,1);
271                                                            }
272                                                    } else {
273                                                            $val = $l;
274                                                  }                                                  }
                                         } else {  
                                                 $val = $l;  
                                         }  
275    
276                                          push @{$rec->{$k}}, $val;                                                  push @{$rec->{$k}}, $val;
277                                            }
278                                    } else {
279                                            push @{$rec->{'000'}}, $mfn;
280                                  }                                  }
                         } else {  
                                 push @{$rec->{'000'}}, $mfn;  
281                          }                          }
282    
283                    } else {
284                            $rec = $isis_db->to_hash($mfn);
285                  }                  }
286    
287                  $log->confess("record $mfn empty?") unless ($rec);                  $log->confess("record $mfn empty?") unless ($rec);
# Line 357  sub progress_bar { Line 391  sub progress_bar {
391          # reset on re-run          # reset on re-run
392          if ($p < $self->{'last_pcnt'}) {          if ($p < $self->{'last_pcnt'}) {
393                  $self->{'last_pcnt'} = $p;                  $self->{'last_pcnt'} = $p;
394                  $self->{'last_t'} = time();                  $self->{'start_t'} = time();
                 $self->{'last_curr'} = undef;  
395          }          }
396    
397          if ($p != $self->{'last_pcnt'}) {          if ($p != $self->{'last_pcnt'}) {
398    
                 my $last_curr = $self->{'last_curr'} || $curr;  
399                  my $t = time();                  my $t = time();
400                  my $rate = ($curr - $last_curr) / (($t - $self->{'last_t'} || 1));                  my $rate = ($curr / ($t - $self->{'start_t'} || 1));
401                  my $eta = ($max-$curr) / ($rate || 1);                  my $eta = ($max-$curr) / ($rate || 1);
402                  printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta));                  printf STDERR ("%5d [%-38s] %-5d %0.1f/s %s\r",$curr,"=" x ($p/3)."$p%>", $max, $rate, $self->fmt_time($eta));
403                  $self->{'last_pcnt'} = $p;                  $self->{'last_pcnt'} = $p;
                 $self->{'last_t'} = time();  
404                  $self->{'last_curr'} = $curr;                  $self->{'last_curr'} = $curr;
405          }          }
406          print STDERR "\n" if ($p == 100);          print STDERR "\n" if ($p == 100);
# Line 560  sub fill_in { Line 591  sub fill_in {
591          # iteration (for repeatable fields)          # iteration (for repeatable fields)
592          my $i = shift || 0;          my $i = shift || 0;
593    
594            $log->logdie("infitite loop in format $format") if ($i > ($self->{'max_mfn'} || 9999));
595    
596          # FIXME remove for speedup?          # FIXME remove for speedup?
597          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);          $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
598    
# Line 573  sub fill_in { Line 606  sub fill_in {
606          # remove eval{...} from beginning          # remove eval{...} from beginning
607          $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);          $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
608    
609            my $filter_name;
610            # remove filter{...} from beginning
611            $filter_name = $1 if ($format =~ s/^filter{([^}]+)}//s);
612    
613          # do actual replacement of placeholders          # do actual replacement of placeholders
614            # repeatable fields
615          $format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found)/ges;          $format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found)/ges;
616            # non-repeatable fields
617            $format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found)/ges;
618    
619          if ($found) {          if ($found) {
620                  $log->debug("format: $format");                  $log->debug("format: $format");
# Line 582  sub fill_in { Line 622  sub fill_in {
622                          my $eval = $self->fill_in($rec,$eval_code,$i);                          my $eval = $self->fill_in($rec,$eval_code,$i);
623                          return if (! $self->_eval($eval));                          return if (! $self->_eval($eval));
624                  }                  }
625                    if ($filter_name && $self->{'filter'}->{$filter_name}) {
626                            $log->debug("filter '$filter_name' for $format");
627                            $format = $self->{'filter'}->{$filter_name}->($format);
628                            return unless(defined($format));
629                            $log->debug("filter result: $format");
630                    }
631                  # do we have lookups?                  # do we have lookups?
632                  if ($format =~ /$LOOKUP_REGEX/o) {                  if ($format =~ /$LOOKUP_REGEX/o) {
633                          $log->debug("format '$format' has lookup");                          $log->debug("format '$format' has lookup");
# Line 674  sub parse { Line 720  sub parse {
720          # remove eval{...} from beginning          # remove eval{...} from beginning
721          $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);          $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
722    
723            my $filter_name;
724            # remove filter{...} from beginning
725            $filter_name = $1 if ($format =~ s/^filter{([^}]+)}//s);
726    
727          my $prefix;          my $prefix;
728          my $all_found=0;          my $all_found=0;
729    
730          while ($format =~ s/^(.*?)v(\d+)(?:\^(\w))?//s) {          while ($format =~ s/^(.*?)(v|s)(\d+)(?:\^(\w))?//s) {
731    
732                  my $del = $1 || '';                  my $del = $1 || '';
733                  $prefix ||= $del if ($all_found == 0);                  $prefix ||= $del if ($all_found == 0);
734    
735                    # repeatable index
736                    my $r = $i;
737                    $r = 0 if (lc("$2") eq 's');
738    
739                  my $found = 0;                  my $found = 0;
740                  my $tmp = $self->get_data(\$rec,$2,$3,$i,\$found);                  my $tmp = $self->get_data(\$rec,$3,$4,$r,\$found);
741    
742                  if ($found) {                  if ($found) {
743                          push @out, $del;                          push @out, $del;
# Line 707  sub parse { Line 761  sub parse {
761          }          }
762    
763          if ($eval_code) {          if ($eval_code) {
764                  my $eval = $self->fill_in($rec,$eval_code,$i);                  my $eval = $self->fill_in($rec,$eval_code,$i) || return;
765                  $log->debug("about to eval{",$eval,"} format: $out");                  $log->debug("about to eval{$eval} format: $out");
766                  return if (! $self->_eval($eval));                  return if (! $self->_eval($eval));
767          }          }
768            
769            if ($filter_name && $self->{'filter'}->{$filter_name}) {
770                    $log->debug("about to filter{$filter_name} format: $out");
771                    $out = $self->{'filter'}->{$filter_name}->($out);
772                    return unless(defined($out));
773                    $log->debug("filter result: $out");
774            }
775    
776          return $out;          return $out;
777  }  }
# Line 860  sub data_structure { Line 921  sub data_structure {
921    
922                          if ($tag->{'sort'}) {                          if ($tag->{'sort'}) {
923                                  @v = $self->sort_arr(@v);                                  @v = $self->sort_arr(@v);
                                 $log->warn("sort within tag is usually not what you want!");  
924                          }                          }
925    
926                          # use format?                          # use format?
# Line 896  sub data_structure { Line 956  sub data_structure {
956                                          # delimiter (or ,)                                          # delimiter (or ,)
957                                          my $d = $tag->{'delimiter'};                                          my $d = $tag->{'delimiter'};
958                                          # default delimiter                                          # default delimiter
959                                          $d ||= ", ";                                          $d ||= " ";
960    
961                                          my $last = pop @{$row->{$type}};                                          my $last = pop @{$row->{$type}};
962                                          $d = "" if (! $last);                                          $d = "" if (! $last);
# Line 1068  sub _eval { Line 1128  sub _eval {
1128    
1129          $log->debug("eval: ",$code," [",$ret,"]");          $log->debug("eval: ",$code," [",$ret,"]");
1130    
1131          return $ret || 0;          return $ret || undef;
1132  }  }
1133    
1134  =head2 _sort_by_order  =head2 _sort_by_order
Legend:
Removed from v.454  
changed lines
  Added in v.616
  ViewVC Help
Powered by ViewVC 1.1.26