/[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 352 by dpavlin, Tue Jun 15 22:40:07 2004 UTC revision 353 by dpavlin, Wed Jun 16 11:29:37 2004 UTC
# Line 1  Line 1 
1  package WebPac;  package WebPac;
2    
3  use Carp;  use Carp;
4    use Text::Iconv;
5    use Config::IniFiles;
6    
7  =head1 NAME  =head1 NAME
8    
# Line 8  WebPac - base class for WebPac Line 10  WebPac - base class for WebPac
10    
11  =head1 DESCRIPTION  =head1 DESCRIPTION
12    
13  This class does basic thing for WebPac.  This module implements methods used by WebPac.
14    
15  =head1 METHODS  =head1 METHODS
16    
# Line 23  This will create new instance of WebPac Line 25  This will create new instance of WebPac
25    
26  Default C<code_page> is C<ISO-8859-2>.  Default C<code_page> is C<ISO-8859-2>.
27    
28    It will also read configuration files
29    C<global.conf> (used by indexer and Web font-end)
30    and configuration file specified by C<config_file>
31    which describes databases to be indexed.
32    
33  =cut  =cut
34    
35  sub new {  sub new {
# Line 34  sub new { Line 41  sub new {
41          # output codepage          # output codepage
42          $self->{'code_page'} = 'ISO-8859-2' if (! $self->{'code_page'});          $self->{'code_page'} = 'ISO-8859-2' if (! $self->{'code_page'});
43    
44          return $self;          #
45  }          # read global.conf
46            #
 =head2 read_global_config  
   
 Read global configuration (used by indexer and Web font-end)  
   
 =cut  
   
 sub read_global_config {  
         my $self = shift;  
47    
48          $self->{global_config_file} = new Config::IniFiles( -file => 'global.conf' ) || croak "can't open 'global.conf'";          $self->{global_config_file} = new Config::IniFiles( -file => 'global.conf' ) || croak "can't open 'global.conf'";
49    
# Line 60  sub read_global_config { Line 59  sub read_global_config {
59                  $self->{global_config}->{$var} = $self->{global_config_file}->val('global', $var);                  $self->{global_config}->{$var} = $self->{global_config_file}->val('global', $var);
60          }          }
61    
62          return $self;          #
63  }          # read indexer config file
64            #
 =head2 read_indexer_config  
   
 Read indexer configuration (specify databases, types etc.)  
   
 =cut  
   
 sub read_indexer_config {  
         my $self = shift;  
65    
66          $self->{indexer_config_file} = new Config::IniFiles( -file => $self->{config_file} ) || croak "can't open '$self->{config_file}'";          $self->{indexer_config_file} = new Config::IniFiles( -file => $self->{config_file} ) || croak "can't open '$self->{config_file}'";
67    
# Line 102  Open CDS/ISIS database using OpenIsis mo Line 93  Open CDS/ISIS database using OpenIsis mo
93    
94  By default, ISIS code page is assumed to be C<852>.  By default, ISIS code page is assumed to be C<852>.
95    
96  If C<limit_mfn> is set, it will read just 500 records from  If optional parametar C<limit_mfn> is set, it will read just 500 records
97  database in example above.  from database in example above.
98    
99  Returns number of last record read into memory (size of database, really).  Returns number of last record read into memory (size of database, really).
100    
# Line 127  sub open_isis { Line 118  sub open_isis {
118          croak "need filename" if (! $arg->{'filename'});          croak "need filename" if (! $arg->{'filename'});
119          my $code_page = $arg->{'code_page'} || '852';          my $code_page = $arg->{'code_page'} || '852';
120    
121            use OpenIsis;
122    
123          #$self->{'isis_code_page'} = $code_page;          #$self->{'isis_code_page'} = $code_page;
124    
125          # create Text::Iconv object          # create Text::Iconv object
# Line 196  values from record. Line 189  values from record.
189   $webpac->fill_in($rec,'v250^a');   $webpac->fill_in($rec,'v250^a');
190    
191  Optional argument is ordinal number for repeatable fields. By default,  Optional argument is ordinal number for repeatable fields. By default,
192  it's assume to be first repeatable field.  it's assume to be first repeatable field (fields are perl array, so first
193    element is 0).
194    Following example will read second value from repeatable field.
195    
196     $webpac->fill_in($rec,'Title: v250^a',1);
197    
198    This function B<does not> perform parsing of format to inteligenty skip
199    delimiters before fields which aren't used.
200    
201  =cut  =cut
202    
# Line 209  sub fill_in { Line 209  sub fill_in {
209          my $i = shift || 0;          my $i = shift || 0;
210    
211          # FIXME remove for speedup?          # FIXME remove for speedup?
212          if ($rec !~ /HASH/) {          if ($rec !~ /HASH/o) {
213                  confess("need HASH as first argument!");                  confess("need HASH as first argument!");
214          }          }
215    
# Line 241  sub fill_in { Line 241  sub fill_in {
241          $format =~ s/v(\d+)\^(\w)/get_sf(\$found,\$rec,$1,$2,$i)/ges;          $format =~ s/v(\d+)\^(\w)/get_sf(\$found,\$rec,$1,$2,$i)/ges;
242          $format =~ s/v(\d+)/get_nosf(\$found,\$rec,$1,$i)/ges;          $format =~ s/v(\d+)/get_nosf(\$found,\$rec,$1,$i)/ges;
243    
244          if ($found) {            if ($found) {
245                  return $format;                  # do we have lookups?
246                    if ($format =~ /\[[^\[\]]+\]/o) {
247                            return $self->lookup($format);
248                    } else {
249                            return $format;
250                    }
251          } else {          } else {
252                  return;                  return;
253          }          }
# Line 261  sub lookup { Line 266  sub lookup {
266    
267          my $tmp = shift || confess "need format";          my $tmp = shift || confess "need format";
268    
269          if ($tmp =~ /\[[^\[\]]+\]/) {          if ($tmp =~ /\[[^\[\]]+\]/o) {
270                  my @in = ( $tmp );                  my @in = ( $tmp );
271  print "##lookup $tmp\n";  #print "##lookup $tmp\n";
272                  my @out;                  my @out;
273                  while (my $f = shift @in) {                  while (my $f = shift @in) {
274                          if ($f =~ /\[([^\[\]]+)\]/) {                          if ($f =~ /\[([^\[\]]+)\]/) {
275                                  my $k = $1;                                  my $k = $1;
276                                  if ($self->{'lookup'}->{$k}) {                                  if ($self->{'lookup'}->{$k}) {
277  print "## lookup key = $k\n";  #print "## lookup key = $k\n";
278                                          foreach my $nv (@{$self->{'lookup'}->{$k}}) {                                          foreach my $nv (@{$self->{'lookup'}->{$k}}) {
279                                                  my $tmp2 = $f;                                                  my $tmp2 = $f;
280                                                  $tmp2 =~ s/\[$k\]/$nv/g;                                                  $tmp2 =~ s/\[$k\]/$nv/g;
281                                                  push @in, $tmp2;                                                  push @in, $tmp2;
282  print "## lookup in => $tmp2\n";  #print "## lookup in => $tmp2\n";
283                                          }                                          }
284                                  } else {                                  } else {
285                                          undef $f;                                          undef $f;
286                                  }                                  }
287                          } elsif ($f) {                          } elsif ($f) {
288                                  push @out, $f;                                  push @out, $f;
289  print "## lookup out => $f\n";  #print "## lookup out => $f\n";
290                          }                          }
291                  }                  }
292                  return @out;                  return @out;

Legend:
Removed from v.352  
changed lines
  Added in v.353

  ViewVC Help
Powered by ViewVC 1.1.26