/[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 362 by dpavlin, Wed Jun 16 16:50:30 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            $self->{'current_mfn'} = 1;
169    
170          # store max mfn and return it.          # store max mfn and return it.
171          return $self->{'max_mfn'} = $maxmfn;          return $self->{'max_mfn'} = $maxmfn;
172  }  }
173    
174    =head2 fetch_rec
175    
176    Fetch next record from database. It will also display progress bar (once
177    it's implemented, that is).
178    
179     my $rec = $webpac->fetch_rec;
180    
181    =cut
182    
183    sub fetch_rec {
184            my $self = shift;
185    
186            my $mfn = $self->{'current_mfn'}++ || confess "it seems that you didn't load database!";
187    
188            if ($mfn > $self->{'max_mfn'}) {
189                    $self->{'current_mfn'} = $self->{'max_mfn'};
190                    return;
191            }
192    
193            return $self->{'data'}->{$mfn};
194    }
195    
196    =head2 create_lookup
197    
198    Create lookup from record using lookup definition.
199    
200    =cut
201    
202    sub create_lookup {
203            my $self = shift;
204    
205            my $rec = shift || confess "need record to create lookup";
206            confess("need HASH as first argument!") if ($rec !~ /HASH/o);
207    
208            foreach my $i (@_) {
209                    if ($i->{'eval'}) {
210                            my $eval = $self->fill_in($rec,$i->{'eval'});
211                            my $key = $self->fill_in($rec,$i->{'key'});
212                            my @val = $self->fill_in($rec,$i->{'val'});
213                            if ($key && @val && eval $eval) {
214                                    push @{$self->{'lookup'}->{$key}}, @val;
215                            }
216                    } else {
217                            my $key = $self->fill_in($rec,$i->{'key'});
218                            my @val = $self->fill_in($rec,$i->{'val'});
219                            if ($key && @val) {
220                                    push @{$self->{'lookup'}->{$key}}, @val;
221                            }
222                    }
223            }
224    }
225    
226    =head2 get_data
227    
228    Returns value from record.
229    
230     $self->get_data(\$rec,$f,$sf,$i,\$found);
231    
232    Arguments are:
233    record reference C<$rec>,
234    field C<$f>,
235    optional subfiled C<$sf>,
236    index for repeatable values C<$i>.
237    
238    Optinal variable C<$found> will be incremeted if thre
239    is field.
240    
241    Returns value or empty string.
242    
243    =cut
244    
245    sub get_data {
246            my $self = shift;
247    
248            my ($rec,$f,$sf,$i,$found) = @_;
249            if ($$rec->{$f}) {
250                    if ($sf && $$rec->{$f}->[$i]->{$sf}) {
251                            $$found++ if (defined($$found));
252                            return $$rec->{$f}->[$i]->{$sf};
253                    } elsif ($$rec->{$f}->[$i]) {
254                            $$found++ if (defined($$found));
255                            return $$rec->{$f}->[$i];
256                    }
257            } else {
258                    return '';
259            }
260    }
261    
262  =head2 fill_in  =head2 fill_in
263    
264  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 288  sub fill_in {
288          my $i = shift || 0;          my $i = shift || 0;
289    
290          # FIXME remove for speedup?          # FIXME remove for speedup?
291          if ($rec !~ /HASH/o) {          confess("need HASH as first argument!") if ($rec !~ /HASH/o);
                 confess("need HASH as first argument!");  
         }  
292    
293          my $found = 0;          my $found = 0;
294    
295          # get field with subfield          my $eval_code;
296          sub get_sf {          # remove eval{...} from beginning
297                  my ($found,$rec,$f,$sf,$i) = @_;          $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
                 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 '';  
                 }  
         }  
298    
299          # do actual replacement of placeholders          # do actual replacement of placeholders
300          $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;  
301    
302          if ($found) {          if ($found) {
303                    if ($eval_code) {
304                            my $eval = $self->fill_in($rec,$eval_code,$i);
305                            return if (! eval $eval);
306                    }
307                  # do we have lookups?                  # do we have lookups?
308                  if ($format =~ /\[[^\[\]]+\]/o) {                  if ($format =~ /\[[^\[\]]+\]/o) {
309                          return $self->lookup($format);                          return $self->lookup($format);
# Line 255  sub fill_in { Line 317  sub fill_in {
317    
318  =head2 lookup  =head2 lookup
319    
320  This function will perform lookups on format supplied to it.  Perform lookups on format supplied to it.
321    
322   my $txt = $self->lookup('[v900]');   my $txt = $self->lookup('[v900]');
323    
324    Lookups can be nested (like C<[d:[a:[v900]]]>).
325    
326  =cut  =cut
327    
328  sub lookup {  sub lookup {
# Line 295  sub lookup { Line 359  sub lookup {
359          }          }
360  }  }
361    
362    =head2 parse
363    
364    Perform smart parsing of string, skipping delimiters for fields which aren't
365    defined. It can also eval code in format starting with C<eval{...}> and
366    return output or nothing depending on eval code.
367    
368     $webpac->parse($rec,'eval{"v901^a" eq "Deskriptor"}descriptor: v250^a', $i);
369    
370    =cut
371    
372    sub parse {
373            my $self = shift;
374    
375            my ($rec, $format, $i) = @_;
376    
377            confess("need HASH as first argument!") if ($rec !~ /HASH/o);
378    
379            $i = 0 if (! $i);
380    
381            my @out;
382    
383            my $eval_code;
384            # remove eval{...} from beginning
385            $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
386    
387            my $prefix;
388            my $all_found=0;
389    
390    #print "## $format\n";
391            while ($format =~ s/^(.*?)v(\d+)(?:\^(\w))*//s) {
392    #print "## [ $1 | $2 | $3 ] $format\n";
393    
394                    my $del = $1 || '';
395                    $prefix ||= $del if ($all_found == 0);
396    
397                    my $found = 0;
398                    my $tmp = $self->get_data(\$rec,$2,$3,$i,\$found);
399    
400                    if ($found) {
401                            push @out, $del;
402                            push @out, $tmp;
403                            $all_found += $found;
404                    }
405            }
406    
407            return if (! $all_found);
408    
409            my $out = join('',@out) . $format;
410    
411            # add prefix if not there
412            $out = $prefix . $out if ($out !~ m/^\Q$prefix\E/);
413            
414            if ($eval_code) {
415                    my $eval = $self->fill_in($rec,$eval_code,$i);
416                    return if (! eval $eval);
417            }
418    
419            return $out;
420    }
421    
422  1;  1;
Legend:
Removed from v.354  
changed lines
  Added in v.362
  ViewVC Help
Powered by ViewVC 1.1.26