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 57d379fc023c6a978aa6271d27735daf8451bb0b Author: Patrick Hochstenbach <[email protected]> Date: Thu Mar 2 08:46:19 2017 +0100 Fixinf marc_spec append --- lib/Catmandu/Fix/marc_map.pm | 1 + lib/Catmandu/Fix/marc_spec.pm | 15 ++++++-- lib/Catmandu/MARC.pm | 32 +++++++++++++--- t/22-append-path.t | 86 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 125 insertions(+), 9 deletions(-) diff --git a/lib/Catmandu/Fix/marc_map.pm b/lib/Catmandu/Fix/marc_map.pm index 1b2730c..165ba1b 100644 --- a/lib/Catmandu/Fix/marc_map.pm +++ b/lib/Catmandu/Fix/marc_map.pm @@ -50,6 +50,7 @@ if (my ${result} = ${marc}->marc_map( ${result} = ref(${result}) ? ${result} : [${result}]; for ${current_value} (\@{${result}}) { EOF + $perl .= $fixer->emit_create_path( $var, $path, diff --git a/lib/Catmandu/Fix/marc_spec.pm b/lib/Catmandu/Fix/marc_spec.pm index 31c4bde..50a1d4c 100644 --- a/lib/Catmandu/Fix/marc_spec.pm +++ b/lib/Catmandu/Fix/marc_spec.pm @@ -20,6 +20,7 @@ has invert => ( fix_opt => 1 ); sub emit { my ( $self, $fixer ) = @_; my $path = $fixer->split_path( $self->path ); + my $key = $path->[-1]; my $marc_obj = Catmandu::MARC->instance; # Precompile the marc_path to gain some speed @@ -31,27 +32,35 @@ sub emit { '-split' => $self->split // 0 , '-pluck' => $self->pluck // 0 , '-invert' => $self->invert // 0 , - '-value' => $self->value + '-value' => $self->value , + '-append' => $key eq '$append' }); my $var = $fixer->var; my $result = $fixer->generate_var; + my $current_value = $fixer->generate_var; - my $perl =<<EOF; + my $perl = ""; + $perl .= $fixer->emit_declare_vars($current_value, "[]"); + $perl .=<<EOF; if (my ${result} = ${marc}->marc_spec( ${var}, ${marc_spec}, ${marc_opt}) ) { + ${result} = ref(${result}) ? ${result} : [${result}]; + for ${current_value} (\@{${result}}) { EOF + $perl .= $fixer->emit_create_path( $var, $path, sub { my $var2 = shift; - "${var2} = ${result}" + "${var2} = ${current_value}" } ); $perl .=<<EOF; + } } EOF $perl; diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm index 368c9bd..cdbfe8d 100644 --- a/lib/Catmandu/MARC.pm +++ b/lib/Catmandu/MARC.pm @@ -350,6 +350,7 @@ sub marc_spec { my $pluck = $_[3]->{'-pluck'} // 0; my $value_set = $_[3]->{'-value'} // undef; my $invert = $_[3]->{'-invert'} // 0; + my $append = $_[3]->{'-append'} // undef; my $vals; @@ -521,9 +522,18 @@ sub marc_spec { unless (@subfields) { return $vals } - $vals = ($split) - ? [@subfields] - : join( $join_char, @subfields ); + if ($split) { + $vals = [[@subfields]]; + } + elsif ($append) { + $vals = [@subfields]; + } + elsif (@subfields) { + $vals = join( $join_char, @subfields ); + } + else { + $vals = undef; + } } else { # no particular subfields requested my $char_start = $field_spec->char_start; @@ -553,10 +563,20 @@ sub marc_spec { } unless (@mapped) { return $vals } - $vals = ($split) - ? [@mapped] - : join $join_char, @mapped; + if ($split) { + $vals = [[@mapped]] + } + elsif ($append) { + $vals = [@mapped] + } + elsif (@mapped) { + $vals = join $join_char, @mapped; + } + else { + $vals = undef; + } } + return $vals; } diff --git a/t/22-append-path.t b/t/22-append-path.t index 31f111a..3a7cd76 100644 --- a/t/22-append-path.t +++ b/t/22-append-path.t @@ -10,6 +10,8 @@ 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" ); @@ -92,4 +94,88 @@ note("t.\$append, split:1"); ]] , '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; -- 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
