/[webpac2]/trunk/lib/WebPAC/Normalize.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 /trunk/lib/WebPAC/Normalize.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 295 by dpavlin, Mon Dec 19 15:34:47 2005 UTC revision 340 by dpavlin, Mon Jan 2 10:58:26 2006 UTC
# Line 11  WebPAC::Normalize - data mungling for no Line 11  WebPAC::Normalize - data mungling for no
11    
12  =head1 VERSION  =head1 VERSION
13    
14  Version 0.07  Version 0.08
15    
16  =cut  =cut
17    
18  our $VERSION = '0.07';  our $VERSION = '0.08';
19    
20  =head1 SYNOPSIS  =head1 SYNOPSIS
21    
# Line 157  sub data_structure { Line 157  sub data_structure {
157    
158          $log->debug("data_structure rec = ", sub { Dumper($rec) });          $log->debug("data_structure rec = ", sub { Dumper($rec) });
159    
160          $log->logdie("need unique ID (mfn) in field 000 of record ", sub { Dumper($rec) } ) unless (defined($rec->{'000'}));          $log->logdie("need unique ID (mfn) in field 000 of record " . Dumper($rec) ) unless (defined($rec->{'000'}));
161    
162          my $id = $rec->{'000'}->[0] || $log->logdie("field 000 isn't array!");          my $id = $rec->{'000'}->[0] || $log->logdie("field 000 isn't array!");
163    
# Line 317  sub parse { Line 317  sub parse {
317    
318          my @out;          my @out;
319    
320          $log->debug("format: $format");          $log->debug("format: $format [$i]");
321    
322          my $eval_code;          my $eval_code;
323          # remove eval{...} from beginning          # remove eval{...} from beginning
# Line 327  sub parse { Line 327  sub parse {
327          # remove filter{...} from beginning          # remove filter{...} from beginning
328          $filter_name = $1 if ($format =~ s/^filter{([^}]+)}//s);          $filter_name = $1 if ($format =~ s/^filter{([^}]+)}//s);
329    
330            # did we found any (att all) field from format in row?
331            my $found_any;
332            # prefix before first field which we preserve it $found_any
333          my $prefix;          my $prefix;
334          my $all_found=0;  
335            my $f_step = 1;
336    
337          while ($format =~ s/^(.*?)(v|s)(\d+)(?:\^(\w))?//s) {          while ($format =~ s/^(.*?)(v|s)(\d+)(?:\^(\w))?//s) {
338    
339                  my $del = $1 || '';                  my $del = $1 || '';
340                  $prefix ||= $del if ($all_found == 0);                  $prefix = $del if ($f_step == 1);
341    
342                    my $fld_type = lc($2);
343    
344                  # repeatable index                  # repeatable index
345                  my $r = $i;                  my $r = $i;
346                  $r = 0 if (lc("$2") eq 's');                  if ($fld_type eq 's') {
347                            if ($found_any->{'v'}) {
348                                    $r = 0;
349                            } else {
350                                    return;
351                            }
352                    }
353    
354                  my $found = 0;                  my $found = 0;
355                  my $tmp = $self->get_data(\$rec,$3,$4,$r,\$found);                  my $tmp = $self->get_data(\$rec,$3,$4,$r,\$found);
356    
357                  if ($found) {                  if ($found) {
358                          push @out, $del;                          $found_any->{$fld_type} += $found;
359    
360                            # we will skip delimiter before first occurence of field!
361                            push @out, $del unless($found_any == 1);
362                          push @out, $tmp;                          push @out, $tmp;
                         $all_found += $found;  
363                  }                  }
364                    $f_step++;
365          }          }
366    
367          return if (! $all_found);          # test if any fields found?
368            return if (! $found_any->{'v'} && ! $found_any->{'s'});
369    
370          my $out = join('',@out);          my $out = join('',@out);
371    
# Line 463  sub fill_in { Line 479  sub fill_in {
479          }          }
480    
481          my $found = 0;          my $found = 0;
482            my $just_single = 1;
483    
484          my $eval_code;          my $eval_code;
485          # remove eval{...} from beginning          # remove eval{...} from beginning
# Line 474  sub fill_in { Line 491  sub fill_in {
491    
492          # do actual replacement of placeholders          # do actual replacement of placeholders
493          # repeatable fields          # repeatable fields
494          $format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found)/ges;          if ($format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found)/ges) {
495                    $just_single = 0;
496            }
497            
498          # non-repeatable fields          # non-repeatable fields
499          $format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found)/ges;          if ($format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found)/ges) {
500                    return if ($i > 0 && $just_single);
501            }
502    
503          if ($found) {          if ($found) {
504                  $log->debug("format: $format");                  $log->debug("format: $format");

Legend:
Removed from v.295  
changed lines
  Added in v.340

  ViewVC Help
Powered by ViewVC 1.1.26