r1203@llin: dpavlin | 2007-04-11 14:22:28 +0200

 spacial handling for empty subfields [0.18]

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@823 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/lib/WebPAC/Input.pm b/lib/WebPAC/Input.pm
index 45b3779..8746da9 100644 (file)
--- a/lib/WebPAC/Input.pm
+++ b/lib/WebPAC/Input.pm
@@ -16,11 +16,11 @@ WebPAC::Input - read different file formats into WebPAC
 
 =head1 VERSION
 
-Version 0.17
+Version 0.18
 
 =cut
 
-our $VERSION = '0.17';
+our $VERSION = '0.18';
 
 =head1 SYNOPSIS
 
@@ -565,14 +565,15 @@ sub dump_ascii {
        }
 }
 
-=head2 modify_record_regexps
+=head2 _get_regex
 
-Generate hash with regexpes to be applied using L<filter>.
+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<regex:> prefix to from value and has
+additional logic to skip empty subfields.
 
 =cut
 
@@ -589,14 +590,30 @@ sub _get_regex {
                $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<filter>.
+
+  my $regexpes = $input->modify_record_regexps(
+               900 => { '^a' => { ' : ' => '^b' } },
+               901 => { '*' => { '^b' => ' ; ' } },
+  );
+
+=cut
+
 sub modify_record_regexps {
        my $self = shift;
        my $modify_record = {@_};

diff --git a/t/2-input.t b/t/2-input.t
index 70eb385..19af3df 100755 (executable)
--- a/t/2-input.t
+++ b/t/2-input.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 116;
+use Test::More tests => 118;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
@@ -193,7 +193,10 @@ ok($input->open(
        modify_records => {
                900 => {
                        '^a' => { '^e' => ' : ^e' },
-               }
+               },
+               901 => {
+                       '^a' => { 'foo' => 'baz' },
+               },
        },
 ), "open (with modify_records for empty subfields)");
 
@@ -206,3 +209,8 @@ test_filter(900,
        '^afoo^ebar',
        '^afoo : ^ebar',
 );
+
+test_filter(901,
+       '^afoo^ebar',
+       '^abaz^ebar',
+);