--- trunk/lib/WebPAC/Input.pm 2006/11/03 20:56:21 774 +++ trunk/lib/WebPAC/Input.pm 2007/02/04 15:09:01 799 @@ -16,11 +16,11 @@ =head1 VERSION -Version 0.16 +Version 0.17 =cut -our $VERSION = '0.16'; +our $VERSION = '0.17'; =head1 SYNOPSIS @@ -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 @@ -301,12 +302,14 @@ eval '$l =~ ' . $r; if ($old_l ne $l) { $log->debug("REGEX on $f_nr eval \$l =~ $r\n## old l: [$old_l]\n## new l: [$l]"); + warn "*** $r |$old_l| -> |$l|\n" if ($debug); } $log->error("error applying regex: $r") if ($@); } } $log->debug("<=- $f_nr ## $l"); + warn "<=- $f_nr ## $l\n" if ($debug); return $l; }); @@ -469,10 +472,12 @@ sub seek { my $self = shift; - my $pos = shift || return; + my $pos = shift; my $log = $self->_get_logger(); + $log->logconfess("called without pos") unless defined($pos); + if ($pos < 1) { $log->warn("seek before first record"); $pos = 1; @@ -555,7 +560,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' } }, @@ -566,12 +571,22 @@ sub _get_regex { my ($sf,$from,$to) = @_; + + # protect / + $from =~ s!/!\\/!gs; + $to =~ s!/!\\/!gs; + + if ($from =~ m/^regex:(.+)$/) { + $from = $1; + } else { + $from = '\Q' . $from . '\E'; + } if ($sf =~ /^\^/) { return - 's/\Q'. $sf .'\E([^\^]*?)\Q'. $from .'\E([^\^]*?)/'. $sf .'$1'. $to .'$2/'; + 's/\Q'. $sf .'\E([^\^]*?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/'; } else { return - 's/\Q'. $from .'\E/'. $to .'/g'; + 's/'. $from .'/'. $to .'/g'; } } @@ -606,7 +621,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: