X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=t%2F1-validate-delimiters.t;h=780a157b81085b0561ea91748673d230f4cbcb29;hb=33156dfb36756fcafdf27a56b3254344aab06d09;hp=8a16e4f5088f8bb0c876c662e46895b4faeaa36f;hpb=20141033691c58360beff1f1d6329bbe5108a647;p=webpac2 diff --git a/t/1-validate-delimiters.t b/t/1-validate-delimiters.t index 8a16e4f..780a157 100755 --- a/t/1-validate-delimiters.t +++ b/t/1-validate-delimiters.t @@ -1,29 +1,27 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 4; -use Test::Exception; -use blib; +use lib 'lib'; -use Data::Dump qw/dump/; -use Cwd qw/abs_path/; +use Test::More tests => 15; + +use File::Temp qw/ :POSIX /; BEGIN { +use_ok( 'WebPAC::Test' ); use_ok( 'WebPAC::Validate' ); } -my $debug = shift @ARGV; - -ok(my $abs_path = abs_path($0), "abs_path"); -$abs_path =~ s#/[^/]*$#/#; +my $delimiters_path = tmpnam(); ok(my $v = new WebPAC::Validate( path => "$abs_path/data/validate_test", - delimiters => [ ' : ', ' ; ', ' / ', ' \. ' ], - debug => $debug, + delimiters => [ ' : ', ' ; ', ' / ', ' \. ', ' = ' ], + delimiters_path => $delimiters_path, + %LOG, ), "new"); -diag "rules = ", dump( $v->{rules} ); +diag "rules = ", dump( $v->{rules} ) if ( $debug ); $v->{rules} = {}; @@ -34,22 +32,78 @@ sub test_v { $row->{'000'} = [ 42 ]; - $v->reset_errors; + $v->reset; my $e = $v->validate_rec( $row ); diag ">> validate $d\n",dump($e) if ($debug); } test_v({ - '900' => [ { 'a' => 'a : aa = aaa : a ; a', 'b' => 'b ; b ; b ; b ; a : / z . z . ' }, { 'c' => 'a : b ; c / d' } ] + '900' => [ + { 'a' => 'a : aa = aaa : a ; a', 'b' => 'b ; b ; b ; b ; a : / z . z . ' }, + { 'a' => 'a : a : a', 'c' => [ 'a : b ; c', 'a : b ; c / d' ] }, + { 'a' => 'a : b / c' }, + { 'a' => 'a : b / c' }, + ], + '901' => [ + { 'a' => 'a : b / c', 'b' => 'foo' }, + { 'a' => 'a : b / c', 'b' => 'foo' }, + ], }); -diag dump($v->{_delimiters_templates}); +diag dump($v->{_delimiters_templates}) if ( $debug ); is_deeply( $v->{_delimiters_templates}, { 900 => { - "^a : : ; ^b ; ; ; ; : . . " => 1, - "^a : : ; ^b ; ; ; ; : . . ^c : ; / " => 1, + "^a : / " => 2, + "^a : : ^c : ; ^c : ; / " => 1, + "^a : = : ; ^b ; ; ; ; : . . " => 1, }, + 901 => { "^a : / ^b" => 2 }, }, 'just subfields and delimiters'); +ok(! $v->delimiters_templates, 'no accumulated delimiters_template'); + +ok(my $dt = $v->delimiters_templates( current_input => 1 ), 'delimiters_template'); +diag $dt if ( $debug ); + +ok($dt = $v->delimiters_templates( report => 1, current_input => 1 ), 'delimiters_template report'); +diag $dt if ( $debug ); + +$v->reset; +ok( $v->delimiters_templates, 'have accumulated delimiters_templates'); + +$v->{_validate_delimiters_templates} = { + 900 => { '^a : ^b' => 1 }, +}; + +test_v({ + '900' => [ + { 'a' => 'foo : bar', 'b' => 'baz' }, + { 'a' => 'foo', 'b' => 'baz' }, + { 'a' => 'foo' }, + { 'a' => 'foo : bar' }, + ], +}); + +ok (my $e = $v->report, 'report'); + +diag $e if ( $debug ); + +ok( $v->save_delimiters_templates, 'save_delimiters_templates' ); + +ok( -s $delimiters_path, "$delimiters_path " . ( -s $delimiters_path ) . " bytes" ); + +ok( $v->save_delimiters_templates, 'save_delimiters_templates to existing file' ); + +ok( -s $delimiters_path . '.new' , "new file created" ); + +ok(my $v2 = new WebPAC::Validate( + delimiters => [ ' : ', ' ; ', ' / ', ' \. ', ' = ' ], + delimiters_path => $delimiters_path, + debug => $debug, +), "new"); + +is_deeply( $v->{_accumulated_delimiters_templates}, $v2->{_validate_delimiters_templates}, 'save/load ok'); + +diag dump( $v, $v2 ) if $debug;