[libcatmandu-mab2-perl] 21/35: add Catmandu::Error exceptions and more tests
Jonas Smedegaard
dr at jones.dk
Fri Oct 27 17:54:42 UTC 2017
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 <jorol at cpan.org>
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");
- at 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");
- at 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
More information about the Pkg-perl-cvs-commits
mailing list