[libcatmandu-marc-perl] 107/208: Fixing marc-spec
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:41 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 21f03f5e50ea2004cf644de5cfe72a4dce525747
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Thu Mar 2 13:35:16 2017 +0100
Fixing marc-spec
---
lib/Catmandu/MARC.pm | 21 +++-
t/21-marc-spec.t | 2 +-
t/22-append-path.t | 181 ---------------------------
t/{23-mapping_rules.t => 22-mapping_rules.t} | 0
4 files changed, 20 insertions(+), 184 deletions(-)
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index 3441e6c..2e2e517 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -436,6 +436,9 @@ sub marc_spec {
for my $field (@fields) {
my $start = 3;
+
+ my @sf_results;
+
for my $sf (@sf_spec) {
# set invert level
if ( $invert ) {
@@ -516,7 +519,15 @@ sub marc_spec {
@subfield;
}
}
- push @subfields, @subfield if (@subfield);
+
+ push @sf_results, @subfield;
+ }
+
+ if ($split) {
+ push @subfields, @sf_results;
+ }
+ else {
+ push @subfields, join($join_char, at sf_results);
}
}
@@ -561,7 +572,13 @@ sub marc_spec {
map { substr $_, $char_start, $field_spec->char_length }
@subfields;
}
- push @mapped, @subfields;
+
+ if ($split) {
+ push @mapped, @subfields;
+ }
+ else {
+ push @mapped, join($join_char, at subfields);
+ }
}
unless (@mapped) {
diff --git a/t/21-marc-spec.t b/t/21-marc-spec.t
index f8fd65b..1fa3319 100644
--- a/t/21-marc-spec.t
+++ b/t/21-marc-spec.t
@@ -52,7 +52,7 @@ is_deeply
is_deeply
$records->[9]->{my}{fields}{indicators10},
- ['Cross-platform Perl /','Eric F. Johnson.'],
+ ['Cross-platform Perl /Eric F. Johnson.'],
q|fix: marc_spec('..._10', my.fields.indicators10.$append);|;
is scalar @{$records->[9]->{my}{fields}{indicators_0}}, 9, q|fix: marc_spec('...__0', my.fields.indicators_0, split:1);|;
diff --git a/t/22-append-path.t b/t/22-append-path.t
deleted file mode 100644
index 3a7cd76..0000000
--- a/t/22-append-path.t
+++ /dev/null
@@ -1,181 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use warnings qw(FATAL utf8);
-use utf8;
-
-use Test::More;
-
-use Catmandu::Importer::MARC;
-use Catmandu::Fix;
-
-note("marc_map-----------------");
-
-note("t");
-{
- my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
- my $fixer = Catmandu::Fix->new(fixes => ['marc_map(650a,t)']);
-
- my $result = $fixer->fix($importer);
-
- my $field = $result->first->{t};
-
- ok $field , 'got an 650';
-
- my $joined = join "" , (
- 'Semantics.',
- 'Proposition (Logic)',
- 'Speech acts (Linguistics)',
- 'Generative grammar.',
- 'Competence and performance (Linguistics)'
- );
-
- is $field , $joined , '650 is a joined string';
-}
-
-note("t.\$append");
-{
- my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
- my $fixer = Catmandu::Fix->new(fixes => ['marc_map(650a,t.$append)']);
-
- my $result = $fixer->fix($importer);
-
- my $field = $result->first->{t};
-
- ok $field , 'got an 650';
-
- is_deeply $field , [
- 'Semantics.',
- 'Proposition (Logic)',
- 'Speech acts (Linguistics)',
- 'Generative grammar.',
- 'Competence and performance (Linguistics)'
- ] , '650 is an array of values';
-}
-
-note("t, split:1");
-{
- my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
- my $fixer = Catmandu::Fix->new(fixes => ['marc_map(650a,t,split:1)']);
-
- my $result = $fixer->fix($importer);
-
- my $field = $result->first->{t};
-
- ok $field , 'got an 650';
-
- is_deeply $field , [
- 'Semantics.',
- 'Proposition (Logic)',
- 'Speech acts (Linguistics)',
- 'Generative grammar.',
- 'Competence and performance (Linguistics)'
- ] , '650 is an array of values';
-}
-
-note("t.\$append, split:1");
-{
- my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
- my $fixer = Catmandu::Fix->new(fixes => ['marc_map(650a,t.$append,split:1)']);
-
- my $result = $fixer->fix($importer);
-
- my $field = $result->first->{t};
-
- ok $field , 'got an 650';
-
- is_deeply $field , [[
- 'Semantics.',
- 'Proposition (Logic)',
- 'Speech acts (Linguistics)',
- 'Generative grammar.',
- 'Competence and performance (Linguistics)'
- ]] , '650 is an array of array of values';
-}
-
-note("marc_spec-----------------");
-
-note("t");
-{
- my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
- my $fixer = Catmandu::Fix->new(fixes => ['marc_spec(650$a,t)']);
-
- my $result = $fixer->fix($importer);
-
- my $field = $result->first->{t};
-
- ok $field , 'got an 650';
-
- my $joined = join "" , (
- 'Semantics.',
- 'Proposition (Logic)',
- 'Speech acts (Linguistics)',
- 'Generative grammar.',
- 'Competence and performance (Linguistics)'
- );
-
- is $field , $joined , '650 is a joined string';
-}
-
-note("t.\$append");
-{
- my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
- my $fixer = Catmandu::Fix->new(fixes => ['marc_spec(650$a,t.$append)']);
-
- my $result = $fixer->fix($importer);
-
- my $field = $result->first->{t};
-
- ok $field , 'got an 650';
-
- is_deeply $field , [
- 'Semantics.',
- 'Proposition (Logic)',
- 'Speech acts (Linguistics)',
- 'Generative grammar.',
- 'Competence and performance (Linguistics)'
- ] , '650 is an array of values';
-}
-
-note("t, split:1");
-{
- my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
- my $fixer = Catmandu::Fix->new(fixes => ['marc_spec(650$a,t,split:1)']);
-
- my $result = $fixer->fix($importer);
-
- my $field = $result->first->{t};
-
- ok $field , 'got an 650';
-
- is_deeply $field , [
- 'Semantics.',
- 'Proposition (Logic)',
- 'Speech acts (Linguistics)',
- 'Generative grammar.',
- 'Competence and performance (Linguistics)'
- ] , '650 is an array of values';
-}
-
-note("t.\$append, split:1");
-{
- my $importer = Catmandu::Importer::MARC->new( file => 't/rug01.aleph', type => "ALEPHSEQ" );
- my $fixer = Catmandu::Fix->new(fixes => ['marc_spec(650$a,t.$append,split:1)']);
-
- my $result = $fixer->fix($importer);
-
- my $field = $result->first->{t};
-
- ok $field , 'got an 650';
-
- is_deeply $field , [[
- 'Semantics.',
- 'Proposition (Logic)',
- 'Speech acts (Linguistics)',
- 'Generative grammar.',
- 'Competence and performance (Linguistics)'
- ]] , '650 is an array of array of values';
-}
-
-done_testing;
diff --git a/t/23-mapping_rules.t b/t/22-mapping_rules.t
similarity index 100%
rename from t/23-mapping_rules.t
rename to t/22-mapping_rules.t
--
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