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 <[email protected]> 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,@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,@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 _______________________________________________ Pkg-perl-cvs-commits mailing list [email protected] http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
