--- trunk/lib/WebPAC/Input.pm 2007/02/04 12:19:51 793 +++ trunk/lib/WebPAC/Input.pm 2007/02/04 23:10:18 800 @@ -282,10 +282,11 @@ $log->debug("position: $pos\n"); my $rec = $ll_db->fetch_rec($pos, sub { - my ($l,$f_nr) = @_; + my ($l,$f_nr,$debug) = @_; # return unless defined($l); # return $l unless ($rec_regex && $f_nr); + warn "-=> $f_nr ## |$l|\n" if ($debug); $log->debug("-=> $f_nr ## $l"); # codepage conversion and recode_regex @@ -298,15 +299,22 @@ my $c = 0; foreach my $r (@{ $rec_regex->{$f_nr} }) { my $old_l = $l; - eval '$l =~ ' . $r; + $log->logconfess("expected regex in ", dump( $r )) unless defined($r->{regex}); + eval '$l =~ ' . $r->{regex}; if ($old_l ne $l) { - $log->debug("REGEX on $f_nr eval \$l =~ $r\n## old l: [$old_l]\n## new l: [$l]"); + my $d = "|$old_l| -> |$l| "; # . $r->{regex}; + $d .= ' +' . $r->{line} . ' ' . $r->{file} if defined($r->{line}); + $d .= ' ' . $r->{debug} if defined($r->{debug}); + $log->debug("MODIFY $d"); + warn "*** $d\n" if ($debug); + } $log->error("error applying regex: $r") if ($@); } } - $log->debug("<=- $f_nr ## $l"); + $log->debug("<=- $f_nr ## |$l|"); + warn "<=- $f_nr ## $l\n" if ($debug); return $l; }); @@ -473,7 +481,7 @@ my $log = $self->_get_logger(); - $log->confess("called without pos") unless defined($pos); + $log->logconfess("called without pos") unless defined($pos); if ($pos < 1) { $log->warn("seek before first record"); @@ -557,7 +565,7 @@ =head2 modify_record_regexps -Generate hash with regexpes to be applied using l. +Generate hash with regexpes to be applied using L. my $regexpes = $input->modify_record_regexps( 900 => { '^a' => { ' : ' => '^b' } }, @@ -568,6 +576,11 @@ sub _get_regex { my ($sf,$from,$to) = @_; + + # protect / + $from =~ s!/!\\/!gs; + $to =~ s!/!\\/!gs; + if ($from =~ m/^regex:(.+)$/) { $from = $1; } else { @@ -599,10 +612,11 @@ foreach my $from (keys %{ $modify_record->{$f}->{$sf} }) { my $to = $modify_record->{$f}->{$sf}->{$from}; #die "no field?" unless defined($to); - $log->debug("transform: |$from| -> |$to|"); + my $d = "|$from| -> |$to|"; + $log->debug("transform: $d"); my $regex = _get_regex($sf,$from,$to); - push @{ $regexpes->{$f} }, $regex; + push @{ $regexpes->{$f} }, { regex => $regex, debug => $d }; $log->debug("regex: $regex"); } } @@ -613,7 +627,7 @@ =head2 modify_file_regexps -Generate hash with regexpes to be applied using l from +Generate hash with regexpes to be applied using L from pseudo hash/yaml format for regex mappings. It should be obvious: @@ -663,7 +677,11 @@ $log->debug("transform: |$from| -> |$to|"); my $regex = _get_regex($sf,$from,$to); - push @{ $regexpes->{$f} }, $regex; + push @{ $regexpes->{$f} }, { + regex => $regex, + file => $modify_path, + line => $., + }; $log->debug("regex: $regex"); } }