This is an automated email from the git hooks/post-receive script. js pushed a commit to annotated tag upstream/1.19 in repository libcatmandu-marc-perl.
commit 2b6773401d598cbfb405f7d94072a006884c261f Author: Patrick Hochstenbach <[email protected]> Date: Wed Sep 27 18:28:59 2017 +0200 Adding more tests --- lib/Catmandu/Exporter/MARC/MiJ.pm | 2 + lib/Catmandu/Fix/marc_xml.pm | 25 ++++++++++- lib/Catmandu/Importer/MARC/Lint.pm | 3 ++ t/Catmandu/Exporter/MARC/ALEPHSEQ.t | 22 ++++----- t/Catmandu/Exporter/MARC/MiJ.t | 28 ++++++++++++ t/Catmandu/Fix/Condition/marc_has_many.t | 77 ++++++++++++++++++++++++++++++++ t/Catmandu/Fix/marc_xml.t | 68 ++++++++++++++++++++++++++++ t/Catmandu/Importer/MARC/Lint.t | 19 ++++++++ 8 files changed, 231 insertions(+), 13 deletions(-) diff --git a/lib/Catmandu/Exporter/MARC/MiJ.pm b/lib/Catmandu/Exporter/MARC/MiJ.pm index 5fa8e30..cde3927 100644 --- a/lib/Catmandu/Exporter/MARC/MiJ.pm +++ b/lib/Catmandu/Exporter/MARC/MiJ.pm @@ -137,6 +137,8 @@ sub add { sub commit { my ($self) = @_; $self->fh->flush; + + 1; } 1; diff --git a/lib/Catmandu/Fix/marc_xml.pm b/lib/Catmandu/Fix/marc_xml.pm index 89692be..0b85045 100644 --- a/lib/Catmandu/Fix/marc_xml.pm +++ b/lib/Catmandu/Fix/marc_xml.pm @@ -4,6 +4,7 @@ use Catmandu::Sane; use Moo; use Catmandu::MARC; use Catmandu::Fix::Has; +use Clone qw(clone); with 'Catmandu::Fix::Inlineable'; @@ -14,8 +15,28 @@ has path => (fix_arg => 1); # Transform a raw MARC array into MARCXML sub fix { my ($self, $data) = @_; - my $xml = Catmandu::MARC->instance->marc_xml($data); - $data->{$self->path} = $xml; + my $path = $self->{path}; + + return $data unless exists $data->{$path}; + + if ($path eq 'record') { + my $xml = Catmandu::MARC->instance->marc_xml($data); + $data->{$path} = $xml; + } + elsif (exists $data->{record}) { + my $copy = clone($data->{record}); + $data->{record} = $data->{$path}; + my $xml = Catmandu::MARC->instance->marc_xml($data); + $data->{$path} = $xml; + $data->{record} = $copy; + } + else { + $data->{record} = $data->{$path}; + my $xml = Catmandu::MARC->instance->marc_xml($data); + $data->{$path} = $xml; + delete $data->{record}; + } + $data; } diff --git a/lib/Catmandu/Importer/MARC/Lint.pm b/lib/Catmandu/Importer/MARC/Lint.pm index 01518ef..8fa17ab 100644 --- a/lib/Catmandu/Importer/MARC/Lint.pm +++ b/lib/Catmandu/Importer/MARC/Lint.pm @@ -99,6 +99,9 @@ sub generator { $file = $self->decoder->fake_marc_file($self->fh,'MARC::File::USMARC') unless $file; sub { my $marc = $file->next(); + + return undef unless $marc; + my $doc = $self->decoder->decode($marc,$self->id); $lint->check_record( $marc ); $doc->{lint} = [$lint->warnings]; diff --git a/t/Catmandu/Exporter/MARC/ALEPHSEQ.t b/t/Catmandu/Exporter/MARC/ALEPHSEQ.t index 4f849b9..2d9ad59 100644 --- a/t/Catmandu/Exporter/MARC/ALEPHSEQ.t +++ b/t/Catmandu/Exporter/MARC/ALEPHSEQ.t @@ -15,9 +15,9 @@ BEGIN { require_ok $pkg; -my $xml = undef; +my $alephseq = undef; -my $exporter = Catmandu::Exporter::MARC->new(file => \$xml, type=> 'ALEPHSEQ' , skip_empty_subfields => 1); +my $exporter = Catmandu::Exporter::MARC->new(file => \$alephseq, type=> 'ALEPHSEQ' , skip_empty_subfields => 1); ok $exporter , 'got an MARC/ALEPHSEQ exporter'; @@ -38,13 +38,13 @@ ok $exporter->add({ ok $exporter->commit; -ok($xml =~ /^000000001/, 'test id'); -ok($xml =~ /000000001 100 L \$\$aDavis, Miles\$\$cTest/, 'test subfields'); -ok($xml !~ /000000001 500/, 'test skip empty subfields'); +ok($alephseq =~ /^000000001/, 'test id'); +ok($alephseq =~ /000000001 100 L \$\$aDavis, Miles\$\$cTest/, 'test subfields'); +ok($alephseq !~ /000000001 500/, 'test skip empty subfields'); -$xml = ''; +$alephseq = ''; $exporter = Catmandu::Exporter::MARC->new( - file => \$xml, + file => \$alephseq, type=> 'ALEPHSEQ', record_format => 'MARC-in-JSON', skip_empty_subfields => 1 @@ -66,9 +66,9 @@ $exporter->add({ ] }); -ok($xml =~ /^000000001/, 'test id'); -ok($xml =~ /000000001 100 L \$\$aDavis, Miles\$\$cTest/, 'test subfields'); -ok($xml !~ /000000001 500/, 'test skip empty subfields'); -ok($xml =~ /000000001 540 L \$\$aabcd/, 'test skip newlines'); +ok($alephseq =~ /^000000001/, 'test id'); +ok($alephseq =~ /000000001 100 L \$\$aDavis, Miles\$\$cTest/, 'test subfields'); +ok($alephseq !~ /000000001 500/, 'test skip empty subfields'); +ok($alephseq =~ /000000001 540 L \$\$aabcd/, 'test skip newlines'); done_testing; diff --git a/t/Catmandu/Exporter/MARC/MiJ.t b/t/Catmandu/Exporter/MARC/MiJ.t index edadf7b..5056355 100644 --- a/t/Catmandu/Exporter/MARC/MiJ.t +++ b/t/Catmandu/Exporter/MARC/MiJ.t @@ -4,6 +4,8 @@ use strict; use warnings; use Test::More; use Test::Exception; +use Catmandu::Exporter::MARC; +use JSON::XS; my $pkg; @@ -14,4 +16,30 @@ BEGIN { require_ok $pkg; +my $json = undef; + +my $exporter = Catmandu::Exporter::MARC->new(file => \$json, type=> 'MiJ' , skip_empty_subfields => 1); + +ok $exporter , 'got an MARC/MiJ exporter'; + +ok $exporter->add({ + _id => '1' , + record => [ + ['001', undef, undef, '_', 'rec001'], + ['100', ' ', ' ', 'a', 'Davis, Miles' , 'c' , 'Test'], + ['245', ' ', ' ', + 'a', 'Sketches in Blue' , + ], + ['500', ' ', ' ', 'a', "test"], + ['501', ' ', ' ', 'a', "test"], + ['502', ' ', ' ', 'a', "bla", 'b' , 'ok'], + ] +}) , 'add a record'; + +ok $exporter->commit , 'commit'; + +my $perl = decode_json $json; + +ok $perl , 'decode json'; + done_testing; diff --git a/t/Catmandu/Fix/Condition/marc_has_many.t b/t/Catmandu/Fix/Condition/marc_has_many.t index e6b2564..5a5e0af 100644 --- a/t/Catmandu/Fix/Condition/marc_has_many.t +++ b/t/Catmandu/Fix/Condition/marc_has_many.t @@ -14,4 +14,81 @@ BEGIN { require_ok $pkg; +my $mrc = <<'MRC'; +<?xml version="1.0" encoding="UTF-8"?> +<marc:collection xmlns:marc="http://www.loc.gov/MARC21/slim";> + <marc:record> + <marc:controlfield tag="001"> 92005291 </marc:controlfield> + <marc:datafield ind1="1" ind2="0" tag="245"> + <marc:subfield code="a">Title / </marc:subfield> + <marc:subfield code="c">Name</marc:subfield> + </marc:datafield> + <marc:datafield ind1=" " ind2=" " tag="998"> + <marc:subfield code="a">X</marc:subfield> + <marc:subfield code="a">Y</marc:subfield> + <marc:subfield code="b">Z</marc:subfield> + </marc:datafield> + <marc:datafield ind1=" " ind2=" " tag="999"> + <marc:subfield code="a">X</marc:subfield> + <marc:subfield code="a">Y</marc:subfield> + </marc:datafield> + <marc:datafield ind1=" " ind2=" " tag="999"> + <marc:subfield code="a">Z</marc:subfield> + </marc:datafield> + </marc:record> +</marc:collection> +MRC + +note 'marc_has_many(001)'; +{ + my $importer = Catmandu->importer( + 'MARC', + file => \$mrc, + type => 'XML', + fix => 'if marc_has_many(001) add_field(test,failed) end' + ); + my $record = $importer->first; + + ok ! $record->{test} , 'ok no match'; +} + +note 'marc_has_many(999)'; +{ + my $importer = Catmandu->importer( + 'MARC', + file => \$mrc, + type => 'XML', + fix => 'if marc_has_many(999) add_field(test,ok) end' + ); + my $record = $importer->first; + + is $record->{test} , "ok" , 'ok match'; +} + +note 'marc_has_many(998a)'; +{ + my $importer = Catmandu->importer( + 'MARC', + file => \$mrc, + type => 'XML', + fix => 'if marc_has_many(998a) add_field(test,ok) end' + ); + my $record = $importer->first; + + is $record->{test} , "ok" , 'ok match'; +} + +note 'marc_has_many(998b)'; +{ + my $importer = Catmandu->importer( + 'MARC', + file => \$mrc, + type => 'XML', + fix => 'if marc_has_many(998b) add_field(test,failed) end' + ); + my $record = $importer->first; + + ok ! $record->{test} , 'ok no match'; +} + done_testing; diff --git a/t/Catmandu/Fix/marc_xml.t b/t/Catmandu/Fix/marc_xml.t index ae74175..010c2b6 100644 --- a/t/Catmandu/Fix/marc_xml.t +++ b/t/Catmandu/Fix/marc_xml.t @@ -14,4 +14,72 @@ BEGIN { require_ok $pkg; +my $mrc = <<'MRC'; +<?xml version="1.0" encoding="UTF-8"?> +<marc:collection xmlns:marc="http://www.loc.gov/MARC21/slim";> + <marc:record> + <marc:controlfield tag="001"> 92005291 </marc:controlfield> + <marc:datafield ind1="1" ind2="0" tag="245"> + <marc:subfield code="a">Title / </marc:subfield> + <marc:subfield code="c">Name</marc:subfield> + </marc:datafield> + <marc:datafield ind1=" " ind2=" " tag="998"> + <marc:subfield code="a">X</marc:subfield> + <marc:subfield code="a">Y</marc:subfield> + <marc:subfield code="b">Z</marc:subfield> + </marc:datafield> + <marc:datafield ind1=" " ind2=" " tag="999"> + <marc:subfield code="a">X</marc:subfield> + <marc:subfield code="a">Y</marc:subfield> + </marc:datafield> + <marc:datafield ind1=" " ind2=" " tag="999"> + <marc:subfield code="a">Z</marc:subfield> + </marc:datafield> + </marc:record> +</marc:collection> +MRC + +note 'marc_xml(record)'; +{ + my $importer = Catmandu->importer( + 'MARC', + file => \$mrc, + type => 'XML', + fix => 'marc_xml(record)' + ); + my $record = $importer->first; + + like $record->{record} , qr/^<marc:record/, 'ok match'; +} + +note 'marc_xml(record2)'; +{ + my $importer = Catmandu->importer( + 'MARC', + file => \$mrc, + type => 'XML', + fix => 'copy_field(record,record2); marc_xml(record2)' + ); + my $record = $importer->first; + + like $record->{record2} , qr/^<marc:record/, 'ok match'; + + is $record->{record}->[0]->[0] , 'LDR' , 'still have a record'; +} + +note 'marc_xml(record2)'; +{ + my $importer = Catmandu->importer( + 'MARC', + file => \$mrc, + type => 'XML', + fix => 'move_field(record,record2); marc_xml(record2)' + ); + my $record = $importer->first; + + like $record->{record2} , qr/^<marc:record/, 'ok match'; + + ok ! $record->{record} , 'still have a record'; +} + done_testing; diff --git a/t/Catmandu/Importer/MARC/Lint.t b/t/Catmandu/Importer/MARC/Lint.t index f39b92a..7306c43 100644 --- a/t/Catmandu/Importer/MARC/Lint.t +++ b/t/Catmandu/Importer/MARC/Lint.t @@ -4,6 +4,7 @@ use strict; use warnings; use Test::More; use Test::Exception; +use Catmandu::Importer::MARC; my $pkg; @@ -14,4 +15,22 @@ BEGIN { require_ok $pkg; +my $importer = Catmandu::Importer::MARC->new( + file => 't/camel.mrc', + type => "Lint" +); + +ok $importer , 'got an MARC/ISO importer'; + +my $records = $importer->to_array(); + +ok @$records == 10, 'got all records' ; +is $records->[0]->{'_id'} , 'fol05731351 ', 'got _id' ; +is $records->[0]->{'record'}->[1][-1] , 'fol05731351 ', 'got subfield' ; +is $records->[0]->{'_id'} , $records->[0]->{'record'}->[1][-1], '_id matches record id' ; + +ok $records->[9]->{lint} , 'got lint'; + +like $records->[9]->{lint}->[0] , qr/Indicator 1 must be 0/ , 'got lit information'; + done_testing; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-marc-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
