/[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 355 by dpavlin, Wed Jun 16 11:41:50 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    
9  WebPac - base class for WebPac  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    
17  =head2 new  =head2 new
18    
19  This will create new instance of WebPac using configuration specified by C<config_file>.  This will create new instance of WebPAC using configuration specified by C<config_file>.
20    
21   my $webpac = new WebPac(   my $webpac = new WebPAC(
22          config_file => 'name.conf',          config_file => 'name.conf',
23          [code_page => 'ISO-8859-2',]          [code_page => 'ISO-8859-2',]
24   );   );
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 163  sub open_isis { Line 156  sub open_isis {
156                  }                  }
157    
158                  # create lookup                  # create lookup
159                    my $rec = $self->{'data'}->{$mfn};
160                    $self->create_lookup($rec, @{$arg->{'lookup'}});
161    
                 foreach my $i (@{$arg->{lookup}}) {  
                         my $rec = $self->{'data'}->{$mfn};  
                         if ($i->{'eval'}) {  
                                 my $eval = $self->fill_in($rec,$i->{'eval'});  
                                 my $key = $self->fill_in($rec,$i->{'key'});  
                                 my @val = $self->fill_in($rec,$i->{'val'});  
                                 if ($key && @val && eval $eval) {  
                                         push @{$self->{'lookup'}->{$key}}, @val;  
                                 }  
                         } else {  
                                 my $key = $self->fill_in($rec,$i->{'key'});  
                                 my @val = $self->fill_in($rec,$i->{'val'});  
                                 if ($key && @val) {  
                                         push @{$self->{'lookup'}->{$key}}, @val;  
                                 }  
                         }  
                 }  
162          }          }
163    
164          # store max mfn and return it.          # store max mfn and return it.
165          return $self->{'max_mfn'} = $maxmfn;          return $self->{'max_mfn'} = $maxmfn;
166  }  }
167    
168    =head2 create_lookup
169    
170    Create lookup from record using lookup definition.
171    
172    =cut
173    
174    sub create_lookup {
175            my $self = shift;
176    
177            my $rec = shift || confess "need record to create lookup";
178            confess("need HASH as first argument!") if ($rec !~ /HASH/o);
179    
180            foreach my $i (@_) {
181                    if ($i->{'eval'}) {
182                            my $eval = $self->fill_in($rec,$i->{'eval'});
183                            my $key = $self->fill_in($rec,$i->{'key'});
184                            my @val = $self->fill_in($rec,$i->{'val'});
185                            if ($key && @val && eval $eval) {
186                                    push @{$self->{'lookup'}->{$key}}, @val;
187                            }
188                    } else {
189                            my $key = $self->fill_in($rec,$i->{'key'});
190                            my @val = $self->fill_in($rec,$i->{'val'});
191                            if ($key && @val) {
192                                    push @{$self->{'lookup'}->{$key}}, @val;
193                            }
194                    }
195            }
196    }
197    
198  =head2 fill_in  =head2 fill_in
199    
200  Workhourse of all: takes record from in-memory structure of database and  Workhourse of all: takes record from in-memory structure of database and
# Line 196  values from record. Line 204  values from record.
204   $webpac->fill_in($rec,'v250^a');   $webpac->fill_in($rec,'v250^a');
205    
206  Optional argument is ordinal number for repeatable fields. By default,  Optional argument is ordinal number for repeatable fields. By default,
207  it's assume to be first repeatable field.  it's assume to be first repeatable field (fields are perl array, so first
208    element is 0).
209    Following example will read second value from repeatable field.
210    
211     $webpac->fill_in($rec,'Title: v250^a',1);
212    
213    This function B<does not> perform parsing of format to inteligenty skip
214    delimiters before fields which aren't used.
215    
216  =cut  =cut
217    
# Line 209  sub fill_in { Line 224  sub fill_in {
224          my $i = shift || 0;          my $i = shift || 0;
225    
226          # FIXME remove for speedup?          # FIXME remove for speedup?
227          if ($rec !~ /HASH/) {          confess("need HASH as first argument!") if ($rec !~ /HASH/o);
                 confess("need HASH as first argument!");  
         }  
228    
229          my $found = 0;          my $found = 0;
230    
# Line 241  sub fill_in { Line 254  sub fill_in {
254          $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;
255          $format =~ s/v(\d+)/get_nosf(\$found,\$rec,$1,$i)/ges;          $format =~ s/v(\d+)/get_nosf(\$found,\$rec,$1,$i)/ges;
256    
257          if ($found) {            if ($found) {
258                  return $format;                  # do we have lookups?
259                    if ($format =~ /\[[^\[\]]+\]/o) {
260                            return $self->lookup($format);
261                    } else {
262                            return $format;
263                    }
264          } else {          } else {
265                  return;                  return;
266          }          }
# Line 250  sub fill_in { Line 268  sub fill_in {
268    
269  =head2 lookup  =head2 lookup
270    
271  This function will perform lookups on format supplied to it.  Perform lookups on format supplied to it.
272    
273   my $txt = $self->lookup('[v900]');   my $txt = $self->lookup('[v900]');
274    
275    Lookups can be nested (like C<[d:[a:[v900]]]>).
276    
277  =cut  =cut
278    
279  sub lookup {  sub lookup {
# Line 261  sub lookup { Line 281  sub lookup {
281    
282          my $tmp = shift || confess "need format";          my $tmp = shift || confess "need format";
283    
284          if ($tmp =~ /\[[^\[\]]+\]/) {          if ($tmp =~ /\[[^\[\]]+\]/o) {
285                  my @in = ( $tmp );                  my @in = ( $tmp );
286  print "##lookup $tmp\n";  #print "##lookup $tmp\n";
287                  my @out;                  my @out;
288                  while (my $f = shift @in) {                  while (my $f = shift @in) {
289                          if ($f =~ /\[([^\[\]]+)\]/) {                          if ($f =~ /\[([^\[\]]+)\]/) {
290                                  my $k = $1;                                  my $k = $1;
291                                  if ($self->{'lookup'}->{$k}) {                                  if ($self->{'lookup'}->{$k}) {
292  print "## lookup key = $k\n";  #print "## lookup key = $k\n";
293                                          foreach my $nv (@{$self->{'lookup'}->{$k}}) {                                          foreach my $nv (@{$self->{'lookup'}->{$k}}) {
294                                                  my $tmp2 = $f;                                                  my $tmp2 = $f;
295                                                  $tmp2 =~ s/\[$k\]/$nv/g;                                                  $tmp2 =~ s/\[$k\]/$nv/g;
296                                                  push @in, $tmp2;                                                  push @in, $tmp2;
297  print "## lookup in => $tmp2\n";  #print "## lookup in => $tmp2\n";
298                                          }                                          }
299                                  } else {                                  } else {
300                                          undef $f;                                          undef $f;
301                                  }                                  }
302                          } elsif ($f) {                          } elsif ($f) {
303                                  push @out, $f;                                  push @out, $f;
304  print "## lookup out => $f\n";  #print "## lookup out => $f\n";
305                          }                          }
306                  }                  }
307                  return @out;                  return @out;
Legend:
Removed from v.352  
changed lines
  Added in v.355
  ViewVC Help
Powered by ViewVC 1.1.26