/[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 357 by dpavlin, Wed Jun 16 13:39:17 2004 UTC revision 359 by dpavlin, Wed Jun 16 15:41:16 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 266  sub fill_in { Line 268  sub fill_in {
268    
269          my $found = 0;          my $found = 0;
270    
271            my $eval_code;
272            # remove eval{...} from beginning
273            $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
274    
275          # do actual replacement of placeholders          # do actual replacement of placeholders
276          $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;
277    
278          if ($found) {          if ($found) {
279                    if ($eval_code) {
280                            my $eval = $self->fill_in($rec,$eval_code,$i);
281                            return if (! eval $eval);
282                    }
283                  # do we have lookups?                  # do we have lookups?
284                  if ($format =~ /\[[^\[\]]+\]/o) {                  if ($format =~ /\[[^\[\]]+\]/o) {
285                          return $self->lookup($format);                          return $self->lookup($format);
# Line 340  sub parse { Line 350  sub parse {
350    
351          my ($rec, $format, $i) = @_;          my ($rec, $format, $i) = @_;
352    
353            confess("need HASH as first argument!") if ($rec !~ /HASH/o);
354    
355            $i = 0 if (! $i);
356    
357          my @out;          my @out;
358    
359          my $eval_code;          my $eval_code;
360          # remove eval{...} from beginning          # remove eval{...} from beginning
361          $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);          $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
362    
363          my $prefix = '';          my $prefix;
364          $prefix = $1 if ($format =~ s/^(.+)(v\d+(?:\^\w)*)/$2/s);          my $all_found=0;
365    
366    #print "## $format\n";
367            while ($format =~ s/^(.*?)v(\d+)(?:\^(\w))*//s) {
368    #print "## [ $1 | $2 | $3 ] $format\n";
369    
370                    my $del = $1 || '';
371                    $prefix ||= $del if ($all_found == 0);
372    
373          sub f_sf_del {                  my $found = 0;
374                  my ($self,$rec,$out,$f,$sf,$del,$i) = @_;                  my $tmp = $self->get_data(\$rec,$2,$3,$i,\$found);
375    
                 my $found=0;  
                 my $tmp = $self->get_data($rec,$f,$sf,$i,\$found);  
376                  if ($found) {                  if ($found) {
377                          push @{$$out}, $tmp;                          push @out, $del;
378                          push @{$$out}, $del;                          push @out, $tmp;
379                            $all_found += $found;
380                  }                  }
                 return '';  
381          }          }
382    
383          #$format =~ s/(.*)v(\d+)(?:\^(\w))*/f_sf_del($self,\$rec,\@out,$2,$3,$1,$i/ges;          return if (! $all_found);
384    
385            my $out = join('',@out) . $format;
386    
387          print Dumper(@out);          # add prefix if not there
388            $out = $prefix . $out if ($out !~ m/^\Q$prefix\E/);
389            
390            if ($eval_code) {
391                    my $eval = $self->fill_in($rec,$eval_code,$i);
392                    return if (! eval $eval);
393            }
394    
395            return $out;
396  }  }
397    
398  1;  1;

Legend:
Removed from v.357  
changed lines
  Added in v.359

  ViewVC Help
Powered by ViewVC 1.1.26