/[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!

Diff of /trunk2/lib/WebPAC.pm

Parent Directory | Revision Log | View Patch Patch

-revision 355 by dpavlin,
Wed Jun 16 11:41:50 2004 UTC
+revision 362 by dpavlin,
Wed Jun 16 16:50:30 2004 UTC
 Line 4 
 use Carp;
  use Text::Iconv;
  use Config::IniFiles;
+ use Data::Dumper;
  =head1 NAME
  WebPAC - base class for WebPAC
-Line 129 
 sub open_isis {
+Line 131 
 sub open_isis {
          my $maxmfn = OpenIsis::maxRowid( $isis_db ) || 1;
+         $maxmfn = $self->{limit_mfn} if ($self->{limit_mfn});
          # read database
          for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) {
-Line 161 
 sub open_isis {
+Line 165 
 sub open_isis {
          }
+         $self->{'current_mfn'} = 1;
          # store max mfn and return it.
          return $self->{'max_mfn'} = $maxmfn;
  }
+ =head2 fetch_rec
+ Fetch next record from database. It will also display progress bar (once
+ it's implemented, that is).
+  my $rec = $webpac->fetch_rec;
+ =cut
+ sub fetch_rec {
+         my $self = shift;
+         my $mfn = $self->{'current_mfn'}++ || confess "it seems that you didn't load database!";
+         if ($mfn > $self->{'max_mfn'}) {
+                 $self->{'current_mfn'} = $self->{'max_mfn'};
+                 return;
+         }
+         return $self->{'data'}->{$mfn};
+ }
  =head2 create_lookup
  Create lookup from record using lookup definition.
-Line 195 
 sub create_lookup {
+Line 223 
 sub create_lookup {
          }
  }
+ =head2 get_data
+ Returns value from record.
+  $self->get_data(\$rec,$f,$sf,$i,\$found);
+ Arguments are:
+ record reference C<$rec>,
+ field C<$f>,
+ optional subfiled C<$sf>,
+ index for repeatable values C<$i>.
+ Optinal variable C<$found> will be incremeted if thre
+ is field.
+ Returns value or empty string.
+ =cut
+ sub get_data {
+         my $self = shift;
+         my ($rec,$f,$sf,$i,$found) = @_;
+         if ($$rec->{$f}) {
+                 if ($sf && $$rec->{$f}->[$i]->{$sf}) {
+                         $$found++ if (defined($$found));
+                         return $$rec->{$f}->[$i]->{$sf};
+                 } elsif ($$rec->{$f}->[$i]) {
+                         $$found++ if (defined($$found));
+                         return $$rec->{$f}->[$i];
+                 }
+         } else {
+                 return '';
+         }
+ }
  =head2 fill_in
  Workhourse of all: takes record from in-memory structure of database and
-Line 228 
 sub fill_in {
+Line 292 
 sub fill_in {
          my $found = 0;
-         # get field with subfield
+         my $eval_code;
-         sub get_sf {
+         # remove eval{...} from beginning
-                 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 '';
-                 }
-         }
          # do actual replacement of placeholders
-         $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;
          if ($found) {
+                 if ($eval_code) {
+                         my $eval = $self->fill_in($rec,$eval_code,$i);
+                         return if (! eval $eval);
+                 }
                  # do we have lookups?
                  if ($format =~ /\[[^\[\]]+\]/o) {
                          return $self->lookup($format);
-Line 310 
 sub lookup {
+Line 359 
 sub lookup {
          }
  }
+ =head2 parse
+ Perform smart parsing of string, skipping delimiters for fields which aren't
+ defined. It can also eval code in format starting with C<eval{...}> and
+ return output or nothing depending on eval code.
+  $webpac->parse($rec,'eval{"v901^a" eq "Deskriptor"}descriptor: v250^a', $i);
+ =cut
+ sub parse {
+         my $self = shift;
+         my ($rec, $format, $i) = @_;
+         confess("need HASH as first argument!") if ($rec !~ /HASH/o);
+         $i = 0 if (! $i);
+         my @out;
+         my $eval_code;
+         # remove eval{...} from beginning
+         $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
+         my $prefix;
+         my $all_found=0;
+ #print "## $format\n";
+         while ($format =~ s/^(.*?)v(\d+)(?:\^(\w))*//s) {
+ #print "## [ $1 | $2 | $3 ] $format\n";
+                 my $del = $1 || '';
+                 $prefix ||= $del if ($all_found == 0);
+                 my $found = 0;
+                 my $tmp = $self->get_data(\$rec,$2,$3,$i,\$found);
+                 if ($found) {
+                         push @out, $del;
+                         push @out, $tmp;
+                         $all_found += $found;
+                 }
+         }
+         return if (! $all_found);
+         my $out = join('',@out) . $format;
+         # add prefix if not there
+         $out = $prefix . $out if ($out !~ m/^\Q$prefix\E/);
+         if ($eval_code) {
+                 my $eval = $self->fill_in($rec,$eval_code,$i);
+                 return if (! eval $eval);
+         }
+         return $out;
+ }
 ;

 Legend:



Removed from v.355
 


changed lines


 
Added in v.362
 Legend:



Removed from v.355
 


changed lines


 
Added in v.362
-Removed from v.355
+Added in v.362

	ViewVC Help
Powered by ViewVC 1.1.26