[libcatmandu-marc-perl] 21/26: using MARC::Spec 2.0
Jonas Smedegaard
dr at jones.dk
Tue Dec 19 12:17:05 UTC 2017
This is an automated email from the git hooks/post-receive script.
js pushed a commit to annotated tag upstream/1.23.1
in repository libcatmandu-marc-perl.
commit 306d301e62bd7424f97adb494ed7ec54924ec0a9
Author: Carsten Klee <cKlee at users.noreply.github.com>
Date: Sat Dec 16 11:25:36 2017 +0100
using MARC::Spec 2.0
---
cpanfile | 2 +-
lib/Catmandu/MARC.pm | 30 +++++++++++++------
t/Catmandu/Fix/marc_spec.t | 6 ++--
t/marc-spec-subspecs.t | 72 +++++++++++++++++++++++-----------------------
t/marc_spec.fix | 6 ++--
5 files changed, 64 insertions(+), 52 deletions(-)
diff --git a/cpanfile b/cpanfile
index ffb2923..5338011 100644
--- a/cpanfile
+++ b/cpanfile
@@ -22,7 +22,7 @@ requires 'MARC::File::MiJ' , '0.04';
requires 'MARC::Record', '2.0.6';
requires 'MARC::Lint', '0';
requires 'MARC::Parser::RAW', '0';
-requires 'MARC::Spec', '==1.0.0';
+requires 'MARC::Spec', '2.0.3';
requires 'Memoize', '0';
requires 'Moo', '1.0';
requires 'MooX::Singleton', '0';
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index 95bcdbd..c2082df 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -576,7 +576,7 @@ sub marc_spec {
# filter field by subspec
if( $field_spec->has_subspecs) {
- my $valid = $self->_it_subspecs( $data, $field_spec->tag, $field_spec->subspecs, $tag_index );
+ my $valid = $self->_it_subspecs( $data, $current_tag, $field_spec->subspecs, $tag_index );
next unless $valid;
}
@@ -675,8 +675,14 @@ sub marc_spec {
$to_referred->(@subfields) if @subfields;
} # end of subfield handling
elsif($ms->has_indicator){
+ # filter field by subspec
+ if( $ms->indicator->has_subspecs) {
+ my $valid = $self->_it_subspecs( $data, $current_tag, $ms->indicator->subspecs, $tag_index );
+ next unless $valid;
+ }
my @indicators = ();
- push @indicators, $field->[$ms->indicator->position];
+ push @indicators, $field->[$ms->indicator->position]
+ if defined $field->[$ms->indicator->position];
$to_referred->(@indicators);
}
else { # no particular subfields requested
@@ -706,13 +712,15 @@ sub marc_spec {
}
sub _it_subspecs {
- my ( $self, $data, $tag, $subspecs, $tag_index, $code_index ) = @_;
+ my ( $self, $data, $tag, $subspecs, $tag_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 );
+ my $spec_tag = $subspec->$side->field->tag;
+ next unless ( $tag =~ /$spec_tag/ );
$subspec->$side->field->set_index_start_end( $tag_index );
}
};
@@ -722,14 +730,14 @@ sub _it_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 );
+ $valid = $self->_validate_subspec( $or_subspec, $data, $tag );
# at least one of them is true (OR)
last if $valid;
}
}
else { # repeated SubSpecs (AND)
$set_index->( $subspec );
- $valid = $self->_validate_subspec( $subspec, $data );
+ $valid = $self->_validate_subspec( $subspec, $data, $tag );
# all of them have to be true (AND)
last unless $valid;
}
@@ -738,14 +746,16 @@ sub _it_subspecs {
}
sub _validate_subspec {
- my ( $self, $subspec, $data ) = @_;
+ my ( $self, $subspec, $data, $tag ) = @_;
my ($left_subterm, $right_subterm);
if('!' ne $subspec->operator && '?' ne $subspec->operator) {
if ( ref $subspec->left ne 'MARC::Spec::Comparisonstring' ) {
+ my $new_spec = $subspec->left->to_string();
+ $new_spec =~ s/^\.\.\./$tag/;
$left_subterm = $self->marc_spec(
$data,
- $subspec->left,
+ $new_spec,
{ '-split' => 1 }
); # split should result in an array ref
return 0 unless defined $left_subterm;
@@ -756,9 +766,11 @@ sub _validate_subspec {
}
if ( ref $subspec->right ne 'MARC::Spec::Comparisonstring' ) {
+ my $new_spec = $subspec->right->to_string();
+ $new_spec =~ s/^\.\.\./$tag/;
$right_subterm = $self->marc_spec(
$data,
- $subspec->right,
+ $new_spec,
{ '-split' => 1 }
); # split should result in an array ref
unless( defined $right_subterm ) {
diff --git a/t/Catmandu/Fix/marc_spec.t b/t/Catmandu/Fix/marc_spec.t
index 67127dd..810d93a 100644
--- a/t/Catmandu/Fix/marc_spec.t
+++ b/t/Catmandu/Fix/marc_spec.t
@@ -76,9 +76,9 @@ is_deeply
is_deeply
$records->[0]->{my}{fields}{indicators10},
['Cross-platform Perl /Eric F. Johnson.'],
- q|fix: marc_spec('..._10', my.fields.indicators10.$append);|;
+ q|fix: marc_spec('...{^1=\1}{^2=\0}', my.fields.indicators10.$append);|;
-is scalar @{$records->[0]->{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('...{^2=\0}', my.fields.indicators_0, split:1);|;
is $records->[0]->{my}{ldr}{all}, '00696nam 22002538a 4500', q|fix: marc_spec('LDR', my.ldr.all);|;
@@ -88,7 +88,7 @@ is $records->[0]->{my}{lastcharpos}{ldr}, '4500', q|fix: marc_spec('LDR/#-3', my
is $records->[0]->{my}{title}{proper}, 'Cross-platform Perl /', q|fix: marc_spec('245$a', my.title.proper);|;
-is $records->[0]->{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$a{^1=\1}{^2=\0}', my.title.indicator.proper);|;
is $records->[0]->{my}{title}{charpos}, 'Cr', q|fix: marc_spec('245$a/0-1', my.title.charpos);|;
diff --git a/t/marc-spec-subspecs.t b/t/marc-spec-subspecs.t
index 6a69b80..7db6e5e 100644
--- a/t/marc-spec-subspecs.t
+++ b/t/marc-spec-subspecs.t
@@ -253,149 +253,149 @@ note 'marc_spec(650[0]{!300}, exists_not) exists_not: "Alpha"';
is_deeply $record->{exists_not}, 'Alpha', 'marc_spec(650[0]{!300}, exists_not)';
}
-note 'marc_spec(650[1]{245_0}, indicator1) indicator1: "Beta"';
+note 'marc_spec(650[1]{245^1=\0}, indicator1) indicator1: "Beta"';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
- fix => 'marc_spec("650[1]{245_0}", indicator1); retain_field(indicator1)'
+ fix => 'marc_spec("650[1]{245^1=\0}", indicator1); retain_field(indicator1)'
);
my $record = $importer->first;
- is_deeply $record->{indicator1}, 'Beta', 'marc_spec(650[1]{245_0}, indicator1)';
+ is_deeply $record->{indicator1}, 'Beta', 'marc_spec(650[1]{245^1=\0}, indicator1)';
}
-note 'marc_spec(999$a{_1}, indicator1) indicator1: "Z"';
+note 'marc_spec(999$a{^1=\1}, indicator1) indicator1: "Z"';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
- fix => 'marc_spec("999$a{999_1}", indicator1); retain_field(indicator1)'
+ fix => 'marc_spec("999$a{^1=\1}", indicator1); retain_field(indicator1)'
);
my $record = $importer->first;
- is_deeply $record->{indicator1}, 'Z', 'marc_spec(999$a{_1}, indicator1)';
+ is_deeply $record->{indicator1}, 'Z', 'marc_spec(999$a{^1=\1}, indicator1)';
}
-note 'marc_spec(650[1]{245_1}, indicator1) indicator1: undef';
+note 'marc_spec(650[1]{245^1=\1}, indicator1) indicator1: undef';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
- fix => 'marc_spec("650[1]{245_1}", indicator1); retain_field(indicator1)'
+ fix => 'marc_spec("650[1]{245^1=\1}", indicator1); retain_field(indicator1)'
);
my $record = $importer->first;
- ok !$record->{indicator1}, 'marc_spec(650[1]{245_1}, indicator1)';
+ ok !$record->{indicator1}, 'marc_spec(650[1]{245^1=\1}, indicator1)';
}
-note 'marc_spec(650[1]{245__1}, indicator2) indicator1: "Beta"';
+note 'marc_spec(650[1]{245^2=\1}, indicator2) indicator2: "Beta"';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
- fix => 'marc_spec("650[1]{245__1}", indicator2); retain_field(indicator2)'
+ fix => 'marc_spec("650[1]{245^2=\1}", indicator2); retain_field(indicator2)'
);
my $record = $importer->first;
- is_deeply $record->{indicator2}, 'Beta', 'marc_spec(650[1]{245__1}, indicator2)';
+ is_deeply $record->{indicator2}, 'Beta', 'marc_spec(650[1]{245^2=\1}, indicator2)';
}
-note 'marc_spec(650[1]{245__0}, indicator2) indicator2: undef';
+note 'marc_spec(650[1]{245^2=\0}, indicator2) indicator2: undef';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
- fix => 'marc_spec("650[1]{245__0}", indicator2); retain_field(indicator2)'
+ fix => 'marc_spec("650[1]{245^2=\0}", indicator2); retain_field(indicator2)'
);
my $record = $importer->first;
- ok !$record->{indicator2}, 'marc_spec(650[1]{245__0}, indicator2)';
+ ok !$record->{indicator2}, 'marc_spec(650[1]{245^2=\0}, indicator2)';
}
-note 'marc_spec(650[1]{245_01}, indicators) indicator1: "Beta"';
+note 'marc_spec(650[1]{245^1=\0}{245^2=\1}, indicators) indicator1: "Beta"';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
- fix => 'marc_spec("650[1]{245_01}", indicators); retain_field(indicators)'
+ fix => 'marc_spec("650[1]{245^1=\0}{245^2=\1}", indicators); retain_field(indicators)'
);
my $record = $importer->first;
- is_deeply $record->{indicators}, 'Beta', 'marc_spec(650[1]{245_01}, indicators)';
+ is_deeply $record->{indicators}, 'Beta', 'marc_spec(650[1]{245^1=\0}{245^2=\1}, indicators)';
}
-note 'marc_spec(650[1]{245_00}, indicators) indicator2: undef';
+note 'marc_spec(650[1]{245^1=\0}{245^2=\0}, indicators) indicator2: undef';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
- fix => 'marc_spec("650[1]{245_00}", indicators); retain_field(indicators)'
+ fix => 'marc_spec("650[1]{245^1=\0}{245^2=\0}", indicators); retain_field(indicators)'
);
my $record = $importer->first;
- ok !$record->{indicators}, 'marc_spec(650[1]{245_00}, indicators)';
+ ok !$record->{indicators}, 'marc_spec(650[1]{245^1=\0}{245^2=\0}, indicators)';
}
-note 'marc_spec(999{245_00|$a=\Y}, or) or: "XY"';
+note 'marc_spec(999{245^2=\0|$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)'
+ fix => 'marc_spec("999{245^2=\0|$a=\Y}", or); retain_field(or)'
);
my $record = $importer->first;
- is_deeply $record->{or}, 'XY', 'marc_spec(999{245_00|$a=\Y}, or)';
+ is_deeply $record->{or}, 'XY', 'marc_spec(999{245^2=\0|$a=\Y}, or)';
}
-note 'marc_spec(999$a[#]{245_00|$a=\Y}, or) or: "Y"';
+note 'marc_spec(999$a[#]{245^2=\0|$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)'
+ fix => 'marc_spec("999$a[#]{245^2=\0|$a=\Y}", or); retain_field(or)'
);
my $record = $importer->first;
- is_deeply $record->{or}, 'Y', 'marc_spec(999$a[#]{245_00|$a=\Y}, or)';
+ is_deeply $record->{or}, 'Y', 'marc_spec(999$a[#]{245^2=\0|$a=\Y}, or)';
}
-note 'marc_spec(999$a[#]{245_00}{$a=\Y}, and) and: undef';
+note 'marc_spec(999$a[#]{245^1=\0}{245^2=\0}{$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)'
+ fix => 'marc_spec("999$a[#]{245^1=\0}{245^2=\0}{$a=\Y}", and); retain_field(and)'
);
my $record = $importer->first;
- ok !$record->{and}, 'marc_spec(999$a[#]{245_00}{$a=\Y}, and)';
+ ok !$record->{and}, 'marc_spec(999$a[#]{245^1=\0}{245^2=\0}{$a=\Y}, and)';
}
-note 'marc_spec(999$a[#]{245_01}{$a=\Y}, and) and: "Y"';
+note 'marc_spec(999$a[#]{245^1=\0}{245^2=\1}{$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)'
+ fix => 'marc_spec("999$a[#]{245^1=\0}{245^2=\1}{$a=\Y}", and); retain_field(and)'
);
my $record = $importer->first;
- is_deeply $record->{and}, 'Y', 'marc_spec(999$a[#]{245_01}{$a=\Y}, and)';
+ is_deeply $record->{and}, 'Y', 'marc_spec(999$a[#]{245^1=\0}{245^2=\1}{$a=\Y}, and)';
}
-note 'marc_spec(999$a[#]{245_01}{$a=\Foo|$a=\Y}, and) and: "Y"';
+note 'marc_spec(999$a[#]{245^1=\0}{245^2=\1}{$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)'
+ fix => 'marc_spec("999$a[#]{245^1=\0}{245^2=\1}{$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)';
+ is_deeply $record->{and}, 'Y', 'marc_spec(999$a[#]{245^1=\0}{245^2=\1}{$a=\Foo|$a=\Y}, and)';
}
diff --git a/t/marc_spec.fix b/t/marc_spec.fix
index 842e0c5..42063f5 100644
--- a/t/marc_spec.fix
+++ b/t/marc_spec.fix
@@ -21,9 +21,9 @@ marc_spec('650', my.split.subjects, split:1)
marc_spec('650', my.append.split.subjects.$append, split:1)
-marc_spec('..._10', my.fields.indicators10.$append)
+marc_spec('...{^1=\1}{^2=\0}', my.fields.indicators10.$append)
-marc_spec('...__0', my.fields.indicators_0, split:1)
+marc_spec('...{^2=\0}', my.fields.indicators_0, split:1)
marc_spec('LDR', my.ldr.all)
@@ -33,7 +33,7 @@ marc_spec('LDR/#-3', my.lastcharpos.ldr)
marc_spec('245$a', my.title.proper)
-marc_spec('245_10$a', my.title.indicator.proper)
+marc_spec('245$a{^1=\1}{^2=\0}', my.title.indicator.proper)
marc_spec('245$a/0-1', my.title.charpos)
--
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