/[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 356 by dpavlin, Wed Jun 16 13:41:54 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 get_data
199    
200    Returns value from record.
201    
202     $self->get_data(\$rec,$f,$sf,$i,\$found);
203    
204    Arguments are:
205    record reference C<$rec>,
206    field C<$f>,
207    optional subfiled C<$sf>,
208    index for repeatable values C<$i>.
209    
210    Optinal variable C<$found> will be incremeted if thre
211    is field.
212    
213    Returns value or empty string.
214    
215    =cut
216    
217    sub get_data {
218            my $self = shift;
219    
220            my ($rec,$f,$sf,$i,$found) = @_;
221            if ($$rec->{$f}) {
222                    if ($sf && $$rec->{$f}->[$i]->{$sf}) {
223                            $$found++ if (defined($$found));
224                            return $$rec->{$f}->[$i]->{$sf};
225                    } elsif ($$rec->{$f}->[$i]) {
226                            $$found++ if (defined($$found));
227                            return $$rec->{$f}->[$i];
228                    }
229            } else {
230                    return '';
231            }
232    }
233    
234  =head2 fill_in  =head2 fill_in
235    
236  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 240  values from record.
240   $webpac->fill_in($rec,'v250^a');   $webpac->fill_in($rec,'v250^a');
241    
242  Optional argument is ordinal number for repeatable fields. By default,  Optional argument is ordinal number for repeatable fields. By default,
243  it's assume to be first repeatable field.  it's assume to be first repeatable field (fields are perl array, so first
244    element is 0).
245    Following example will read second value from repeatable field.
246    
247     $webpac->fill_in($rec,'Title: v250^a',1);
248    
249    This function B<does not> perform parsing of format to inteligenty skip
250    delimiters before fields which aren't used.
251    
252  =cut  =cut
253    
# Line 209  sub fill_in { Line 260  sub fill_in {
260          my $i = shift || 0;          my $i = shift || 0;
261    
262          # FIXME remove for speedup?          # FIXME remove for speedup?
263          if ($rec !~ /HASH/) {          confess("need HASH as first argument!") if ($rec !~ /HASH/o);
                 confess("need HASH as first argument!");  
         }  
264    
265          my $found = 0;          my $found = 0;
266    
267          # get field with subfield          # do actual replacement of placeholders
268          sub get_sf {          $format =~ s/v(\d+)(?:\^(\w))*/$self->get_data(\$rec,$1,$2,$i,\$found)/ges;
                 my ($found,$rec,$f,$sf,$i) = @_;  
                 if ($$rec->{$f} && $$rec->{$f}->[$i]->{$sf}) {  
                         $$found++;  
                         return $$rec->{$f}->[$i]->{$sf};  
                 } else {  
                         return '';  
                 }  
         }  
269    
270          # get field (without subfield)          if ($found) {
271          sub get_nosf {                  # do we have lookups?
272                  my ($found,$rec,$f,$i) = @_;                  if ($format =~ /\[[^\[\]]+\]/o) {
273                  if ($$rec->{$f} && $$rec->{$f}->[$i]) {                          return $self->lookup($format);
                         $$found++;  
                         return $$rec->{$f}->[$i];  
274                  } else {                  } else {
275                          return '';                          return $format;
276                  }                  }
         }  
   
         # do actual replacement of placeholders  
         $format =~ s/v(\d+)\^(\w)/get_sf(\$found,\$rec,$1,$2,$i)/ges;  
         $format =~ s/v(\d+)/get_nosf(\$found,\$rec,$1,$i)/ges;  
   
         if ($found) {    
                 return $format;  
277          } else {          } else {
278                  return;                  return;
279          }          }
# Line 250  sub fill_in { Line 281  sub fill_in {
281    
282  =head2 lookup  =head2 lookup
283    
284  This function will perform lookups on format supplied to it.  Perform lookups on format supplied to it.
285    
286   my $txt = $self->lookup('[v900]');   my $txt = $self->lookup('[v900]');
287    
288    Lookups can be nested (like C<[d:[a:[v900]]]>).
289    
290  =cut  =cut
291    
292  sub lookup {  sub lookup {
# Line 261  sub lookup { Line 294  sub lookup {
294    
295          my $tmp = shift || confess "need format";          my $tmp = shift || confess "need format";
296    
297          if ($tmp =~ /\[[^\[\]]+\]/) {          if ($tmp =~ /\[[^\[\]]+\]/o) {
298                  my @in = ( $tmp );                  my @in = ( $tmp );
299  print "##lookup $tmp\n";  #print "##lookup $tmp\n";
300                  my @out;                  my @out;
301                  while (my $f = shift @in) {                  while (my $f = shift @in) {
302                          if ($f =~ /\[([^\[\]]+)\]/) {                          if ($f =~ /\[([^\[\]]+)\]/) {
303                                  my $k = $1;                                  my $k = $1;
304                                  if ($self->{'lookup'}->{$k}) {                                  if ($self->{'lookup'}->{$k}) {
305  print "## lookup key = $k\n";  #print "## lookup key = $k\n";
306                                          foreach my $nv (@{$self->{'lookup'}->{$k}}) {                                          foreach my $nv (@{$self->{'lookup'}->{$k}}) {
307                                                  my $tmp2 = $f;                                                  my $tmp2 = $f;
308                                                  $tmp2 =~ s/\[$k\]/$nv/g;                                                  $tmp2 =~ s/\[$k\]/$nv/g;
309                                                  push @in, $tmp2;                                                  push @in, $tmp2;
310  print "## lookup in => $tmp2\n";  #print "## lookup in => $tmp2\n";
311                                          }                                          }
312                                  } else {                                  } else {
313                                          undef $f;                                          undef $f;
314                                  }                                  }
315                          } elsif ($f) {                          } elsif ($f) {
316                                  push @out, $f;                                  push @out, $f;
317  print "## lookup out => $f\n";  #print "## lookup out => $f\n";
318                          }                          }
319                  }                  }
320                  return @out;                  return @out;
# Line 290  print "## lookup out => $f\n"; Line 323  print "## lookup out => $f\n";
323          }          }
324  }  }
325    
326    =head2 parse
327    
328    Perform smart parsing of string, skipping delimiters for fields which aren't
329    defined. It can also eval code in format starting with C<eval{...}> and
330    return output or nothing depending on eval code.
331    
332     $webpac->parse($rec,'eval{"v901^a" eq "Deskriptor"}descriptor: v250^a', $i);
333    
334    =cut
335    
336    sub parse {
337            my $self = shift;
338    
339            my ($rec, $format, $i) = @_;
340    
341            my @out;
342    
343            my $eval_code;
344            # remove eval{...} from beginning
345            $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
346    
347            my $prefix = '';
348            $prefix = $1 if ($format =~ s/^(.+)(v\d+(?:\^\w)*)/$2/s);
349    
350            sub f_sf_del {
351                    my ($self,$rec,$out,$f,$sf,$del,$i) = @_;
352    
353                    my $found=0;
354                    my $tmp = $self->get_data($rec,$f,$sf,$i,\$found);
355                    if ($found) {
356                            push @{$$out}, $tmp;
357                            push @{$$out}, $del;
358                    }
359                    return '';
360            }
361    
362            #$format =~ s/(.*)v(\d+)(?:\^(\w))*/f_sf_del($self,\$rec,\@out,$2,$3,$1,$i/ges;
363    
364            print Dumper(@out);
365    
366    }
367    
368  1;  1;
Legend:
Removed from v.352  
changed lines
  Added in v.356
  ViewVC Help
Powered by ViewVC 1.1.26