[libcatmandu-marc-perl] 124/208: marc_spec supports nested_arrays and subspecs
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:43 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 87ef375df26608bb7a127f7fb62e26a34702515f
Author: Carsten Klee <cKlee at users.noreply.github.com>
Date: Thu Apr 6 15:01:08 2017 +0200
marc_spec supports nested_arrays and subspecs
---
lib/Catmandu/Fix/marc_spec.pm | 16 +-
lib/Catmandu/MARC.pm | 497 +++++++++++++++++++++++++-----------------
t/21-marc-spec.t | 93 ++++----
t/23-mapping_rules_spec.t | 225 ++++++++++++++++---
t/24-marc-spec-subspecs.t | 402 ++++++++++++++++++++++++++++++++++
t/marc_spec.fix | 3 +
6 files changed, 957 insertions(+), 279 deletions(-)
diff --git a/lib/Catmandu/Fix/marc_spec.pm b/lib/Catmandu/Fix/marc_spec.pm
index a4a32d9..d9b2438 100644
--- a/lib/Catmandu/Fix/marc_spec.pm
+++ b/lib/Catmandu/Fix/marc_spec.pm
@@ -9,13 +9,14 @@ with 'Catmandu::Fix::Base';
our $VERSION = '1.09';
-has spec => ( fix_arg => 1 );
-has path => ( fix_arg => 1 );
-has split => ( fix_opt => 1 );
-has join => ( fix_opt => 1 );
-has value => ( fix_opt => 1 );
-has pluck => ( fix_opt => 1 );
-has invert => ( fix_opt => 1 );
+has spec => ( fix_arg=> 1 );
+has path => ( fix_arg=> 1 );
+has split => ( fix_opt=> 1 );
+has join => ( fix_opt=> 1 );
+has value => ( fix_opt=> 1 );
+has pluck => ( fix_opt=> 1 );
+has invert => ( fix_opt=> 1 );
+has nested_arrays => (fix_opt => 1);
sub emit {
my ( $self, $fixer ) = @_;
@@ -31,6 +32,7 @@ sub emit {
'-join' => $self->join // '' ,
'-split' => $self->split // 0 ,
'-pluck' => $self->pluck // 0 ,
+ '-nested_arrays' => $self->nested_arrays // 0 ,
'-invert' => $self->invert // 0 ,
'-value' => $self->value ,
'-force_array' => ($key =~ /^(\$.*|\d+)$/) ? 1 : 0
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index 0d7e7d0..102eaf7 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -4,14 +4,17 @@ use Catmandu::Sane;
use Catmandu::Util;
use Catmandu::Exporter::MARC::XML;
use MARC::Spec;
+use List::Util;
use Memoize;
use Carp;
use Moo;
+
with 'MooX::Singleton';
memoize('compile_marc_path');
memoize('parse_marc_spec');
-memoize('get_index_range');
+memoize('_it_subspecs');
+memoize('_get_index_range');
our $VERSION = '1.09';
@@ -334,307 +337,395 @@ sub marc_remove {
return $data;
}
+
sub marc_spec {
- my $self = $_[0];
+ my $self = $_[0];
+
# $_[1] : data record
- my $data = $_[1]->{'record'};
+ my $data = $_[1];
+ my $record = $data->{'record'};
# $_[2] : spec
- my $ms = ref($_[2]) ?
- $_[2] :
- $self->parse_marc_spec( $self->spec );
+ my ($ms, $spec);
+ if( ref $_[2] ) {
+ $ms = $_[2];
+ $spec = $ms->to_string()
+ } else {
+ $ms = $self->parse_marc_spec( $_[2] ); # memoized
+ $spec = $_[2];
+ }
+ my $EMPTY = q{};
# $_[3] : opts
- my $split = $_[3]->{'-split'} // 0;
- my $join_char = $_[3]->{'-join'} // '';
- my $pluck = $_[3]->{'-pluck'} // 0;
- my $value_set = $_[3]->{'-value'} // undef;
- my $invert = $_[3]->{'-invert'} // 0;
- my $append = $_[3]->{'-force_array'} // undef;
-
- my $vals;
+ my $split = $_[3]->{'-split'} // 0;
+ my $join_char = $_[3]->{'-join'} // $EMPTY;
+ my $pluck = $_[3]->{'-pluck'} // 0;
+ my $value_set = $_[3]->{'-value'} // undef;
+ my $invert = $_[3]->{'-invert'} // 0;
+ my $nested_arrays = $_[3]->{'-nested_arrays'} // 0;
+ my $append = $_[3]->{'-force_array'} // 0;
+
+ if($nested_arrays) {
+ $split = 1
+ }
# filter by tag
my @fields = ();
my $field_spec = $ms->field;
- my $tag = $field_spec->tag;
- $tag = qr/$tag/;
- unless ( @fields =
- grep { $_->[0] =~ /$tag/ } @{ $data } )
- {
- return $vals;
- }
-
- if (defined $field_spec->indicator1) {
- my $indicator1 = $field_spec->indicator1;
- $indicator1 = qr/$indicator1/;
- unless( @fields =
- grep { defined $_->[1] && $_->[1] =~ /$indicator1/ } @fields)
- {
- return $vals;
- }
- }
- if (defined $field_spec->indicator2) {
- my $indicator2 = $field_spec->indicator2;
- $indicator2 = qr/$indicator2/;
- unless( @fields =
- grep { defined $_->[2] && $_->[2] =~ /$indicator2/ } @fields)
- {
- return $vals;
- }
- }
-
- # filter by index
- if ( -1 != $field_spec->index_length ) { # index is requested
- my $index_range = $self->get_index_range( $field_spec, scalar @fields );
- my $prevTag = q{};
- my $index = 0;
- my $tag;
- my @filtered = ();
- for my $pos ( 0 .. $#fields ) {
- $tag = $fields[$pos][0];
- $index = ( $prevTag eq $tag or q{} eq $prevTag ) ? $index : 0;
- if ( Catmandu::Util::array_includes( $index_range, $index ) ) {
- push @filtered, $fields[$pos];
- }
- $index++;
- $prevTag = $tag;
- }
- unless (@filtered) { return $vals }
- @fields = @filtered;
- }
+ my $tag_spec = $field_spec->tag;
- # return $value_set ASAP
- if ( $value_set && !defined $ms->subfields ) {
- return $value_set;
+ @fields = grep { $_->[0] =~ /$tag_spec/ } @{ $record };
+ return unless @fields;
+
+ # filter by indicator
+ my ( $indicator1, $indicator2 );
+ if ( $field_spec->has_indicator1 ) {
+ $indicator1 = $field_spec->indicator1;
+ $indicator1 = qr/$indicator1/
}
+ if ( $field_spec->has_indicator2 ) {
+ $indicator2 = $field_spec->indicator2;
+ $indicator2 = qr/$indicator2/
+ }
+
+ # calculate char start
+ my $chst = sub {
+ my ($sp) = @_;
+ my $char_start;
+ if ( $sp->has_char_start ) {
+ $char_start = ( '#' eq $sp->char_start )
+ ? $sp->char_length * -1
+ : $sp->char_start
+ }
+ return $char_start
+ };
- if ( defined $ms->subfields ) { # now we dealing with subfields
+ # vars we need only for subfields
+ my (@sf_spec, $invert_level, $codes, $invert_chars);
+ if ( $ms->has_subfields ) {
# set the order of subfields
- my @sf_spec = map { $_ } @{ $ms->subfields };
+ @sf_spec = map { $_ } @{ $ms->subfields };
unless ( $pluck ) {
- @sf_spec = sort { $a->code cmp $b->code } @sf_spec;
+ @sf_spec = sort { $a->code cmp $b->code } @sf_spec
}
# set invert level default
- my $invert_level = 4;
- my $codes;
+ $invert_level = 4;
if ( $invert ) {
- $codes = '[^';
- $codes .= join '', map { $_->code } @sf_spec;
- $codes .= ']';
+ $codes = '[^';
+ $codes .= join $EMPTY, map { $_->code } @sf_spec;
+ $codes .= ']'
}
- my ( @subfields, @subfield );
- my $invert_chars = sub {
+ $invert_chars = sub {
my ( $str, $start, $length ) = @_;
for ( substr $str, $start, $length ) {
- $_ = '';
+ $_ = $EMPTY
}
- return $str;
+ return $str
};
+ }
+ else {
+ # return $value_set ASAP
+ return $value_set if defined $value_set
+ }
+
+ # vars we need for fields and subfields
+ my ($referred, $char_start, $prev_tag, $index_range);
+ my $current_tag = $EMPTY;
+ my $tag_index = 0;
+ my $index_start = $field_spec->index_start;
+ my $index_end = $field_spec->index_end;
+
+ my $to_referred = sub {
+ my ( @values ) = @_;
+ if($nested_arrays) {
+ push @{$referred}, \@values
+ } elsif($split) {
+ push @{$referred}, @values
+ } else {
+ push @{$referred}, join $join_char, @values
+ }
+ };
+
+ if( defined $field_spec->index_start ) {
+ $index_range =
+ _get_index_range( $field_spec->index_start, $field_spec->index_end, $#fields )
+ }
- for my $field (@fields) {
- my $start = 3;
+ # iterate over fields
+ for my $field (@fields) {
+ $prev_tag = $current_tag;
+ $current_tag = $field->[0];
- my @sf_results;
+ $tag_index = ( $prev_tag eq $current_tag and defined $tag_index)
+ ? ++$tag_index
+ : 0; #: $field_spec->index_start;
+ # filter by indicator
+ if( defined $indicator1 ) {
+ next unless ( defined $field->[1] && $field->[1] =~ $indicator1)
+ }
+
+ if( defined $indicator2 ) {
+ #next unless $field->[2] =~ $indicator2;
+ next unless ( defined $field->[2] && $field->[2] =~ $indicator2)
+ }
+
+ # filter by index
+ if ( defined $index_range ) {
+ next unless ( Catmandu::Util::array_includes( $index_range, $tag_index ) )
+ }
+
+ # filter field by subspec
+ if( $field_spec->has_subspecs) {
+ my $valid = $self->_it_subspecs( $data, $field_spec->tag, $field_spec->subspecs, $tag_index );
+ next unless $valid
+ }
+
+ if ( $ms->has_subfields ) { # now we dealing with subfields
for my $sf (@sf_spec) {
# set invert level
- if ( $invert ) {
- if ( -1 == $sf->index_length
- && !defined $sf->char_start )
- { # todo add subspec check
- next
- if ( $invert_level == 3 )
- ; # skip subfield spec it's already covered
- $invert_level = 3;
+ if ( $invert && !$sf->has_subspecs) {
+ if ( -1 == $sf->index_length && !$sf->has_char_start ) {
+ next if ( $invert_level == 3 ); # skip subfield spec it's already covered
+ $invert_level = 3
}
- elsif ( !defined $sf->char_start )
- { # todo add subspec check
- $invert_level = 2;
+ elsif ( $sf->has_char_start ) {
+ $invert_level = 1
}
- else { # todo add subspec check
- $invert_level = 1;
+ else {
+ $invert_level = 2
}
}
- @subfield = ();
- my $code =
- ( $invert_level == 3 ) ? $codes : $sf->code;
- $code = qr/$code/;
- for ( my $i = $start ; $i < @$field ; $i += 2 ) {
+ my @subfield = ();
+ my $code = ( $invert_level == 3 ) ? $codes : $sf->code;
+ $code = qr/$code/;
+ for ( my $i = 3 ; $i < @{$field} ; $i += 2 ) {
if ( $field->[$i] =~ /$code/ ) {
- push( @subfield, $field->[ $i + 1 ] );
+ push @subfield, $field->[ $i + 1 ]
}
}
- if ( $invert_level == 3 ) {
- if (@subfield) { push @sf_results, @subfield }
+ if ( $invert_level == 3 ) { # no index or charpos
+ if (@subfield) {
+ $to_referred->(@subfield)
+ }
- # return $value_set ASAP
- if ( @sf_results && $value_set ) {
- return $value_set;
+ if ( $referred && $value_set ) { # return $value_set ASAP
+ return $value_set
}
- next;
+ next
}
next unless (@subfield);
# filter by index
- if ( -1 != $sf->index_length ) {
- my $sf_range = $self->get_index_range( $sf, scalar @subfield );
+ if ( defined $sf->index_start ) {
+ my $sf_range =
+ _get_index_range( $sf->index_start, $sf->index_end, $#subfield );
+
if ( $invert_level == 2 ) { # inverted
@subfield = map {
Catmandu::Util::array_includes( $sf_range, $_ )
? ()
: $subfield[$_]
- } 0 .. $#subfield;
+ } 0 .. $#subfield
}
else { # without invert
@subfield =
- map { defined $subfield[$_] ? $subfield[$_] : () }
- @$sf_range;
+ map {
+ defined $subfield[$_]
+ ? $subfield[$_]
+ : ()
+ } @{$sf_range}
}
- next unless (@subfield);
+ next unless (@subfield)
}
# return $value_set ASAP
- if ( $value_set ) { return $value_set }
+ return $value_set if $value_set;
+
+ # filter subfield by subspec
+ if( $sf->has_subspecs) {
+ my $valid = $self->_it_subspecs( $data, $field_spec->tag, $sf->subspecs, $tag_index);
+ next unless $valid
+ }
# get substring
- my $char_start = $sf->char_start;
+ $char_start = $chst->($sf);
if ( defined $char_start ) {
- my $char_start =
- ( '#' eq $char_start )
- ? $sf->char_length * -1
- : $char_start;
if ( $invert_level == 1 ) { # inverted
- @subfield = map {
+ @subfield =
+ map {
$invert_chars->( $_, $char_start, $sf->char_length )
- } @subfield;
+ } @subfield
}
else {
@subfield =
- map { substr $_, $char_start, $sf->char_length }
- @subfield;
+ map {
+ substr $_, $char_start, $sf->char_length
+ } @subfield
}
}
-
- push @sf_results, @subfield;
+ next unless @subfield;
+ $to_referred->(@subfield)
+ } # end of subfield iteration
+ } # end of subfield handling
+ else { # no particular subfields requested
+ my @contents = ();
+ for ( my $i = 4 ; $i < @{$field} ; $i += 2 ) {
+ # get substring
+ $char_start = $chst->($field_spec);
+ my $content = ( defined $char_start )
+ ? substr $field->[$i], $char_start, $field_spec->char_length
+ : $field->[$i];
+ push @contents, $content
}
+ next unless (@contents);
+ $to_referred->(@contents);
+ } # end of field handling
+ } # end of field iteration
+ return unless ($referred);
+
+ if($append) {
+ return [$referred] if $split;
+ return $referred
+ } elsif($split) {
+ return [$referred]
+ }
- if ($split) {
- push @subfields, @sf_results;
- }
- else {
- push @subfields, join($join_char, at sf_results);
- }
- }
+ return join $join_char, @{$referred}
+}
- unless (@subfields) { return $vals }
+sub _it_subspecs {
+ my ( $self, $data, $tag, $subspecs, $tag_index, $code_index ) = @_;
+ my $set_index = sub {
+ my ( $subspec ) = @_;
+ foreach my $side ( ('left', 'right') ) {
+ next if ( ref $subspec->$side eq 'MARC::Spec::Comparisonstring' );
+ # only set new index if subspec field tag equals spec field tag!!
+ next unless ( $tag eq $subspec->$side->field->tag );
+ $subspec->$side->field->set_index_start_end( $tag_index )
+ }
+ };
- if ($split) {
- $vals = [[@subfields]];
+ my $valid = 1;
+ foreach my $subspec ( @{$subspecs} ) {
+ if( ref $subspec eq 'ARRAY' ) { # chained subSpecs (OR)
+ foreach my $or_subspec ( @{$subspec} ) {
+ $set_index->( $or_subspec );
+ $valid = $self->_validate_subspec( $or_subspec, $data );
+ # at least one of them is true (OR)
+ last if $valid
+ }
}
- elsif ($append) {
- $vals = [@subfields];
+ else { # repeated SubSpecs (AND)
+ $set_index->( $subspec );
+ $valid = $self->_validate_subspec( $subspec, $data );
+ # all of them have to be true (AND)
+ last unless $valid
}
- elsif (@subfields) {
- $vals = join( $join_char, @subfields );
+ }
+ return $valid
+}
+
+sub _validate_subspec {
+ my ( $self, $subspec, $data ) = @_;
+ my ($left_subterm, $right_subterm);
+
+ if('!' ne $subspec->operator && '?' ne $subspec->operator) {
+ if ( ref $subspec->left ne 'MARC::Spec::Comparisonstring' ) {
+ $left_subterm = $self->marc_spec(
+ $data,
+ $subspec->left,
+ { '-split' => 1 }
+ ); # split should result in an array ref
+ return 0 unless defined $left_subterm
}
else {
- $vals = undef;
+ push @{$left_subterm}, $subspec->left->comparable
}
}
- else { # no particular subfields requested
- my $char_start = $field_spec->char_start;
- if ( defined $char_start ) {
- $char_start =
- ( '#' eq $char_start )
- ? $field_spec->char_length * -1
- : $char_start;
+ if ( ref $subspec->right ne 'MARC::Spec::Comparisonstring' ) {
+ $right_subterm = $self->marc_spec(
+ $data,
+ $subspec->right,
+ { '-split' => 1 }
+ ); # split should result in an array ref
+ unless( defined $right_subterm ) {
+ $right_subterm = []
}
+ }
+ else {
+ push @{$right_subterm}, $subspec->right->comparable
+ }
- my @mapped = ();
- for my $field (@fields) {
- my $start = 4;
-
- my @subfields = ();
- for ( my $i = $start ; $i < @$field ; $i += 2 ) {
- push( @subfields, $field->[$i] );
- }
- next unless (@subfields);
+ if($subspec->operator eq '?') {
+ return (@{$right_subterm}) ? 1 : 0
+ }
- # get substring
- if ( defined $char_start ) {
- @subfields =
- map { substr $_, $char_start, $field_spec->char_length }
- @subfields;
- }
+ if($subspec->operator eq '!') {
+ return (@{$right_subterm}) ? 0 : 1
+ }
- if ($split) {
- push @mapped, @subfields;
- }
- else {
- push @mapped, join($join_char, at subfields);
- }
+ if($subspec->operator eq '=') {
+ foreach my $v ( @{$left_subterm->[0]} ) {
+ return 1 if List::Util::any {$v eq $_} @{$right_subterm}
}
+ }
- unless (@mapped) {
- return $vals
+ if($subspec->operator eq '!=') {
+ foreach my $v ( @{$left_subterm->[0]} ) {
+ return 0 if List::Util::any {$v eq $_} @{$right_subterm}
}
+ return 1
+ }
- if ($split) {
- $vals = [[@mapped]];
- }
- elsif ($append) {
- $vals = [ @mapped ];
- }
- elsif (@mapped) {
- $vals = join $join_char, @mapped;
+ if($subspec->operator eq '~') {
+ foreach my $v ( @{$left_subterm->[0]} ) {
+ return 1 if List::Util::any {$v =~ m?$_?} @{$right_subterm}
}
- else {
- $vals = undef;
+ }
+
+ if($subspec->operator eq '!~') {
+ foreach my $v ( @{$left_subterm->[0]} ) {
+ return 0 if List::Util::any {$v =~ m?$_?} @{$right_subterm}
}
+ return 1
}
- return $vals;
+ return 0
}
sub parse_marc_spec {
my ( $self, $marc_spec ) = @_;
- my $ms = MARC::Spec->parse( $marc_spec );
+ return MARC::Spec->parse( $marc_spec )
}
-sub get_index_range {
- my ( $self, $spec, $total ) = @_;
-
- my $last_index = $total - 1;
- my $index_start = $spec->index_start;
- my $index_end = $spec->index_end;
+sub _get_index_range {
+ my ( $index_start, $index_end, $last_index ) = @_;
- if ( '#' eq $index_start ) {
- if ( '#' eq $index_end or 0 eq $index_end ) { return [$last_index] }
- $index_start = $last_index;
- $index_end = $last_index - $index_end;
- if ( 0 > $index_end ) { $index_end = 0 }
- }
- else {
- if ( $last_index < $index_start ) {
- return [$index_start];
- } # this will result to no hits
- }
+ if ( '#' eq $index_start ) {
+ if ( '#' eq $index_end or 0 == $index_end ) { return [$last_index] }
+ $index_start = $last_index;
+ $index_end = $last_index - $index_end;
+ if ( 0 > $index_end ) { $index_end = 0 }
+ }
+ else {
+ if ( $last_index < $index_start ) {
+ return [$index_start]
+ } # this will result to no hits
+ }
- if ( '#' eq $index_end or $index_end > $last_index ) {
- $index_end = $last_index;
- }
+ if ( '#' eq $index_end or $index_end > $last_index ) {
+ $index_end = $last_index
+ }
- my $range =
- ( $index_start <= $index_end )
- ? [ $index_start .. $index_end ]
- : [ $index_end .. $index_start ];
- return $range;
+ return ( $index_start <= $index_end )
+ ? [ $index_start .. $index_end ]
+ : [ $index_end .. $index_start ]
}
sub marc_xml {
diff --git a/t/21-marc-spec.t b/t/21-marc-spec.t
index 1fa3319..dbac380 100644
--- a/t/21-marc-spec.t
+++ b/t/21-marc-spec.t
@@ -7,26 +7,34 @@ use Catmandu::Importer::MARC;
use Catmandu::Fix;
my $fixer = Catmandu::Fix->new(fixes => ['t/marc_spec.fix']);
-my $importer = Catmandu::Importer::MARC->new( file => 't/camel.mrc', type => "ISO" );
+my $importer = Catmandu::Importer::MARC->new( file => 't/camel9.mrc', type => "ISO" );
my $records = $fixer->fix($importer)->to_array;
-is $records->[0]->{my}{id}, 'fol05731351 ', q|fix: marc_spec('001', my.id);|;
+is $records->[0]->{my}{id}, 'fol05882032 ', q|fix: marc_spec('001', my.id);|;
ok !defined $records->[0]->{my}{no}{field}, q|fix: marc_spec('000', my.no.field);|;
-# field 666 does not exist in camel.usmarc
-# the '$append' fix creates $my->{'references'} hash key with empty array ref as value
+#field 666 does not exist in camel.usmarc
+#he '$append' fix creates $my->{'references'} hash key with empty array ref as value
ok !$records->[0]->{'my'}{'references'}, q|fix: marc_map('666', my.references.$append);|;
-is $records->[9]->{my}{title}{all}, 'Cross-platform Perl /Eric F. Johnson.', q|fix: marc_spec('245', my.title.all);|;
+is_deeply
+ $records->[0]->{'my'}{'references2'},
+ [
+ 'first',
+ 'IMchF'
+ ],
+ q|fix: add_field(my.references2.$first, 'first'); marc_map('003', my.references2.$append);|;
+
+is $records->[0]->{my}{title}{all}, 'Cross-platform Perl /Eric F. Johnson.', q|fix: marc_spec('245', my.title.all);|;
-is $records->[9]->{my}{title}{default}, 'the title', q|fix: marc_spec('245', my.title.default, value:'the title');|;
+is $records->[0]->{my}{title}{default}, 'the title', q|fix: marc_spec('245', my.title.default, value:'the title');|;
-is $records->[9]->{my}{subjects}{all}, 'Perl (Computer program language)Web servers.Cross-platform software development.', q|fix: marc_spec('650', my.subjects.all);|;
+is $records->[0]->{my}{subjects}{all}, 'Perl (Computer program language)Web servers.Cross-platform software development.', q|fix: marc_spec('650', my.subjects.all);|;
-is $records->[9]->{my}{subjects}{joined}, 'Perl (Computer program language)###Web servers.###Cross-platform software development.', q|fix: marc_spec('650', my.subjects.joined, join:'###');|;
+is $records->[0]->{my}{subjects}{joined}, 'Perl (Computer program language)###Web servers.###Cross-platform software development.', q|fix: marc_spec('650', my.subjects.joined, join:'###');|;
is_deeply
- $records->[9]->{my}{append}{subjects},
+ $records->[0]->{my}{append}{subjects},
[
'Perl (Computer program language)',
'Web servers.',
@@ -35,12 +43,16 @@ is_deeply
q|fix: marc_spec('650', my.append.subjects.$append);|;
is_deeply
- $records->[9]->{my}{split}{subjects},
- ['Perl (Computer program language)', 'Web servers.', 'Cross-platform software development.'],
+ $records->[0]->{my}{split}{subjects},
+ [
+ 'Perl (Computer program language)',
+ 'Web servers.',
+ 'Cross-platform software development.'
+ ],
q|fix: marc_spec('650', my.split.subjects, split:1);|;
is_deeply
- $records->[9]->{my}{append}{split}{subjects},
+ $records->[0]->{my}{append}{split}{subjects},
[
[
"Perl (Computer program language)",
@@ -51,42 +63,42 @@ is_deeply
q|fix: marc_spec('650', my.append.split.subjects.$append, split:1);|;
is_deeply
- $records->[9]->{my}{fields}{indicators10},
+ $records->[0]->{my}{fields}{indicators10},
['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);|;
+is scalar @{$records->[0]->{my}{fields}{indicators_0}}, 9, q|fix: marc_spec('...__0', my.fields.indicators_0, split:1);|;
-is $records->[9]->{my}{ldr}{all}, '00696nam 22002538a 4500', q|fix: marc_spec('LDR', my.ldr.all);|;
+is $records->[0]->{my}{ldr}{all}, '00696nam 22002538a 4500', q|fix: marc_spec('LDR', my.ldr.all);|;
-is $records->[9]->{my}{firstcharpos}{ldr}, '0069', q|fix: marc_spec('LDR', my.firstcharpos.ldr);|;
+is $records->[0]->{my}{firstcharpos}{ldr}, '0069', q|fix: marc_spec('LDR', my.firstcharpos.ldr);|;
-is $records->[9]->{my}{lastcharpos}{ldr}, '4500', q|fix: marc_spec('LDR/#-3', my.lastcharpos.ldr);|;
+is $records->[0]->{my}{lastcharpos}{ldr}, '4500', q|fix: marc_spec('LDR/#-3', my.lastcharpos.ldr);|;
-is $records->[9]->{my}{title}{proper}, 'Cross-platform Perl /', q|fix: marc_spec('245$a', my.title.proper);|;
+is $records->[0]->{my}{title}{proper}, 'Cross-platform Perl /', q|fix: marc_spec('245$a', my.title.proper);|;
-is $records->[9]->{my}{title}{indicator}{proper}, 'Cross-platform Perl /', q|fix: marc_spec('245_10$a', my.title.indicator.proper);|;
+is $records->[0]->{my}{title}{indicator}{proper}, 'Cross-platform Perl /', q|fix: marc_spec('245_10$a', my.title.indicator.proper);|;
-is $records->[9]->{my}{title}{charpos}, 'Cr', q|fix: marc_spec('245$a/0-1', my.title.charpos);|;
+is $records->[0]->{my}{title}{charpos}, 'Cr', q|fix: marc_spec('245$a/0-1', my.title.charpos);|;
-is $records->[9]->{my}{second}{subject}, 'Web servers.', q|fix: marc_spec('650[1]', my.second.subjects);|;
-is $records->[9]->{my}{last}{subject}, 'Cross-platform software development.', q|fix: marc_spec('650[#]', my.last.subjects);|;
+is $records->[0]->{my}{second}{subject}, 'Web servers.', q|fix: marc_spec('650[1]', my.second.subjects);|;
+is $records->[0]->{my}{last}{subject}, 'Cross-platform software development.', q|fix: marc_spec('650[#]', my.last.subjects);|;
is_deeply
- $records->[9]->{my}{two}{split}{subjects},
+ $records->[0]->{my}{two}{split}{subjects},
['Perl (Computer program language)', 'Web servers.'],
q|fix: marc_spec('650[0-1]', my.two.split.subjects, split:1);|;
-is $records->[9]->{my}{two}{join}{subjects}, 'Web servers.###Cross-platform software development.', q|fix: marc_spec('650[#-1]', my.two.join.subjects, join:'###');|;
+is $records->[0]->{my}{two}{join}{subjects}, 'Web servers.###Cross-platform software development.', q|fix: marc_spec('650[#-1]', my.two.join.subjects, join:'###');|;
-is $records->[9]->{my}{isbn}{number}, '0764547291 (alk. paper)0491001304test0491001304', q|fix: marc_spec('020$a[0]', my.isbn.number);|;
-is $records->[9]->{my}{isbn}{numbers}, '0764547291 (alk. paper)0491001304', q|fix: marc_spec('020$a[0]', my.isbn.numbers);|;
-ok !defined $records->[9]->{my}{isbn}{qual}{none}, q|fix: marc_spec('020[0]$q[0]', my.isbn.qual.none);|;
-is $records->[9]->{my}{isbn}{qual}{first}, 'black leather', q|fix: marc_spec('020$q[0]', my.isbn.qual.first);|;
-is $records->[9]->{my}{isbn}{qual}{second}, 'blue pigskin', q|fix: marc_spec('020$q[1]', my.isbn.qual.second);|;
-is $records->[9]->{my}{isbn}{qual}{last}, 'easel binding', q|fix: marc_spec('020$q[#]', my.isbn.qual.last);|;
+is $records->[0]->{my}{isbn}{number}, '0764547291 (alk. paper)0491001304test0491001304', q|fix: marc_spec('020$a[0]', my.isbn.number);|;
+is $records->[0]->{my}{isbn}{numbers}, '0764547291 (alk. paper)0491001304', q|fix: marc_spec('020$a[0]', my.isbn.numbers);|;
+ok !defined $records->[0]->{my}{isbn}{qual}{none}, q|fix: marc_spec('020[0]$q[0]', my.isbn.qual.none);|;
+is $records->[0]->{my}{isbn}{qual}{first}, 'black leather', q|fix: marc_spec('020$q[0]', my.isbn.qual.first);|;
+is $records->[0]->{my}{isbn}{qual}{second}, 'blue pigskin', q|fix: marc_spec('020$q[1]', my.isbn.qual.second);|;
+is $records->[0]->{my}{isbn}{qual}{last}, 'easel binding', q|fix: marc_spec('020$q[#]', my.isbn.qual.last);|;
is_deeply
- $records->[9]->{my}{isbns}{all},
+ $records->[0]->{my}{isbns}{all},
[
"0764547291 (alk. paper)",
"0491001304",
@@ -97,7 +109,7 @@ is_deeply
],
q|fix: marc_spec('020$q$a', my.isbns.all, split:1);|;
is_deeply
- $records->[9]->{my}{isbns}{pluck}{all},
+ $records->[0]->{my}{isbns}{pluck}{all},
[
"0764547291 (alk. paper)",
"black leather",
@@ -108,14 +120,14 @@ is_deeply
],
q|fix: marc_spec('020$q$a', my.isbns.all, split:1, pluck:1);|;
is_deeply
- $records->[9]->{my}{isbn}{qual}{other},
+ $records->[0]->{my}{isbn}{qual}{other},
[
"test0491001304",
"easel binding"
],
q|fix: marc_spec('020$q[#]$a[1]', my.isbn.qual.other, split:1);|;
is_deeply
- $records->[9]->{my}{isbn}{qual}{range},
+ $records->[0]->{my}{isbn}{qual}{range},
[
"0764547291 (alk. paper)",
"0491001304",
@@ -125,16 +137,17 @@ is_deeply
],
q|fix: marc_spec('020$q[#-1]$a[0-1]', my.isbn.qual.range, split:1);|;
is_deeply
- $records->[9]->{my}{isbn}{qual}{substring}{other},
+ $records->[0]->{my}{isbn}{qual}{substring}{other},
[
"4",
"easel"
],
q|fix: marc_spec('020$q[#]/0-4$a[1]/#-0', my.isbn.qual.substring.other, split:1);|;
-is $records->[9]->{my}{level3}{inverted}, '2000.', q|fix: marc_spec('260[#]$b$a', my.level3.inverted, invert:1);|;
-is $records->[9]->{my}{level2}{inverted}, 'black leatherblue pigskin', q|fix: marc_spec('020$a$q[#]', my.level2.inverted, invert:1);|;
-is $records->[9]->{my}{level1}{inverted}, 'ebinding', q|fix: marc_spec('020[#]$a$q[#]/1-5', my.level1.inverted, invert:1);|;
-is $records->[9]->{my}{multi}{level1}{inverted}, 'bleatherbigskinebinding', q|fix: marc_spec('020[#]$a$q[0]/1-5$q[1]/1-5$q[2]/1-5', my.multi.level1.inverted, invert:1);|;
+is $records->[0]->{my}{level3}{inverted}, '2000.', q|fix: marc_spec('260[#]$b$a', my.level3.inverted, invert:1);|;
+is $records->[0]->{my}{level2}{inverted}, 'black leatherblue pigskin', q|fix: marc_spec('020$a$q[#]', my.level2.inverted, invert:1);|;
+is $records->[0]->{my}{level1}{inverted}, 'ebinding', q|fix: marc_spec('020[#]$a$q[#]/1-5', my.level1.inverted, invert:1);|;
+is $records->[0]->{my}{multi}{level1}{inverted}, 'bleatherbigskinebinding', q|fix: marc_spec('020[#]$a$q[0]/1-5$q[1]/1-5$q[2]/1-5', my.multi.level1.inverted, invert:1);|;
+
-done_testing;
+done_testing;
\ No newline at end of file
diff --git a/t/23-mapping_rules_spec.t b/t/23-mapping_rules_spec.t
index 858c089..5aec65d 100644
--- a/t/23-mapping_rules_spec.t
+++ b/t/23-mapping_rules_spec.t
@@ -70,7 +70,19 @@ note 'marc_spec(245,title.$append) title: [ "Title / Name" ]';
fix => 'marc_spec(245,title.$append); retain_field(title)'
);
my $record = $importer->first;
- is_deeply $record->{title}, ['Title / Name'], 'marc_spec(245.$append,title)';
+ is_deeply $record->{title}, ['Title / Name'], 'marc_spec(245,title.$append)';
+}
+
+note 'add_field(title.$first, "first"); marc_spec(245,title.$append) title: ["first", "Title / Name" ]';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'add_field(title.$first, "first"); marc_spec(245,title.$append); retain_field(title)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{title}, ['first', 'Title / Name'], 'marc_spec(245,title.$append)';
}
note 'marc_spec(245$a,title.$append) title: [ "Title / " ]';
@@ -98,10 +110,40 @@ note 'marc_spec(245,title, split:1) title: [ "Title / ", "Name" ]';
'marc_spec(245,title, split:1)';
}
-note
- 'marc_spec(245, title, split:1, nested_arrays:1) title: [[ "Title / ", "Name" ]]';
+note 'marc_spec(245,title.$append, split:1) title: [ [ "Title / ", "Name" ] ]';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(245,title.$append, split:1); retain_field(title)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{title}, [[ 'Title / ', 'Name' ]], 'marc_spec(245a,title.$append,split:1)';
+}
+
+note 'marc_spec(245,title, split:1, nested_arrays:1) title: [ [ "Title / ", "Name" ] ]';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(245,title, split:1, nested_arrays:1); retain_field(title)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{title}, [[ 'Title / ', 'Name' ]], 'marc_spec(245, title, split:1, nested_arrays:1)';
+}
+
+note 'marc_spec(245,title.$append, split:1, nested_arrays:1) title: [[ [ "Title / ", "Name" ] ]]';
{
- note "nested_arrays not yet supported";
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(245,title.$append, split:1, nested_arrays:1); retain_field(title)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{title}, [[[ 'Title / ', 'Name' ]]], 'marc_spec(245a,title.$append,split:1, nested_arrays:1)';
}
note 'marc_spec(500,note) note: "ABCD"';
@@ -152,6 +194,18 @@ note 'marc_spec(500,note.$append) note: [ "ABCD" ]';
is_deeply $record->{note}, ['ABCD'], ' marc_spec(500,note.$append)';
}
+note 'marc_spec(500,note.$append, join:"#") note: [ "A#B#C#D" ]';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(500,note.$append, join:"#"); retain_field(note)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{note}, ['A#B#C#D'], ' marc_spec(500,note.$append, join:"#")';
+}
+
note 'marc_spec(500$a,note.$append) note: [ "ABC" ]';
{
my $importer = Catmandu->importer(
@@ -215,7 +269,14 @@ note 'marc_spec(500$a,note, split:1) note: [ "A" , "B" , "C" ]';
note
'marc_spec(500$a,note, split:1, nested_arrays:1) note: [[ "A" , "B" , "C" ]]';
{
- note("nested arrays not yet supported");
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(500$a,note, split:1, nested_arrays:1); retain_field(note)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{note}, [[ "A" , "B" , "C" ]], 'marc_spec(500a,note, split:1)';
}
note 'marc_spec(500$a,note.$append, split:1) note : [[ "A" , "B" , "C" ]]';
@@ -227,8 +288,7 @@ note 'marc_spec(500$a,note.$append, split:1) note : [[ "A" , "B" , "C" ]]';
fix => 'marc_spec(500$a,note.$append, split:1); retain_field(note)'
);
my $record = $importer->first;
- is_deeply $record->{note}, [ [ 'A', 'B', 'C' ] ],
- 'marc_spec(500$a,note.$append, split:1)';
+ is_deeply $record->{note}, [ [ 'A', 'B', 'C' ] ], 'marc_spec(500$a,note.$append, split:1)';
}
note 'marc_spec(500$x,note.$append, split:1, invert:1) note : [[ "A" , "B" , "C" ]]';
@@ -245,9 +305,16 @@ note 'marc_spec(500$x,note.$append, split:1, invert:1) note : [[ "A" , "B" ,
}
note
- 'marc_map(500a,note.$append, split:1, nested_arrays: 1) note : [[[ "A" , "B" , "C" ]]]';
+ 'marc_spec(500$a,note.$append, split:1, nested_arrays: 1) note : [[[ "A" , "B" , "C" ]]]';
{
- note("nested arrays not yet supported");
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(500$a,note.$append, split:1, nested_arrays: 1); retain_field(note)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{note}, [[[ "A" , "B" , "C" ]]], 'marc_spec(500$a,note.$append, split:1, nested_arrays: 1)';
}
note 'marc_spec(650,subject) subject: "AlphaBetaGamma"';
@@ -319,8 +386,7 @@ note 'marc_spec(650$a,subject.$append) subject: [ "Alpha", "Beta" , "Gamma" ]';
fix => 'marc_spec(650$a,subject.$append); retain_field(subject)'
);
my $record = $importer->first;
- is_deeply $record->{subject}, [ 'Alpha', 'Beta', 'Gamma' ],
- 'marc_spec(650$a,subject.$append)';
+ is_deeply $record->{subject}, [ 'Alpha', 'Beta', 'Gamma' ], 'marc_spec(650$a,subject.$append)';
}
note
@@ -333,8 +399,7 @@ note
fix => 'marc_spec(650$a,subject, split:1); retain_field(subject)'
);
my $record = $importer->first;
- is_deeply $record->{subject}, [ 'Alpha', 'Beta', 'Gamma' ],
- 'marc_spec(650$a,subject, split:1)';
+ is_deeply $record->{subject}, [ 'Alpha', 'Beta', 'Gamma' ], 'marc_spec(650$a,subject, split:1)';
}
note
@@ -348,20 +413,35 @@ note
'marc_spec(650$a,subject.$append, split:1) ; retain_field(subject)'
);
my $record = $importer->first;
- is_deeply $record->{subject}, [ [ 'Alpha', 'Beta', 'Gamma' ] ],
- 'marc_spec(650$a,subject.$append, split:1) ';
+ is_deeply $record->{subject}, [ [ 'Alpha', 'Beta', 'Gamma' ] ], 'marc_spec(650$a,subject.$append, split:1) ';
}
note
- 'marc_spec(650$a,subject, split:1, nested_arrays:1) subject: [["Alpha"], ["Beta"] , ["Gamma"]]';
+ 'marc_spec(650,subject, nested_arrays:1) subject: [["Alpha"], ["Beta"] , ["Gamma"]]';
{
- note("nested_arrays not yet supported");
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix =>
+ 'marc_spec(650,subject, split:1, nested_arrays:1); retain_field(subject)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{subject}, [ ['Alpha'], ['Beta'], ['Gamma'] ], 'marc_spec(650,subject, nested_arrays:1)';
}
note
- 'marc_spec(650$a,subject.$append, split:1, nested_arrays:1) subject: [[["Alpha"], ["Beta"] , ["Gamma"]]]';
+ 'marc_spec(650$a,subject, split:1, nested_arrays:1) subject: [["Alpha"], ["Beta"] , ["Gamma"]]';
{
- note("nested_arrays not yet supported");
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix =>
+ 'marc_spec(650$a,subject, split:1, nested_arrays:1); retain_field(subject)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{subject}, [ ['Alpha'], ['Beta'], ['Gamma'] ], 'marc_spec(650$a,subject, split:1, nested_arrays:1)';
}
note 'marc_spec(999,local) local: "XYZ"';
@@ -460,6 +540,7 @@ note 'marc_spec(999$a,local, split:1) local: [ "X" , "Y", "Z" ]';
is_deeply $record->{local}, [ 'X', 'Y', 'Z' ], 'marc_spec(999$a,local, split:1)';
}
+
note 'marc_spec(999$a[0],local, split:1) local: [ "X" , "Z" ]';
{
my $importer = Catmandu->importer(
@@ -493,8 +574,7 @@ note 'marc_spec(999$a,local.$append, split:1) local: [[ "X" , "Y", "Z" ]]';
fix => 'marc_spec(999$a,local.$append, split:1); retain_field(local)'
);
my $record = $importer->first;
- is_deeply $record->{local}, [ [ 'X', 'Y', 'Z' ] ],
- 'marc_spec(999$a,local.$append, split:1)';
+ is_deeply $record->{local}, [ [ 'X', 'Y', 'Z' ] ], 'marc_spec(999$a,local.$append, split:1)';
}
note 'marc_spec(999$a[0],local.$append, split:1) local: [[ "X" , "Z" ]]';
@@ -506,21 +586,108 @@ note 'marc_spec(999$a[0],local.$append, split:1) local: [[ "X" , "Z" ]]';
fix => 'marc_spec(999$a[0],local.$append, split:1); retain_field(local)'
);
my $record = $importer->first;
- is_deeply $record->{local}, [ [ 'X', 'Z' ] ],
- 'marc_spec(999$a[0],local.$append, split:1)';
+ is_deeply $record->{local}, [ [ 'X', 'Z' ] ], 'marc_spec(999$a[0],local.$append, split:1)';
}
-note
- 'marc_spec(999$a,local, split:1, nested_arrays:1) local: [ ["X" , "Y"] , ["Z"] ]';
+
+note 'marc_spec(999$a,local, nested_arrays:1) local: [ ["X" , "Y"] , ["Z"] ]';
{
- note("nested_arrays not yet supported");
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(999$a,local, nested_arrays:1); retain_field(local)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{local}, [ [ 'X', 'Y' ], ['Z'] ], 'marc_spec(999$a,local, nested_arrays:1) ';
}
-note
- 'marc_map(999a,local.$append, split:1, nested_arrays:1) local: [[ ["X" , "Y"] , ["Z"] ]]';
+
+
+note 'marc_spec(...$a, all.$append) all: [ "Title / ", "ABC", "Alpha", "Beta", "Gamma", "XY", "Z" ]';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(...$a, all.$append); retain_field(all)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{all}, [ "Title / ", "ABC", "Alpha", "Beta", "Gamma", "XY", "Z" ], 'marc_spec(...$a, all.$append)';
+}
+
+note 'marc_spec(..., all.$append) all: [ "Title / Name", "ABCD", "Alpha", "Beta", "Gamma", "XY", "Z" ]';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(..., all.$append); retain_field(all)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{all}, [ " ", "Title / Name", "ABCD", "Alpha", "Beta", "Gamma", "XY", "Z" ], 'marc_spec(..., all.$append)';
+}
+
+note 'marc_spec(...$a, all, split:1) all: [ "Title / " , "A" , "B" , "C", "Alpha" , "Beta" , "Gamma" , "X" , "Y", "Z" ]';
{
- note("nested_arrays not yet supported");
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(...$a, all, split:1); retain_field(all)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{all}, [ "Title / " , "A" , "B" , "C", "Alpha" , "Beta" , "Gamma" , "X" , "Y", "Z" ], 'marc_spec(...$a, all, split:1)';
}
+note 'marc_spec(...$a, all.$append, split:1) all: [[ "Title / " , "A" , "B" , "C", "Alpha" , "Beta" , "Gamma" , "X" , "Y", "Z" ]]';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(...$a, all.$append, split:1); retain_field(all)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{all}, [[ "Title / " , "A" , "B" , "C", "Alpha" , "Beta" , "Gamma" , "X" , "Y", "Z" ]], 'marc_spec(...$a, all.$append, split:1)';
+}
+
+
+note 'marc_spec(...$a, all, split:1, nested_arrays:1) all: [["Title / "], ["A" , "B" , "C"], ["Alpha"] , ["Beta"] , ["Gamma"] , ["X" , "Y"], ["Z"]]';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(...$a, all, split:1, nested_arrays:1); retain_field(all)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{all}, [ ["Title / "], ["A" , "B" , "C"], ["Alpha"] , ["Beta"] , ["Gamma"] , ["X" , "Y"], ["Z"]], 'marc_spec(...$a, all, split:1, nested_arrays:1)';
+}
+
+note 'marc_spec(...$a, all.$append, split:1, nested_arrays:1) all: [[ ["Title / "], ["A" , "B" , "C"], ["Alpha"] , ["Beta"] , ["Gamma"] , ["X" , "Y"], ["Z"]]]';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec(...$a, all.$append, split:1, nested_arrays:1); retain_field(all)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{all}, [[ ["Title / "], ["A" , "B" , "C"], ["Alpha"] , ["Beta"] , ["Gamma"] , ["X" , "Y"], ["Z"]]], 'marc_spec(...$a, all.$append, split:1, nested_arrays:1)';
+
+}
+
+note 'add_field(all.$first,"first"); marc_spec(...$a, all.$append, split:1, nested_arrays:1) all: ["first",[ ["Title / "], ["A" , "B" , "C"], ["Alpha"] , ["Beta"] , ["Gamma"] , ["X" , "Y"], ["Z"]]]';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'add_field(all.$first,"first"); marc_spec(...$a, all.$append, split:1, nested_arrays:1); retain_field(all)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{all}, ["first",[ ["Title / "], ["A" , "B" , "C"], ["Alpha"] , ["Beta"] , ["Gamma"] , ["X" , "Y"], ["Z"]]], 'marc_spec(...$a, all.$append, split:1, nested_arrays:1)';
+}
done_testing;
diff --git a/t/24-marc-spec-subspecs.t b/t/24-marc-spec-subspecs.t
new file mode 100644
index 0000000..6a69b80
--- /dev/null
+++ b/t/24-marc-spec-subspecs.t
@@ -0,0 +1,402 @@
+use strict;
+use warnings;
+use Test::More;
+use Catmandu;
+
+my $mrc = <<'MRC';
+<?xml version="1.0" encoding="UTF-8"?>
+<marc:collection xmlns:marc="http://www.loc.gov/MARC21/slim">
+ <marc:record>
+ <marc:datafield ind1="0" ind2="1" tag="245">
+ <marc:subfield code="a">Title / </marc:subfield>
+ <marc:subfield code="c">Name</marc:subfield>
+ </marc:datafield>
+ <marc:datafield ind1=" " ind2=" " tag="500">
+ <marc:subfield code="a">A</marc:subfield>
+ <marc:subfield code="a">B</marc:subfield>
+ <marc:subfield code="a">C</marc:subfield>
+ <marc:subfield code="x">D</marc:subfield>
+ </marc:datafield>
+ <marc:datafield ind1=" " ind2=" " tag="650">
+ <marc:subfield code="a">Alpha</marc:subfield>
+ </marc:datafield>
+ <marc:datafield ind1=" " ind2=" " tag="650">
+ <marc:subfield code="a">Beta</marc:subfield>
+ </marc:datafield>
+ <marc:datafield ind1=" " ind2=" " tag="650">
+ <marc:subfield code="a">Gamma</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="1" ind2=" " tag="999">
+ <marc:subfield code="a">Z</marc:subfield>
+ </marc:datafield>
+ </marc:record>
+</marc:collection>
+MRC
+
+note 'marc_spec(650{$a=\Beta}, equals) equals: "Beta"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650{$a=\Beta}", equals); retain_field(equals)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{equals}, 'Beta', 'marc_spec(650{$a=\Beta}, equals)';
+}
+
+note 'marc_spec(650{$a!=\Beta}, equals_not) equals_not: "AlphaGamma"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650{$a!=\Beta}", equals_not); retain_field(equals_not)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{equals_not}, 'AlphaGamma', 'marc_spec(650{$a!=\Beta}, equals_not)';
+}
+
+note 'marc_spec(650{$a/0=\B}, equals) equals: "Beta"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650{$a/0=\B}", equals); retain_field(equals)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{equals}, 'Beta', 'marc_spec(650{$a/0=\B}, equals)';
+}
+
+note 'marc_spec(650{$a/0!=\B}, equals_not) equals_not: "AlphaGamma"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650{$a/0!=\B}", equals_not); retain_field(equals_not)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{equals_not}, 'AlphaGamma', 'marc_spec(650{$a/0!=\B}, equals_not)';
+}
+
+note 'marc_spec(650{$a~\ph}, includes) includes: "Alpha"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650{$a~\ph}", includes); retain_field(includes)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{includes}, 'Alpha', 'marc_spec(650{$a~\ph}, includes)';
+}
+
+note 'marc_spec(650{$a!~\ph}, includes_not) includes_not: "BetaGamma"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650{$a!~\ph}", includes_not); retain_field(includes_not)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{includes_not}, 'BetaGamma', 'marc_spec(650{$a!~\ph}, includes_not)';
+}
+
+note 'marc_spec(650[#]{$a!~\ph}, includes_not) includes_not: "Gamma"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650[#]{$a!~\ph}", includes_not); retain_field(includes_not)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{includes_not}, 'Gamma', 'marc_spec(650[#]{$a!~\ph}, includes_not)';
+}
+
+note 'marc_spec(245{500$a}, exists) exists: "Title / Name"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("245{500$a}", exists); retain_field(exists)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{exists}, 'Title / Name', 'marc_spec(245{500$a}, exists)';
+}
+
+note 'marc_spec(245{!500$a}, exists_not) exists_not: undef';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("245{!500$a}", exists_not); retain_field(exists_not)'
+ );
+ my $record = $importer->first;
+ ok !$record->{exists_not}, 'marc_spec(245{!500$a}, exists_not)';
+}
+
+note 'marc_spec(245$a{500$a=\C}, equals) equals: "Title / "';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("245$a{500$a=\C}", equals); retain_field(equals)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{equals}, 'Title / ', 'marc_spec(245$a{500$a=\C}, equals)';
+}
+
+note 'marc_spec(245$a{500$a!=\C}, equals_not) equals_not: undef';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("245$a{500$a!=\C}", equals_not); retain_field(equals_not)'
+ );
+ my $record = $importer->first;
+ ok !$record->{equals_not}, 'marc_spec(245$a{500$a!=\C}, equals_not)';
+}
+
+note 'marc_spec(245{500$a!=\F}, equals_not) equals: "Title / Name"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("245{500$a!=\F}", equals_not); retain_field(equals_not)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{equals_not}, 'Title / Name', 'marc_spec(245{500$a!=\F}, equals_not)';
+}
+
+note 'marc_spec(500$a[1]{$x}, exists) exists: "B"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("500$a[1]{$x}", exists); retain_field(exists)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{exists}, 'B', 'marc_spec(500$a[1]{$x}, exists)';
+}
+
+note 'marc_spec(500$a[1]{!$x}, exists_not) exists_not: undef';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("500$a[1]{!$x}", exists_not); retain_field(exists_not)'
+ );
+ my $record = $importer->first;
+ ok !$record->{exists_not}, 'marc_spec(500$a[1]{!$x}, exists_not)';
+}
+
+note 'marc_spec(500$a[1]{!$c}, exists_not) exists_not: "B"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("500$a[1]{!$c}", exists_not); retain_field(exists_not)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{exists_not}, 'B', 'marc_spec(500$a[1]{!$c}, exists_not)';
+}
+
+note 'marc_spec(650[1]{300}, exists) exists: undef';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650[1]{300}", exists); retain_field(exists)'
+ );
+ my $record = $importer->first;
+ ok !$record->{exists}, 'marc_spec(650[1]{300}, exists)';
+}
+
+note 'marc_spec(650[1-#]{!300}, exists_not) exists_not: "BetaGamma"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650[1-#]{!300}", exists_not); retain_field(exists_not)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{exists_not}, 'BetaGamma', 'marc_spec(650[1-#]{!300}, exists_not)';
+}
+
+note 'marc_spec(650[0]{!300}, exists_not) exists_not: "Alpha"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650[0]{!300}", exists_not); retain_field(exists_not)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{exists_not}, 'Alpha', 'marc_spec(650[0]{!300}, exists_not)';
+}
+
+note 'marc_spec(650[1]{245_0}, indicator1) indicator1: "Beta"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650[1]{245_0}", indicator1); retain_field(indicator1)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{indicator1}, 'Beta', 'marc_spec(650[1]{245_0}, indicator1)';
+}
+
+note 'marc_spec(999$a{_1}, indicator1) indicator1: "Z"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("999$a{999_1}", indicator1); retain_field(indicator1)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{indicator1}, 'Z', 'marc_spec(999$a{_1}, indicator1)';
+}
+
+note 'marc_spec(650[1]{245_1}, indicator1) indicator1: undef';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650[1]{245_1}", indicator1); retain_field(indicator1)'
+ );
+ my $record = $importer->first;
+ ok !$record->{indicator1}, 'marc_spec(650[1]{245_1}, indicator1)';
+}
+
+note 'marc_spec(650[1]{245__1}, indicator2) indicator1: "Beta"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650[1]{245__1}", indicator2); retain_field(indicator2)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{indicator2}, 'Beta', 'marc_spec(650[1]{245__1}, indicator2)';
+}
+
+note 'marc_spec(650[1]{245__0}, indicator2) indicator2: undef';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650[1]{245__0}", indicator2); retain_field(indicator2)'
+ );
+ my $record = $importer->first;
+ ok !$record->{indicator2}, 'marc_spec(650[1]{245__0}, indicator2)';
+}
+
+note 'marc_spec(650[1]{245_01}, indicators) indicator1: "Beta"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650[1]{245_01}", indicators); retain_field(indicators)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{indicators}, 'Beta', 'marc_spec(650[1]{245_01}, indicators)';
+}
+
+note 'marc_spec(650[1]{245_00}, indicators) indicator2: undef';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("650[1]{245_00}", indicators); retain_field(indicators)'
+ );
+ my $record = $importer->first;
+ ok !$record->{indicators}, 'marc_spec(650[1]{245_00}, indicators)';
+}
+
+
+note 'marc_spec(999{245_00|$a=\Y}, or) or: "XY"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("999{245_00|$a=\Y}", or); retain_field(or)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{or}, 'XY', 'marc_spec(999{245_00|$a=\Y}, or)';
+}
+
+note 'marc_spec(999$a[#]{245_00|$a=\Y}, or) or: "Y"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("999$a[#]{245_00|$a=\Y}", or); retain_field(or)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{or}, 'Y', 'marc_spec(999$a[#]{245_00|$a=\Y}, or)';
+}
+
+note 'marc_spec(999$a[#]{245_00}{$a=\Y}, and) and: undef';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("999$a[#]{245_00}{$a=\Y}", and); retain_field(and)'
+ );
+ my $record = $importer->first;
+ ok !$record->{and}, 'marc_spec(999$a[#]{245_00}{$a=\Y}, and)';
+}
+
+note 'marc_spec(999$a[#]{245_01}{$a=\Y}, and) and: "Y"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("999$a[#]{245_01}{$a=\Y}", and); retain_field(and)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{and}, 'Y', 'marc_spec(999$a[#]{245_01}{$a=\Y}, and)';
+}
+
+note 'marc_spec(999$a[#]{245_01}{$a=\Foo|$a=\Y}, and) and: "Y"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_spec("999$a[#]{245_01}{$a=\Foo|$a=\Y}", and); retain_field(and)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{and}, 'Y', 'marc_spec(999$a[#]{245_01}{$a=\Foo|$a=\Y}, and)';
+}
+
+
+done_testing;
diff --git a/t/marc_spec.fix b/t/marc_spec.fix
index ca6b9c2..1b35d92 100644
--- a/t/marc_spec.fix
+++ b/t/marc_spec.fix
@@ -4,6 +4,9 @@ marc_spec('000', my.no.field, value:'nofield')
marc_spec('666', my.references.$append)
+add_field(my.references2.$first, 'first')
+marc_map('003', my.references2.$append);
+
marc_spec('245', my.title.all)
marc_spec('245', my.title.default, value:'the title')
--
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