r938@llin: dpavlin | 2006-09-11 16:27:57 +0200
authorDobrica Pavlinusic <dpavlin@rot13.org>
Mon, 11 Sep 2006 14:29:08 +0000 (14:29 +0000)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Mon, 11 Sep 2006 14:29:08 +0000 (14:29 +0000)
 tests, corrections and version bump [0.08]

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

conf/log.conf
lib/WebPAC/Validate.pm
t/1-validate.t

index ccaf7aa..e4d9dff 100644 (file)
@@ -20,7 +20,7 @@ log4perl.rootLogger=INFO, LOG, SCREEN
 #log4perl.logger.WebPAC.Lookup.lookup=DEBUG
 
 #log4perl.logger.WebPAC.Validate=DEBUG
-log4perl.logger.WebPAC.Validate.report=DEBUG
+#log4perl.logger.WebPAC.Validate.report=DEBUG
 
 #log4perl.logger.WebPAC.Input=DEBUG
 #log4perl.logger.WebPAC.Input.modify_record_regexps=DEBUG
index 83ba782..11ed81c 100644 (file)
@@ -18,11 +18,11 @@ WebPAC::Validate - provide simple validation for records
 
 =head1 VERSION
 
-Version 0.07
+Version 0.08
 
 =cut
 
-our $VERSION = '0.07';
+our $VERSION = '0.08';
 
 =head1 SYNOPSIS
 
@@ -194,8 +194,7 @@ sub validate_errors {
 
                                                foreach my $sf (@r_sf) {
                                                        $errors->{$f}->{subfield}->{extra_repeatable}->{$sf}++;
-                                                       $errors->{$f}->{dump} =
-                                                               join('', _pack_subfields_hash( $h, 1 ) );
+                                                       $errors->{$f}->{dump} = _pack_subfields_hash( $h, 1 );
                                                }
 
                                        }
@@ -211,8 +210,7 @@ sub validate_errors {
                                }
                        } elsif (ref($v) eq 'HASH') {
                                $errors->{$f}->{unexpected_subfields}++;
-                               $errors->{$f}->{dump} =
-                                       join('', _pack_subfields_hash( $v, 1 ) );
+                               $errors->{$f}->{dump} = _pack_subfields_hash( $v, 1 );
                        }
                }
        }
@@ -294,7 +292,7 @@ sub report {
 
                        if ($k eq 'dump') {
                                $dump = $tree->{dump};
-                               warn "## dump: ",dump($dump),"\n";
+#                              warn "## dump: ",dump($dump),"\n";
                                next;
                        }
 
index 3187c38..c6abeec 100755 (executable)
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 51;
+use Test::More tests => 47;
 use Test::Exception;
 use blib;
 
@@ -55,7 +55,7 @@ sub test_v {
                my $tmp = $e;
                while (@_) {
                        my $k = shift @_;
-                       ok($tmp = $tmp->{$k}, "found $k");
+                       ok($tmp = $tmp->{$k}, "found $k") if (defined($k));
                }
                diag "tmp: ",dump($tmp) if ($debug);
                if ($tmp) {
@@ -109,10 +109,9 @@ test_v({
 }, qw/903 subfield extra d/);
 
 is_deeply(
-
-test_v({
-       '903' => [ { 'a' => 0 }, { 'b' => 1 }, { 'c' => 2 }, { 'd' => 3 }, { 'e' => 4 } ]
-}, qw/903 subfield extra/),
+       test_v({
+               '903' => [ { 'a' => 0 }, { 'b' => 1 }, { 'c' => 2 }, { 'd' => 3 }, { 'e' => 4 } ]
+       }, qw/903 subfield extra/),
 { 'd' => 1, 'e' => 1 }, 'additional fields d, e');
 
 test_v({
@@ -135,15 +134,46 @@ test_v({
        '905' => [ ]
 });
 
-test_v({
-       '900' => 'foo',
-       '901' => [ qw/foo bar baz/ ],
-       '902' => [ { 'a' => 1, 'b' => [ 1,2 ] } ],
-       '903' => [ { 'a' => [ 1, 2 ], 'c' => 1, } ],
-       '904' => [ { 'b' => 1 } ],
-       '905' => [ { 'a' => 1 } ],
-});
+my $expected_error = {
+   900 => { not_repeatable => "probably bug in parsing input data" },
+   901 => { missing_subfield => "a required" },
+   902 => {
+            "dump"   => "^a1^b1^b2",
+            subfield => { extra => { a => 1 }, extra_repeatable => { b => 1 } },
+          },
+   903 => {
+            "dump"   => "^a1^a2^c1",
+            subfield => { extra_repeatable => { a => 1 } },
+          },
+   904 => { subfield => { extra => { b => 1 }, missing => { a => 1 } } },
+};
+
+
+is_deeply(
+       test_v({
+               '900' => 'foo',
+               '901' => [ qw/foo bar baz/ ],
+               '902' => [ { 'a' => 1, 'b' => [ 1,2 ] } ],
+               '903' => [ { 'a' => [ 1, 2 ], 'c' => 1, } ],
+               '904' => [ { 'b' => 1 } ],
+               '905' => [ { 'a' => 1 } ],
+       }, undef),
+$expected_error, 'validate without subfields');
+
+ok(my $r1 = $v->report, 'report');
+
+is_deeply(
+       test_v({
+               '900' => 'foo',
+               '901' => [ qw/foo bar baz/ ],
+               '902' => [ { 'a' => 1, 'b' => [ 1,2 ], subfields => [ qw/a 0 b 0 b 1/ ] } ],
+               '903' => [ { 'a' => [ 1, 2 ], 'c' => 1, subfields => [ qw/a 0 a 1 c 0/ ] } ],
+               '904' => [ { 'b' => 1, subfields => [ qw/b 0/ ] } ],
+               '905' => [ { 'a' => 1, subfields => [ qw/a 0/ ] } ],
+       }, undef),
+$expected_error, 'validate with subfields');
+
 
-diag "errors: ",dump( $v->all_errors );
+ok(my $r2 = $v->report, 'report');
 
-diag "report: ", $v->report;
+cmp_ok($r1, 'eq', $r2, 'subfields same as non-subfields');