/[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 356 by dpavlin, Wed Jun 16 13:41:54 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 161  sub open_isis { Line 165  sub open_isis {
165    
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  =head2 create_lookup
197    
198  Create lookup from record using lookup definition.  Create lookup from record using lookup definition.
# Line 264  sub fill_in { Line 292  sub fill_in {
292    
293          my $found = 0;          my $found = 0;
294    
295            my $eval_code;
296            # remove eval{...} from beginning
297            $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
298    
299          # do actual replacement of placeholders          # do actual replacement of placeholders
300          $format =~ s/v(\d+)(?:\^(\w))*/$self->get_data(\$rec,$1,$2,$i,\$found)/ges;          $format =~ s/v(\d+)(?:\^(\w))*/$self->get_data(\$rec,$1,$2,$i,\$found)/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 338  sub parse { Line 374  sub parse {
374    
375          my ($rec, $format, $i) = @_;          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;          my @out;
382    
383          my $eval_code;          my $eval_code;
384          # remove eval{...} from beginning          # remove eval{...} from beginning
385          $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);          $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
386    
387          my $prefix = '';          my $prefix;
388          $prefix = $1 if ($format =~ s/^(.+)(v\d+(?:\^\w)*)/$2/s);          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          sub f_sf_del {                  my $found = 0;
398                  my ($self,$rec,$out,$f,$sf,$del,$i) = @_;                  my $tmp = $self->get_data(\$rec,$2,$3,$i,\$found);
399    
                 my $found=0;  
                 my $tmp = $self->get_data($rec,$f,$sf,$i,\$found);  
400                  if ($found) {                  if ($found) {
401                          push @{$$out}, $tmp;                          push @out, $del;
402                          push @{$$out}, $del;                          push @out, $tmp;
403                            $all_found += $found;
404                  }                  }
                 return '';  
405          }          }
406    
407          #$format =~ s/(.*)v(\d+)(?:\^(\w))*/f_sf_del($self,\$rec,\@out,$2,$3,$1,$i/ges;          return if (! $all_found);
408    
409            my $out = join('',@out) . $format;
410    
411          print Dumper(@out);          # 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.356  
changed lines
  Added in v.362
  ViewVC Help
Powered by ViewVC 1.1.26