[libcatmandu-marc-perl] 115/208: Adding support for $ and . in marcpath
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:42 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 0d314af42b85247d192d2423b8fbeb5a12f87226
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Mon Mar 6 09:46:26 2017 +0100
Adding support for $ and . in marcpath
---
lib/Catmandu/Fix/marc_map.pm | 4 +-
lib/Catmandu/MARC.pm | 7 ++--
t/22-mapping_rules.t | 90 ++++++++++++++++++++++++++++++++++++--------
3 files changed, 81 insertions(+), 20 deletions(-)
diff --git a/lib/Catmandu/Fix/marc_map.pm b/lib/Catmandu/Fix/marc_map.pm
index e77fb33..005f4ba 100644
--- a/lib/Catmandu/Fix/marc_map.pm
+++ b/lib/Catmandu/Fix/marc_map.pm
@@ -112,7 +112,7 @@ Catmandu::Fix::marc_map - copy marc values of one field to a new field
marc_map('100^0123456789','author')
# Map all the 500 - 599 fields to my.notes
- marc_map('5**','my.motes')
+ marc_map('5..','my.motes')
# Map the 100-a field where indicator-1 is 3
marc_map('100[3]a','name.family')
@@ -150,7 +150,7 @@ The MARC_PATH can point to one or more MARC subfields. For instamce:
Wildcards are allowed in the field names:
# Map all the 200-fields to a title
- marc_map('2**'',title)
+ marc_map('2..'',title)
To filter out specific fields indicators can be used:
diff --git a/lib/Catmandu/MARC.pm b/lib/Catmandu/MARC.pm
index 0d1437d..5fd2812 100644
--- a/lib/Catmandu/MARC.pm
+++ b/lib/Catmandu/MARC.pm
@@ -769,7 +769,7 @@ sub compile_marc_path {
my ($field,$field_regex,$ind1,$ind2,
$subfield,$subfield_regex,$from,$to,$len,$is_regex_field);
- my $MARC_PATH_REGEX = qr/(\S{1,3})(\[([^,])?,?([^,])?\])?([_a-z0-9^]+)?(\/(\d+)(-(\d+))?)?/;
+ my $MARC_PATH_REGEX = qr/(\S{1,3})(\[([^,])?,?([^,])?\])?([\$_a-z0-9^]+)?(\/(\d+)(-(\d+))?)?/;
if ($marc_path =~ $MARC_PATH_REGEX) {
$field = $1;
$ind1 = $3;
@@ -777,6 +777,7 @@ sub compile_marc_path {
$subfield = $5;
$field = "0" x (3 - length($field)) . $field; # fixing 020 treated as 20 bug
if (defined($subfield)) {
+ $subfield =~ s{\$}{}g;
unless ($subfield =~ /^[a-zA-Z0-9]$/) {
$subfield = "[$subfield]";
}
@@ -798,9 +799,9 @@ sub compile_marc_path {
return undef;
}
- if ($field =~ /\*/) {
+ if ($field =~ /[\*\.]/) {
$field_regex = $field;
- $field_regex =~ s/\*/(?:[A-Z0-9])/g;
+ $field_regex =~ s/[\*\.]/(?:[A-Z0-9])/g;
$is_regex_field = 1;
$field_regex = qr/^$field_regex$/;
}
diff --git a/t/22-mapping_rules.t b/t/22-mapping_rules.t
index 190317a..2a9c4b9 100644
--- a/t/22-mapping_rules.t
+++ b/t/22-mapping_rules.t
@@ -61,6 +61,66 @@ note 'marc_map(245a,title) title: "Title / "';
is_deeply $record->{title}, 'Title / ', 'marc_map(245a,title)';
}
+note 'marc_map(245$a,title) title: "Title / "';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_map(245$a,title); retain_field(title)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{title}, 'Title / ', 'marc_map(245$a,title)';
+}
+
+note 'marc_map(245ac,title) title: "Title / Name"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_map(245ac,title); retain_field(title)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{title}, 'Title / Name', 'marc_map(245ac,title)';
+}
+
+note 'marc_map(245ca,title) title: "Title / Name"';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_map(245ca,title); retain_field(title)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{title}, 'Title / Name', 'marc_map(245ca,title)';
+}
+
+note 'marc_map(245ca,title,pluck:1) title: "NameTitle / "';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_map(245ca,title,pluck:1); retain_field(title)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{title}, 'NameTitle / ', 'marc_map(245ca,title,pluck:1)';
+}
+
+note 'marc_map(245ca,title,pluck:1,join:" ") title: "NameTitle / "';
+{
+ my $importer = Catmandu->importer(
+ 'MARC',
+ file => \$mrc,
+ type => 'XML',
+ fix => 'marc_map(245ca,title,pluck:1,join:" "); retain_field(title)'
+ );
+ my $record = $importer->first;
+ is_deeply $record->{title}, 'Name Title / ', 'marc_map(245ca,title,pluck:1,join:" ")';
+}
+
note 'marc_map(245,title.$append) title: [ "Title / Name" ]';
{
my $importer = Catmandu->importer(
@@ -415,72 +475,72 @@ note
'marc_map(650a,local.$append, split:1, nested_arrays:1)';
}
-note 'marc_map(***,all) all: "Title / NameABCDAlphaBetaGammaXYZ"';
+note 'marc_map(...,all) all: "Title / NameABCDAlphaBetaGammaXYZ"';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
fix =>
- 'marc_remove(LDR); marc_map(***,all); retain_field(all)'
+ 'marc_remove(LDR); marc_map(...,all); retain_field(all)'
);
my $record = $importer->first;
is_deeply $record->{all}, 'Title / NameABCDAlphaBetaGammaXYZ',
- 'marc_map(***,all)';
+ 'marc_map(...,all)';
}
-note 'marc_map(***a,all) all: "Title / ABCAlphaBetaGammaXYZ"';
+note 'marc_map(...a,all) all: "Title / ABCAlphaBetaGammaXYZ"';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
- fix => 'marc_remove(LDR); marc_map(***a,all); retain_field(all)'
+ fix => 'marc_remove(LDR); marc_map(...a,all); retain_field(all)'
);
my $record = $importer->first;
- is_deeply $record->{all}, 'Title / ABCAlphaBetaGammaXYZ', 'marc_map(***a,all)';
+ is_deeply $record->{all}, 'Title / ABCAlphaBetaGammaXYZ', 'marc_map(...a,all)';
}
note
- 'marc_map(***a,all.$append) all: [ "Title / " , "ABC", "Alpha" , "Beta" , "Gamma" , "XY", "Z" ]';
+ 'marc_map(...a,all.$append) all: [ "Title / " , "ABC", "Alpha" , "Beta" , "Gamma" , "XY", "Z" ]';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
- fix => 'marc_remove(LDR); marc_map(***a,all.$append); retain_field(all)'
+ fix => 'marc_remove(LDR); marc_map(...a,all.$append); retain_field(all)'
);
my $record = $importer->first;
is_deeply $record->{all},
[ "Title / " , "ABC", "Alpha" , "Beta" , "Gamma" , "XY", "Z" ],
- 'marc_map(***a,all.$append)';
+ 'marc_map(...a,all.$append)';
}
note
- 'marc_map(***a,all, split:1) all: [ "Title / " , "A" , "B" , "C", "Alpha" , "Beta" , "Gamma" , "X" , "Y", "Z" ]';
+ 'marc_map(...a,all, split:1) all: [ "Title / " , "A" , "B" , "C", "Alpha" , "Beta" , "Gamma" , "X" , "Y", "Z" ]';
{
my $importer = Catmandu->importer(
'MARC',
file => \$mrc,
type => 'XML',
- fix => 'marc_remove(LDR); marc_map(***a,all, split:1); retain_field(all)'
+ fix => 'marc_remove(LDR); marc_map(...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_map(***a,all, split:1)';
+ 'Z' ], 'marc_map(...a,all, split:1)';
}
note
- 'marc_map(***a,all, split:1, nested_arrays:1) all: [ ["Title / "] , ["A" , "B" , "C"], ["Alpha"] , ["Beta"] , ["Gamma"] , ["X" , "Y"], ["Z"] ]';
+ 'marc_map(...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_remove(LDR); marc_map(***a,all, split:1, nested_arrays:1); retain_field(all)'
+ 'marc_remove(LDR); marc_map(...a,all, split:1, nested_arrays:1); retain_field(all)'
);
my $record = $importer->first;
is_deeply $record->{all},
@@ -488,7 +548,7 @@ note
['Title / '], [ 'A', 'B', 'C' ], ['Alpha'], ['Beta'],
['Gamma'], [ 'X', 'Y' ], ['Z']
],
- 'marc_map(***a,all, split:1, nested_arrays:1)';
+ 'marc_map(...a,all, split:1, nested_arrays:1)';
}
done_testing;
--
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