/[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 355 by dpavlin, Wed Jun 16 11:41:50 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 195  sub create_lookup { Line 199  sub create_lookup {
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 228  sub fill_in { Line 268  sub fill_in {
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 310  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.355  
changed lines
  Added in v.358
  ViewVC Help
Powered by ViewVC 1.1.26