/[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 354 by dpavlin, Wed Jun 16 11:31:42 2004 UTC revision 358 by dpavlin, Wed Jun 16 14:31:33 2004 UTC
# Line 4  use Carp; Line 4  use Carp;
4  use Text::Iconv;  use Text::Iconv;
5  use Config::IniFiles;  use Config::IniFiles;
6    
7    use Data::Dumper;
8    
9  =head1 NAME  =head1 NAME
10    
11  WebPAC - base class for WebPAC  WebPAC - base class for WebPAC
# Line 129  sub open_isis { Line 131  sub open_isis {
131    
132          my $maxmfn = OpenIsis::maxRowid( $isis_db ) || 1;          my $maxmfn = OpenIsis::maxRowid( $isis_db ) || 1;
133    
134            $maxmfn = $self->{limit_mfn} if ($self->{limit_mfn});
135    
136          # read database          # read database
137          for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) {          for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) {
138    
# Line 156  sub open_isis { Line 160  sub open_isis {
160                  }                  }
161    
162                  # create lookup                  # create lookup
163                    my $rec = $self->{'data'}->{$mfn};
164                    $self->create_lookup($rec, @{$arg->{'lookup'}});
165    
                 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;  
                                 }  
                         }  
                 }  
166          }          }
167    
168          # store max mfn and return it.          # store max mfn and return it.
169          return $self->{'max_mfn'} = $maxmfn;          return $self->{'max_mfn'} = $maxmfn;
170  }  }
171    
172    =head2 create_lookup
173    
174    Create lookup from record using lookup definition.
175    
176    =cut
177    
178    sub create_lookup {
179            my $self = shift;
180    
181            my $rec = shift || confess "need record to create lookup";
182            confess("need HASH as first argument!") if ($rec !~ /HASH/o);
183    
184            foreach my $i (@_) {
185                    if ($i->{'eval'}) {
186                            my $eval = $self->fill_in($rec,$i->{'eval'});
187                            my $key = $self->fill_in($rec,$i->{'key'});
188                            my @val = $self->fill_in($rec,$i->{'val'});
189                            if ($key && @val && eval $eval) {
190                                    push @{$self->{'lookup'}->{$key}}, @val;
191                            }
192                    } else {
193                            my $key = $self->fill_in($rec,$i->{'key'});
194                            my @val = $self->fill_in($rec,$i->{'val'});
195                            if ($key && @val) {
196                                    push @{$self->{'lookup'}->{$key}}, @val;
197                            }
198                    }
199            }
200    }
201    
202    =head2 get_data
203    
204    Returns value from record.
205    
206     $self->get_data(\$rec,$f,$sf,$i,\$found);
207    
208    Arguments are:
209    record reference C<$rec>,
210    field C<$f>,
211    optional subfiled C<$sf>,
212    index for repeatable values C<$i>.
213    
214    Optinal variable C<$found> will be incremeted if thre
215    is field.
216    
217    Returns value or empty string.
218    
219    =cut
220    
221    sub get_data {
222            my $self = shift;
223    
224            my ($rec,$f,$sf,$i,$found) = @_;
225            if ($$rec->{$f}) {
226                    if ($sf && $$rec->{$f}->[$i]->{$sf}) {
227                            $$found++ if (defined($$found));
228                            return $$rec->{$f}->[$i]->{$sf};
229                    } elsif ($$rec->{$f}->[$i]) {
230                            $$found++ if (defined($$found));
231                            return $$rec->{$f}->[$i];
232                    }
233            } else {
234                    return '';
235            }
236    }
237    
238  =head2 fill_in  =head2 fill_in
239    
240  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 209  sub fill_in { Line 264  sub fill_in {
264          my $i = shift || 0;          my $i = shift || 0;
265    
266          # FIXME remove for speedup?          # FIXME remove for speedup?
267          if ($rec !~ /HASH/o) {          confess("need HASH as first argument!") if ($rec !~ /HASH/o);
                 confess("need HASH as first argument!");  
         }  
268    
269          my $found = 0;          my $found = 0;
270    
         # get field with subfield  
         sub get_sf {  
                 my ($found,$rec,$f,$sf,$i) = @_;  
                 if ($$rec->{$f} && $$rec->{$f}->[$i]->{$sf}) {  
                         $$found++;  
                         return $$rec->{$f}->[$i]->{$sf};  
                 } else {  
                         return '';  
                 }  
         }  
   
         # get field (without subfield)  
         sub get_nosf {  
                 my ($found,$rec,$f,$i) = @_;  
                 if ($$rec->{$f} && $$rec->{$f}->[$i]) {  
                         $$found++;  
                         return $$rec->{$f}->[$i];  
                 } else {  
                         return '';  
                 }  
         }  
   
271          # do actual replacement of placeholders          # do actual replacement of placeholders
272          $format =~ s/v(\d+)\^(\w)/get_sf(\$found,\$rec,$1,$2,$i)/ges;          $format =~ s/v(\d+)(?:\^(\w))*/$self->get_data(\$rec,$1,$2,$i,\$found)/ges;
         $format =~ s/v(\d+)/get_nosf(\$found,\$rec,$1,$i)/ges;  
273    
274          if ($found) {          if ($found) {
275                  # do we have lookups?                  # do we have lookups?
# Line 255  sub fill_in { Line 285  sub fill_in {
285    
286  =head2 lookup  =head2 lookup
287    
288  This function will perform lookups on format supplied to it.  Perform lookups on format supplied to it.
289    
290   my $txt = $self->lookup('[v900]');   my $txt = $self->lookup('[v900]');
291    
292    Lookups can be nested (like C<[d:[a:[v900]]]>).
293    
294  =cut  =cut
295    
296  sub lookup {  sub lookup {
# Line 295  sub lookup { Line 327  sub lookup {
327          }          }
328  }  }
329    
330    =head2 parse
331    
332    Perform smart parsing of string, skipping delimiters for fields which aren't
333    defined. It can also eval code in format starting with C<eval{...}> and
334    return output or nothing depending on eval code.
335    
336     $webpac->parse($rec,'eval{"v901^a" eq "Deskriptor"}descriptor: v250^a', $i);
337    
338    =cut
339    
340    sub parse {
341            my $self = shift;
342    
343            my ($rec, $format, $i) = @_;
344    
345            confess("need HASH as first argument!") if ($rec !~ /HASH/o);
346    
347            $i = 0 if (! $i);
348    
349            my @out;
350    
351            my $eval_code;
352            # remove eval{...} from beginning
353            $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
354    
355            my $prefix;
356            my $all_found=0;
357    
358    print "## $format\n";
359            while ($format =~ s/^(.*?)v(\d+)(?:\^(\w))*//s) {
360    print "## [ $1 | $2 | $3 ] $format\n";
361    
362                    my $del = $1 || '';
363                    $prefix ||= $del;
364    
365                    my $found = 0;
366                    my $tmp = $self->get_data(\$rec,$2,$3,$i,\$found);
367    
368                    if ($found) {
369                            push @out, $del;
370                            push @out, $tmp;
371                            $all_found += $found;
372                    }
373            }
374    
375            return if (! $all_found);
376    
377            print Dumper($prefix, \@out);
378    
379            my $out = join('',@out) . $format;
380    
381            # add prefix if not there
382            $out = $prefix . $out if ($out !~ m/^\Q$prefix\E/);
383            
384            return $out;
385    }
386    
387  1;  1;

Legend:
Removed from v.354  
changed lines
  Added in v.358

  ViewVC Help
Powered by ViewVC 1.1.26