[libcatmandu-marc-perl] 204/208: Adding more tests
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:51 UTC 2017
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 <patrick.hochstenbach at ugent.be>
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
More information about the Pkg-perl-cvs-commits
mailing list