finish tweaking mock framework, test and fix problem with slashes in modify_record

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

diff --git a/lib/WebPAC/Input.pm b/lib/WebPAC/Input.pm
index bbef001..2388d35 100644 (file)
--- a/lib/WebPAC/Input.pm
+++ b/lib/WebPAC/Input.pm
@@ -473,7 +473,7 @@ sub seek {
 
        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");
@@ -568,6 +568,11 @@ Generate hash with regexpes to be applied using l<filter>.
 
 sub _get_regex {
        my ($sf,$from,$to) = @_;
+
+       # protect /
+       $from =~ s!/!\\/!gs;
+       $to =~ s!/!\\/!gs;
+
        if ($from =~ m/^regex:(.+)$/) {
                $from = $1;
        } else {

diff --git a/lib/WebPAC/Input/Test.pm b/lib/WebPAC/Input/Test.pm
index afddbef..af64475 100644 (file)
--- a/lib/WebPAC/Input/Test.pm
+++ b/lib/WebPAC/Input/Test.pm
@@ -4,7 +4,9 @@ use warnings;
 use strict;
 
 use WebPAC::Input;
+use WebPAC::Common;
 use base qw/WebPAC::Common/;
+use Data::Dump qw/dump/;
 
 =head1 NAME
 
@@ -36,7 +38,7 @@ Setup test record
 
 Setup optional size
 
-  $WebPAC::Input::Test::Size = 42;
+  $WebPAC::Input::Test::size = 42;
 
 =head1 FUNCTIONS
 
@@ -71,18 +73,21 @@ Return record with ID C<$mfn> from database
 
   my $rec = $isis->fetch_rec( $mfn );
 
-Second argument, C<filter_coderef> is ignored.
+Second argument, C<filter_coderef> will be assigned to
+C<WebPAC::Input::Test::filer_coderef>.
 
 =cut
 
-my $rec;
+our $rec;
+our $filter_coderef;
 
 sub fetch_rec {
        my $self = shift;
 
-       my ($mfn, $filter_coderef) = @_;
+       my $mfn = shift;
+       $filter_coderef = shift;
 
-       $self->_get_logger()->info("mfn = $mfn");
+       $self->_get_logger()->debug("mfn = $mfn rec = ", dump($rec));
 
        return $rec;
 }
@@ -109,11 +114,11 @@ Return number of records in database
 
 =cut
 
-my $size = 1;
+our $size = 1;
 
 sub size {
        my $self = shift;
-       $self->_get_logger()->info("size = $size");
+       $self->_get_logger()->debug("size = $size");
        return $size;
 }
 

diff --git a/t/2-input.t b/t/2-input.t
index cb26b19..70b182d 100755 (executable)
--- a/t/2-input.t
+++ b/t/2-input.t
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 
-use Test::More tests => 104;
+use Test::More tests => 108;
 use Test::Exception;
 use Cwd qw/abs_path/;
 use blib;
@@ -123,21 +123,20 @@ test_fetch($input, $input->size);
 $module = 'WebPAC::Input::Test';
 ok($input = new WebPAC::Input( module => $module, no_log => $no_log, no_progress_bar => 1, debug => $debug ), "new $module");
 
-ok($input->open( path => "$abs_path/modify_isis/LIBRI", ), "open modify_isis (plain)");
-
 $WebPAC::Input::Test::rec = {
-       '200' => [ {
-               'a' => 'foo',
-               'b' => 'bar',
-               }, {
-               'a' => 'baz',
-               } ],
+       '200' => [
+               { 'a' => '[200 a]', 'b' => '[200 b]', 'c' => '[200 c]', 'f' => '[200 f] test : test' },
+       ],
        '900' => [
-               'foobar',
-               ],
+               { 'x' => 'foobar', },
+       ],
 };
 
-ok($input->size, 'size');
+$WebPAC::Input::Test::size = 42;
+
+ok($input->open( path => "$abs_path/modify_isis/LIBRI", ), "open modify_isis (plain)");
+
+cmp_ok($input->size, '==', 42, 'size');
 
 ok(my $rec_p = $input->fetch, 'fetch');
 
@@ -153,33 +152,16 @@ ok($input->open(
        },
 ), "open modify_isis (with modify_records)");
 
-ok(my $rec = $input->fetch, 'fetch');
-diag "fetched rec field 200 = ", dump($rec->{200}) if ($debug);
-
-cmp_ok($rec_p->{200}->[0]->{f} . '. ' . $rec_p->{200}->[0]->{c}, 'eq' ,$rec->{200}->[0]->{f}, 'modify_records working');
-
-diag "input = ",dump($input->{data}) if ($debug);
-
-# break encapsulation, bad! bad!
-$input->{ll_db}->{_isis_db}->{record} = {
-       900 => 'foo ; bar ; baz',
-};
-
-$input->{modify_record} = {
-       900 => {
-               '*' => [
-                       { ' ; ' => 'a' },
-                       { ' ; ' => 'b' },
-                       { ' ; ' => 'c' },
-               ],
-       }
-};
-
-diag "hacked: ",dump($input, $input->fetch) if ($debug);
-
 # seek
-throws_ok { $input->seek } qw/without/, 'seek without position';
+throws_ok { $input->seek } qr/without/, 'seek without position';
 cmp_ok($input->seek(0), '==', -1, 'seek');
 
-ok(my $rec = $input->fetch, 'fetch');
-diag "fetched rec = ", dump($rec) if ($debug);
+my $f = $WebPAC::Input::Test::filter_coderef;
+ok(ref($f) eq 'CODE', 'filter_coderef');
+
+cmp_ok(
+       $f->(   '^afoo^cbar^fbing : bong',      200),
+       'eq',   '^afoo. bar^fbing / bong',
+       'modify 200'
+);
+