This is an automated email from the git hooks/post-receive script. js pushed a commit to annotated tag debian/0.21-1 in repository libcatmandu-mab2-perl.
commit f3d78d0e036d2e7ed2391324153d43bc0bed827a Author: Johann Rolschewski <[email protected]> Date: Fri Oct 13 13:25:12 2017 +0200 add Catmandu::Error exceptions and more tests --- lib/Catmandu/Fix/mab_map.pm | 2 +- lib/Catmandu/Importer/MAB2.pm | 5 +- t/01-parser.t | 36 +++++++++----- t/02-importer.t | 107 ++++++++++++++++++++++++++++-------------- t/08-mab-map.t | 26 ++++++++++ 5 files changed, 126 insertions(+), 50 deletions(-) diff --git a/lib/Catmandu/Fix/mab_map.pm b/lib/Catmandu/Fix/mab_map.pm index ee09771..02d8cfb 100644 --- a/lib/Catmandu/Fix/mab_map.pm +++ b/lib/Catmandu/Fix/mab_map.pm @@ -36,7 +36,7 @@ sub emit { $to = $8; } else { - confess "invalid mab path"; + Catmandu::Error->throw('invalid mab path'); } $field_regex = $field; diff --git a/lib/Catmandu/Importer/MAB2.pm b/lib/Catmandu/Importer/MAB2.pm index eb3de7b..f81ef37 100644 --- a/lib/Catmandu/Importer/MAB2.pm +++ b/lib/Catmandu/Importer/MAB2.pm @@ -18,6 +18,7 @@ sub mab_generator { my $file; my $type = lc($self->type); + if ( $type eq 'raw' ) { $file = MAB2::Parser::RAW->new( $self->fh ); } @@ -29,7 +30,7 @@ sub mab_generator { $file = MAB2::Parser::Disk->new( $self->fh ); } else { - die "unknown format"; + Catmandu::Error->throw('unknown type'); } my $id = $self->id; @@ -49,7 +50,7 @@ sub generator { return $self->mab_generator; } else { - die "need MAB2 Disk, RAW or XML data"; + Catmandu::Error->throw('unknown type (suppported types: Disk, RAW, XML)'); } } diff --git a/t/01-parser.t b/t/01-parser.t index 60e6f14..b77073e 100644 --- a/t/01-parser.t +++ b/t/01-parser.t @@ -36,6 +36,11 @@ note 'MAB2::Parser::XML'; ); } +note 'MAB2::Parser::XML exceptions'; +{ + throws_ok { MAB2::Parser::XML->new('') } qr/^file/, 'got exeption'; +} + note 'MAB2::Parser::RAW'; { my $parser = MAB2::Parser::RAW->new('./t/mab2.dat'); @@ -52,18 +57,23 @@ note 'MAB2::Parser::RAW'; ok( $parser->next()->{_id} eq '54251-9', 'next record' ); } -note 'MAB2::Parser::RAW exeptions'; +note 'MAB2::Parser::RAW exceptions'; { - throws_ok { MAB2::Parser::RAW->new('mab2.xxx') } qr/^file/, 'got exeption'; + throws_ok { MAB2::Parser::RAW->new('mab2.xxx') } qr/^file/, + 'got exeption'; } note 'MAB2::Parser::RAW warnings'; { my $parser = MAB2::Parser::RAW->new('./t/mab2_faulty.dat'); - warning_like {$parser->next()} qr/^record terminator not found/, "got warning record terminator"; - warning_like {$parser->next()} qr/^faulty record leader/, "got warning faulty leader"; - warning_like {$parser->next()} qr/^faulty field/, "got warning faulty field"; - warning_like {$parser->next()} qr/^faulty field structure/, "got warning faulty field structure"; + warning_like { $parser->next() } qr/^record terminator not found/, + "got warning record terminator"; + warning_like { $parser->next() } qr/^faulty record leader/, + "got warning faulty leader"; + warning_like { $parser->next() } qr/^faulty field/, + "got warning faulty field"; + warning_like { $parser->next() } qr/^faulty field structure/, + "got warning faulty field structure"; } note 'MAB2::Parser::Disk'; @@ -83,17 +93,21 @@ note 'MAB2::Parser::Disk'; } -note 'MAB2::Parser::Disk exeptions'; +note 'MAB2::Parser::Disk exceptions'; { - throws_ok { MAB2::Parser::Disk->new('mab2disk.xxx') } qr/^file/, 'got exeption'; + throws_ok { MAB2::Parser::Disk->new('mab2disk.xxx') } qr/^file/, + 'got exeption'; } note 'MAB2::Parser::Disk warnings'; { my $parser = MAB2::Parser::Disk->new('./t/mab2disk_faulty.dat'); - warning_like {$parser->next()} qr/^faulty record leader/, "got warning faulty leader"; - warning_like {$parser->next()} qr/^faulty field/, "got warning faulty field"; - warning_like {$parser->next()} qr/^faulty field structure/, "got warning faulty field structure"; + warning_like { $parser->next() } qr/^faulty record leader/, + "got warning faulty leader"; + warning_like { $parser->next() } qr/^faulty field/, + "got warning faulty field"; + warning_like { $parser->next() } qr/^faulty field structure/, + "got warning faulty field structure"; } done_testing; diff --git a/t/02-importer.t b/t/02-importer.t index 2fe3d62..ddff7ca 100644 --- a/t/02-importer.t +++ b/t/02-importer.t @@ -1,48 +1,83 @@ use strict; use warnings; +use Test::Exception; use Test::More; use Catmandu; use Catmandu::Importer::MAB2; -my $importer = Catmandu::Importer::MAB2->new(file => "./t/mab2.dat", type=> "RAW"); -my @records; -$importer->each( - sub { - push( @records, $_[0] ); - } -); -ok(scalar @records == 20, 'records'); -ok( $records[0]->{'_id'} eq '47918-4', 'record _id' ); -is_deeply( $records[0]->{'record'}->[0], ['LDR', '', '_', '02020nM2.01200024 h'], - 'record leader' -); +note 'Catmandu::Importer::MAB2 RAW'; +{ + my $importer = Catmandu::Importer::MAB2->new( + file => './t/mab2.dat', + type => 'RAW' + ); + my @records; + $importer->each( + sub { + push( @records, $_[0] ); + } + ); + ok( scalar @records == 20, 'records' ); + ok( $records[0]->{'_id'} eq '47918-4', 'record _id' ); + is_deeply( + $records[0]->{'record'}->[0], + [ 'LDR', '', '_', '02020nM2.01200024 h' ], + 'record leader' + ); +} -$importer = Catmandu::Importer::MAB2->new(file => "./t/mab2.xml", type=> "XML"); -@records = (); -$importer->each( - sub { - push( @records, $_[0] ); - } -); -ok(scalar @records == 20, 'records'); -ok( $records[0]->{'_id'} eq '47918-4', 'record _id' ); -is_deeply( $records[0]->{'record'}->[0], ['001', ' ', '_', '47918-4'], - 'record field' -); +note 'Catmandu::Importer::MAB2 XML'; +{ + my $importer = Catmandu::Importer::MAB2->new( + file => './t/mab2.xml', + type => 'XML' + ); + my @records = (); + $importer->each( + sub { + push( @records, $_[0] ); + } + ); + ok( scalar @records == 20, 'records' ); + ok( $records[0]->{'_id'} eq '47918-4', 'record _id' ); + is_deeply( + $records[0]->{'record'}->[0], + [ '001', ' ', '_', '47918-4' ], + 'record field' + ); +} +note 'Catmandu::Importer::MAB2 Disk'; +{ + my $importer = Catmandu::Importer::MAB2->new( + file => './t/mab2disk.dat', + type => 'Disk' + ); + my @records = (); + $importer->each( + sub { + push( @records, $_[0] ); + } + ); + ok( scalar @records == 20, 'records' ); + ok( $records[0]->{'_id'} eq '47918-4', 'record _id' ); + is_deeply( + $records[0]->{'record'}->[0], + [ 'LDR', '', '_', '02020nM2.01200024 h' ], + 'record field' + ); +} -$importer = Catmandu::Importer::MAB2->new(file => "./t/mab2disk.dat", type=> "Disk"); -@records = (); -$importer->each( - sub { - push( @records, $_[0] ); +note 'Catmandu::Importer::MAB2 Exception'; +{ + throws_ok { + Catmandu::Importer::MAB2->new( + file => './t/mab2disk.dat', + type => 'XYZ' + )->next } -); -ok(scalar @records == 20, 'records'); -ok( $records[0]->{'_id'} eq '47918-4', 'record _id' ); -is_deeply( $records[0]->{'record'}->[0], ['LDR', '', '_', '02020nM2.01200024 h'], - 'record field' -); + qr/^unknown type/, 'got exeption'; +} -done_testing; \ No newline at end of file +done_testing; diff --git a/t/08-mab-map.t b/t/08-mab-map.t new file mode 100644 index 0000000..20f026c --- /dev/null +++ b/t/08-mab-map.t @@ -0,0 +1,26 @@ +use strict; +use warnings; +use warnings qw(FATAL utf8); +use utf8; + +use Test::More; + +use Catmandu::Importer::MAB2; +use Catmandu::Fix; + +my $pkg; + +BEGIN { + $pkg = 'Catmandu::Fix::mab_map'; + use_ok $pkg; +} +require_ok $pkg; + +my $fixer = Catmandu::Fix->new( fixes => [q|mab_map('00 ', test)|] ); +my $importer + = Catmandu::Importer::MAB2->new( file => './t/mab2.xml', type => "XML" ); + +eval { $fixer->fix( $importer->first ) }; +ok $@, 'got exception'; + +done_testing; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-mab2-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
