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

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

revision 624 by dpavlin, Sat Aug 26 12:00:31 2006 UTC revision 634 by dpavlin, Wed Sep 6 18:08:30 2006 UTC
# Line 291  sub open { Line 291  sub open {
291  #                               return unless defined($l);  #                               return unless defined($l);
292  #                               return $l unless ($rec_regex && $f_nr);  #                               return $l unless ($rec_regex && $f_nr);
293    
294  warn "## --> $f_nr ## $l\n";                                  $log->debug("-=> $f_nr ## $l");
295    
296                                  # codepage conversion and recode_regex                                  # codepage conversion and recode_regex
297  #                               from_to($l, $code_page, $self->{'encoding'});                                  from_to($l, $code_page, $self->{'encoding'});
                                 from_to($l, $code_page, 'utf-8');  
298                                  $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);                                  $l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);
299    
300                                  # apply regexps                                  # apply regexps
# Line 302  warn "## --> $f_nr ## $l\n"; Line 302  warn "## --> $f_nr ## $l\n";
302                                          $log->logconfess("regexps->{$f_nr} must be ARRAY") if (ref($rec_regex->{$f_nr}) ne 'ARRAY');                                          $log->logconfess("regexps->{$f_nr} must be ARRAY") if (ref($rec_regex->{$f_nr}) ne 'ARRAY');
303                                          my $c = 0;                                          my $c = 0;
304                                          foreach my $r (@{ $rec_regex->{$f_nr} }) {                                          foreach my $r (@{ $rec_regex->{$f_nr} }) {
305                                                  #$log->debug("\$l = $l\neval \$l =~ $r");                                                  my $old_l = $l;
306                                                  eval '$l =~ ' . $r;                                                  eval '$l =~ ' . $r;
307                                                    if ($old_l ne $l) {
308                                                            $log->debug("REGEX on $f_nr eval \$l =~ $r\n## old l: [$old_l]\n## new l: [$l]");
309                                                    }
310                                                  $log->error("error applying regex: $r") if ($@);                                                  $log->error("error applying regex: $r") if ($@);
311                                          }                                          }
312                                  }                                  }
313    
314  warn "## <-- $f_nr ## $l\n";                                  $log->debug("<=- $f_nr ## $l");
315                                  return $l;                                  return $l;
316                  });                  });
317    
# Line 548  sub modify_record_regexps { Line 551  sub modify_record_regexps {
551    
552          my $regexpes;          my $regexpes;
553    
554            my $log = $self->_get_logger();
555    
556          foreach my $f (keys %$modify_record) {          foreach my $f (keys %$modify_record) {
557  warn "--- f: $f\n";                  $log->debug("field: $f");
558    
559                  foreach my $sf (keys %{ $modify_record->{$f} }) {                  foreach my $sf (keys %{ $modify_record->{$f} }) {
560  warn "---- sf: $sf\n";                          $log->debug("subfield: $sf");
561    
562                          foreach my $from (keys %{ $modify_record->{$f}->{$sf} }) {                          foreach my $from (keys %{ $modify_record->{$f}->{$sf} }) {
563                                  my $to = $modify_record->{$f}->{$sf}->{$from};                                  my $to = $modify_record->{$f}->{$sf}->{$from};
564                                  #die "no field?" unless defined($to);                                  #die "no field?" unless defined($to);
565  warn "----- transform: |$from| -> |$to|\n";                                  $log->debug("transform: |$from| -> |$to|");
566    
567                                  if ($sf =~ /^\^/) {                                  if ($sf =~ /^\^/) {
568                                          my $regex =                                          my $regex =
569                                                  's/\Q'. $sf .'\E([^\^]+)\Q'. $from .'\E([^\^]+)/'. $sf .'$1'. $to .'$2/g';                                                  's/\Q'. $sf .'\E(.*?)\Q'. $from .'\E(.*?)/'. $sf .'$1'. $to .'$2/g';
570                                          push @{ $regexpes->{$f} }, $regex;                                          push @{ $regexpes->{$f} }, $regex;
571  warn ">>>>> $regex [sf]\n";                                          $log->debug(">>>>> $regex [sf]");
572                                  } else {                                  } else {
573                                          my $regex =                                          my $regex =
574                                                  's/\Q'. $from .'\E/'. $to .'/g';                                                  's/\Q'. $from .'\E/'. $to .'/g';
575                                          push @{ $regexpes->{$f} }, $regex;                                          push @{ $regexpes->{$f} }, $regex;
576  warn ">>>>> $regex [global]\n";                                          $log->debug(">>>>> $regex [global]");
577                                  }                                  }
578    
579                          }                          }
Legend:
Removed from v.624  
changed lines
  Added in v.634
  ViewVC Help
Powered by ViewVC 1.1.26