--- trunk/lib/WebPAC/Input.pm 2007/04/11 12:22:35 822 +++ trunk/lib/WebPAC/Input.pm 2007/04/11 12:22:37 823 @@ -16,11 +16,11 @@ =head1 VERSION -Version 0.17 +Version 0.18 =cut -our $VERSION = '0.17'; +our $VERSION = '0.18'; =head1 SYNOPSIS @@ -565,14 +565,15 @@ } } -=head2 modify_record_regexps +=head2 _get_regex -Generate hash with regexpes to be applied using L. +Helper function called which create regexps to be execute on code. - my $regexpes = $input->modify_record_regexps( - 900 => { '^a' => { ' : ' => '^b' } }, - 901 => { '*' => { '^b' => ' ; ' } }, - ); + _get_regex( 900, 'regex:[0-9]+' ,'numbers' ); + _get_regex( 900, '^b', ' : ^b' ); + +It supports perl regexps with C prefix to from value and has +additional logic to skip empty subfields. =cut @@ -589,14 +590,30 @@ $from = '\Q' . $from . '\E'; } if ($sf =~ /^\^/) { + my $need_subfield_data = '*'; # no + # if from is also subfield, require some data in between + # to correctly skip empty subfields + $need_subfield_data = '+' if ($from =~ m/^\\Q\^/); return - 's/\Q'. $sf .'\E([^\^]*?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/'; + 's/\Q'. $sf .'\E([^\^]' . $need_subfield_data . '?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/'; } else { return 's/'. $from .'/'. $to .'/g'; } } + +=head2 modify_record_regexps + +Generate hash with regexpes to be applied using L. + + my $regexpes = $input->modify_record_regexps( + 900 => { '^a' => { ' : ' => '^b' } }, + 901 => { '*' => { '^b' => ' ; ' } }, + ); + +=cut + sub modify_record_regexps { my $self = shift; my $modify_record = {@_};