/[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 356 by dpavlin, Wed Jun 16 13:41:54 2004 UTC
# Line 156  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 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/o) {          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    
         # 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 '';  
                 }  
         }  
   
267          # do actual replacement of placeholders          # do actual replacement of placeholders
268          $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;  
269    
270          if ($found) {          if ($found) {
271                  # do we have lookups?                  # do we have lookups?
# Line 255  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 295  sub lookup { Line 323  sub lookup {
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.354  
changed lines
  Added in v.356
  ViewVC Help
Powered by ViewVC 1.1.26