/[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 357 by dpavlin, Wed Jun 16 13:39:17 2004 UTC
# Line 129  sub open_isis { Line 129  sub open_isis {
129    
130          my $maxmfn = OpenIsis::maxRowid( $isis_db ) || 1;          my $maxmfn = OpenIsis::maxRowid( $isis_db ) || 1;
131    
132            $maxmfn = $self->{limit_mfn} if ($self->{limit_mfn});
133    
134          # read database          # read database
135          for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) {          for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) {
136    
# Line 156  sub open_isis { Line 158  sub open_isis {
158                  }                  }
159    
160                  # create lookup                  # create lookup
161                    my $rec = $self->{'data'}->{$mfn};
162                    $self->create_lookup($rec, @{$arg->{'lookup'}});
163    
                 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;  
                                 }  
                         }  
                 }  
164          }          }
165    
166          # store max mfn and return it.          # store max mfn and return it.
167          return $self->{'max_mfn'} = $maxmfn;          return $self->{'max_mfn'} = $maxmfn;
168  }  }
169    
170    =head2 create_lookup
171    
172    Create lookup from record using lookup definition.
173    
174    =cut
175    
176    sub create_lookup {
177            my $self = shift;
178    
179            my $rec = shift || confess "need record to create lookup";
180            confess("need HASH as first argument!") if ($rec !~ /HASH/o);
181    
182            foreach my $i (@_) {
183                    if ($i->{'eval'}) {
184                            my $eval = $self->fill_in($rec,$i->{'eval'});
185                            my $key = $self->fill_in($rec,$i->{'key'});
186                            my @val = $self->fill_in($rec,$i->{'val'});
187                            if ($key && @val && eval $eval) {
188                                    push @{$self->{'lookup'}->{$key}}, @val;
189                            }
190                    } else {
191                            my $key = $self->fill_in($rec,$i->{'key'});
192                            my @val = $self->fill_in($rec,$i->{'val'});
193                            if ($key && @val) {
194                                    push @{$self->{'lookup'}->{$key}}, @val;
195                            }
196                    }
197            }
198    }
199    
200    =head2 get_data
201    
202    Returns value from record.
203    
204     $self->get_data(\$rec,$f,$sf,$i,\$found);
205    
206    Arguments are:
207    record reference C<$rec>,
208    field C<$f>,
209    optional subfiled C<$sf>,
210    index for repeatable values C<$i>.
211    
212    Optinal variable C<$found> will be incremeted if thre
213    is field.
214    
215    Returns value or empty string.
216    
217    =cut
218    
219    sub get_data {
220            my $self = shift;
221    
222            my ($rec,$f,$sf,$i,$found) = @_;
223            if ($$rec->{$f}) {
224                    if ($sf && $$rec->{$f}->[$i]->{$sf}) {
225                            $$found++ if (defined($$found));
226                            return $$rec->{$f}->[$i]->{$sf};
227                    } elsif ($$rec->{$f}->[$i]) {
228                            $$found++ if (defined($$found));
229                            return $$rec->{$f}->[$i];
230                    }
231            } else {
232                    return '';
233            }
234    }
235    
236  =head2 fill_in  =head2 fill_in
237    
238  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 262  sub fill_in {
262          my $i = shift || 0;          my $i = shift || 0;
263    
264          # FIXME remove for speedup?          # FIXME remove for speedup?
265          if ($rec !~ /HASH/o) {          confess("need HASH as first argument!") if ($rec !~ /HASH/o);
                 confess("need HASH as first argument!");  
         }  
266    
267          my $found = 0;          my $found = 0;
268    
         # 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 '';  
                 }  
         }  
   
269          # do actual replacement of placeholders          # do actual replacement of placeholders
270          $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;  
271    
272          if ($found) {          if ($found) {
273                  # do we have lookups?                  # do we have lookups?
# Line 255  sub fill_in { Line 283  sub fill_in {
283    
284  =head2 lookup  =head2 lookup
285    
286  This function will perform lookups on format supplied to it.  Perform lookups on format supplied to it.
287    
288   my $txt = $self->lookup('[v900]');   my $txt = $self->lookup('[v900]');
289    
290    Lookups can be nested (like C<[d:[a:[v900]]]>).
291    
292  =cut  =cut
293    
294  sub lookup {  sub lookup {
# Line 295  sub lookup { Line 325  sub lookup {
325          }          }
326  }  }
327    
328    =head2 parse
329    
330    Perform smart parsing of string, skipping delimiters for fields which aren't
331    defined. It can also eval code in format starting with C<eval{...}> and
332    return output or nothing depending on eval code.
333    
334     $webpac->parse($rec,'eval{"v901^a" eq "Deskriptor"}descriptor: v250^a', $i);
335    
336    =cut
337    
338    sub parse {
339            my $self = shift;
340    
341            my ($rec, $format, $i) = @_;
342    
343            my @out;
344    
345            my $eval_code;
346            # remove eval{...} from beginning
347            $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
348    
349            my $prefix = '';
350            $prefix = $1 if ($format =~ s/^(.+)(v\d+(?:\^\w)*)/$2/s);
351    
352            sub f_sf_del {
353                    my ($self,$rec,$out,$f,$sf,$del,$i) = @_;
354    
355                    my $found=0;
356                    my $tmp = $self->get_data($rec,$f,$sf,$i,\$found);
357                    if ($found) {
358                            push @{$$out}, $tmp;
359                            push @{$$out}, $del;
360                    }
361                    return '';
362            }
363    
364            #$format =~ s/(.*)v(\d+)(?:\^(\w))*/f_sf_del($self,\$rec,\@out,$2,$3,$1,$i/ges;
365    
366            print Dumper(@out);
367    
368    }
369    
370  1;  1;
Legend:
Removed from v.354  
changed lines
  Added in v.357
  ViewVC Help
Powered by ViewVC 1.1.26