[libcatmandu-marc-perl] 74/208: Adding Carsten Klee's MARC-Spec contribution
Jonas Smedegaard
dr at jones.dk
Sat Oct 28 03:42:37 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 8e18ffced1146a5ca4360b07143212c13655f84c
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Thu Jan 19 10:24:24 2017 +0100
Adding Carsten Klee's MARC-Spec contribution
---
Build.PL | 2 +
cpanfile | 4 +-
lib/Catmandu/Fix/marc_spec.pm | 626 ++++++++++++++++++++++++++++++++++++++++++
t/00-load.t | 3 +-
t/21-marc-spec.t | 136 +++++++++
t/marc_spec.fix | 59 ++++
6 files changed, 828 insertions(+), 2 deletions(-)
diff --git a/Build.PL b/Build.PL
index 31243e8..fe8c3a1 100644
--- a/Build.PL
+++ b/Build.PL
@@ -25,6 +25,7 @@ my %module_build_args = (
"requires" => {
"Carp" => 0,
"Catmandu" => "1.0201",
+ "Const::Fast" => "0.014",
"JSON::XS" => "2.3",
"List::Util" => 0,
"MARC::File::MARCMaker" => "0.05",
@@ -33,6 +34,7 @@ my %module_build_args = (
"MARC::Lint" => 0,
"MARC::Parser::RAW" => 0,
"MARC::Record" => "v2.0.6",
+ "MARC::Spec" => 0,
"Memoize" => 0,
"Moo" => "1.0",
"MooX::Singleton" => 0,
diff --git a/cpanfile b/cpanfile
index 03f1ab1..a9873a3 100644
--- a/cpanfile
+++ b/cpanfile
@@ -21,6 +21,8 @@ requires 'MARC::File::MiJ' , '0.04';
requires 'MARC::Record', '2.0.6';
requires 'MARC::Lint', '0';
requires 'MARC::Parser::RAW', '0';
+requires 'Const::Fast', '0.014';
+requires 'MARC::Spec';
requires 'Memoize', '0';
requires 'Moo', '1.0';
-requires 'MooX::Singleton', '0';
\ No newline at end of file
+requires 'MooX::Singleton', '0';
diff --git a/lib/Catmandu/Fix/marc_spec.pm b/lib/Catmandu/Fix/marc_spec.pm
new file mode 100644
index 0000000..a2c638c
--- /dev/null
+++ b/lib/Catmandu/Fix/marc_spec.pm
@@ -0,0 +1,626 @@
+package Catmandu::Fix::marc_spec;
+
+use Moo;
+use Catmandu::Sane;
+use Catmandu::Util qw(:data :array);
+use Catmandu::Fix::Has;
+use MARC::Spec;
+use Const::Fast;
+
+our $VERSION = '0.0.1';
+
+has spec => ( fix_arg => 1 );
+has path => ( fix_arg => 1 );
+has record => ( fix_opt => 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 );
+
+const my $NO_LENGTH => -1;
+const my $FIELD_OFFSET => 3;
+const my $INVERT_LEVEL_DEFAULT => 4;
+const my $INVERT_LEVEL_3 => 3;
+const my $INVERT_LEVEL_2 => 2;
+const my $INVERT_LEVEL_1 => 1;
+const my $INVERT_LEVEL_0 => 0;
+const my $EMPTY => q{};
+
+my $cache;
+
+sub fix {
+ my ( $self, $data ) = @_;
+ my $join_char = $self->join // $EMPTY;
+ my $record_key = $self->record // 'record';
+ my $_id = $data->{_id};
+ my ( $path, $key ) = parse_data_path( $self->path );
+
+ # get MARCspec
+ if ( !defined $cache->{ $self->spec } ) {
+ $cache->{ $self->spec } = MARC::Spec->parse( $self->spec );
+ }
+ my $ms = $cache->{ $self->spec };
+
+ my $get_index_range = sub {
+ my ( $spec, $total ) = @_;
+
+ my $last_index = $total - 1;
+ my $index_start = $spec->index_start;
+ my $index_end = $spec->index_end;
+
+ 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_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;
+ };
+
+ my $set_data = sub {
+ my ($val) = @_;
+ my $nested = data_at( $path, $data, create => 1, key => $key );
+ set_data( $nested, $key, $val );
+ return $data;
+ };
+
+ # filter by tag
+ my @fields = ();
+ my $field_spec = $ms->field;
+ my $tag = $field_spec->tag;
+ $tag = qr/$tag/;
+ unless ( @fields =
+ grep { $_->[0] =~ /$tag/ } @{ $data->{$record_key} } )
+ {
+ return $data;
+ }
+
+ if (defined $field_spec->indicator1) {
+ my $indicator1 = $field_spec->indicator1;
+ $indicator1 = qr/$indicator1/;
+ unless( @fields =
+ grep { defined $_->[1] && $_->[1] =~ /$indicator1/ } @fields)
+ {
+ return $data;
+ }
+ }
+ if (defined $field_spec->indicator2) {
+ my $indicator2 = $field_spec->indicator2;
+ $indicator2 = qr/$indicator2/;
+ unless( @fields =
+ grep { defined $_->[2] && $_->[2] =~ /$indicator2/ } @fields)
+ {
+ return $data;
+ }
+ }
+
+ # filter by index
+ if ( $NO_LENGTH != $field_spec->index_length ) { # index is requested
+ my $index_range = $get_index_range->( $field_spec, scalar @fields );
+ my $prevTag = $EMPTY;
+ my $index = 0;
+ my $tag;
+ my @filtered = ();
+ for my $pos ( 0 .. $#fields ) {
+ $tag = $fields[$pos][0];
+ $index = ( $prevTag eq $tag or $EMPTY eq $prevTag ) ? $index : 0;
+ if ( array_includes( $index_range, $index ) ) {
+ push @filtered, $fields[$pos];
+ }
+ $index++;
+ $prevTag = $tag;
+ }
+ unless (@filtered) { return $data }
+ @fields = @filtered;
+ }
+
+ # return $self->value ASAP
+ if ( $self->value && !defined $ms->subfields ) {
+ return $set_data->( $self->value );
+ }
+
+ if ( defined $ms->subfields ) { # now we dealing with subfields
+ # set the order of subfields
+ my @sf_spec = map { $_ } @{ $ms->subfields };
+ unless ( $self->pluck ) {
+ @sf_spec = sort { $a->code cmp $b->code } @sf_spec;
+ }
+
+ # set invert level default
+ my $invert_level = $INVERT_LEVEL_DEFAULT;
+ my $codes;
+ if ( $self->invert ) {
+ $codes = '[^';
+ $codes .= join '', map { $_->code } @sf_spec;
+ $codes .= ']';
+ }
+
+ my ( @subfields, @subfield );
+ my $invert_chars = sub {
+ my ( $str, $start, $length ) = @_;
+ for ( substr $str, $start, $length ) {
+ $_ = '';
+ }
+ return $str;
+ };
+
+ for my $field (@fields) {
+ my $start = $FIELD_OFFSET;
+ for my $sf (@sf_spec) {
+ # set invert level
+ if ( $self->invert ) {
+ if ( $NO_LENGTH == $sf->index_length
+ && !defined $sf->char_start )
+ { # todo add subspec check
+ next
+ if ( $invert_level == $INVERT_LEVEL_3 )
+ ; # skip subfield spec it's already covered
+ $invert_level = $INVERT_LEVEL_3;
+ }
+ elsif ( !defined $sf->char_start )
+ { # todo add subspec check
+ $invert_level = $INVERT_LEVEL_2;
+ }
+ else { # todo add subspec check
+ $invert_level = $INVERT_LEVEL_1;
+ }
+ }
+
+ @subfield = ();
+ my $code =
+ ( $invert_level == $INVERT_LEVEL_3 ) ? $codes : $sf->code;
+ $code = qr/$code/;
+ for ( my $i = $start ; $i < @$field ; $i += 2 ) {
+ if ( $field->[$i] =~ /$code/ ) {
+ push( @subfield, $field->[ $i + 1 ] );
+ }
+ }
+
+ if ( $invert_level == $INVERT_LEVEL_3 ) {
+ if (@subfield) { push @subfields, @subfield }
+
+ # return $self->value ASAP
+ if ( @subfields && $self->value ) {
+ return $set_data->( $self->value );
+ }
+ next;
+ }
+ next unless (@subfield);
+
+ # filter by index
+ if ( $NO_LENGTH != $sf->index_length ) {
+ my $sf_range = $get_index_range->( $sf, scalar @subfield );
+ if ( $invert_level == $INVERT_LEVEL_2 ) { # inverted
+ @subfield = map {
+ array_includes( $sf_range, $_ )
+ ? ()
+ : $subfield[$_]
+ } 0 .. $#subfield;
+ }
+ else { # without invert
+ @subfield =
+ map { defined $subfield[$_] ? $subfield[$_] : () }
+ @$sf_range;
+ }
+ next unless (@subfield);
+ }
+
+ # return $self->value ASAP
+ if ( $self->value ) { return $set_data->( $self->value ) }
+
+ # get substring
+ my $char_start = $sf->char_start;
+ if ( defined $char_start ) {
+ my $char_start =
+ ( '#' eq $char_start )
+ ? $sf->char_length * -1
+ : $char_start;
+ if ( $invert_level == $INVERT_LEVEL_1 ) { # inverted
+ @subfield = map {
+ $invert_chars->( $_, $char_start, $sf->char_length )
+ } @subfield;
+ }
+ else {
+ @subfield =
+ map { substr $_, $char_start, $sf->char_length }
+ @subfield;
+ }
+ }
+ push @subfields, @subfield if (@subfield);
+ }
+ }
+
+ unless (@subfields) { return $data }
+
+ $self->split
+ ? $set_data->( [@subfields] )
+ : $set_data->( join( $join_char, @subfields ) );
+ }
+ else { # no 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;
+ }
+ my @mapped = ();
+ for my $field (@fields) {
+ my $start = $FIELD_OFFSET + 1;
+
+ my @subfields = ();
+ for ( my $i = $start ; $i < @$field ; $i += 2 ) {
+ push( @subfields, $field->[$i] );
+ }
+ next unless (@subfields);
+
+ # get substring
+ if ( defined $char_start ) {
+ @subfields =
+ map { substr $_, $char_start, $field_spec->char_length }
+ @subfields;
+ }
+ push @mapped, @subfields;
+ }
+ unless (@mapped) { return $data }
+
+ $self->split
+ ? $set_data->( [@mapped] )
+ : $set_data->( join $join_char, @mapped );
+ }
+ return $data;
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+Catmandu::Fix::marc_spec - reference MARC values via
+L<MARCspec - A common MARC record path language|http://marcspec.github.io/MARCspec/>
+
+=head1 SYNOPSIS
+
+In a fix file e.g. 'my.fix':
+
+ # Assign value of MARC leader to my.ldr.all
+ marc_spec('LDR', my.ldr.all)
+
+ # Assign values of all subfields of field 245 as a joined string
+ marc_spec('245', my.title.all)
+
+ # If field 245 exists, set string 'the title' as the value of my.title.default
+ marc_spec('245', my.title.default, value:'the title')
+
+ # Assign values of all subfields of every field 650 to my.subjects.all
+ # as a joined string
+ marc_spec('650', my.subjects.all)
+
+ # Same as above with joining characters '###'
+ marc_spec('650', my.subjects.all, join:'###')
+
+ # Same as above but added as an element to the array my.append.subjects
+ marc_spec('650', my.append.subjects.$append, join:'###')
+
+ # Every value of a subfield will be an array element
+ marc_spec('650', my.split.subjects, split:1)
+
+ # Assign values of all subfields of all fields having indicator 1 = 1
+ # and indicator 2 = 0 to the my.fields.indicators10 array.
+ marc_spec('..._10', my.fields.indicators10.$append)
+
+ # Assign first four characters of leader to my.firstcharpos.ldr
+ marc_spec('LDR/0-3', my.firstcharpos.ldr)
+
+ # Assign last four characters of leader to my.lastcharpos.ldr
+ marc_spec('LDR/#-3', my.lastcharpos.ldr)
+
+ # Assign value of subfield a of field 245 to my.title.proper
+ marc_spec('245$a', my.title.proper)
+
+ # Assign first two characters of subfield a of field 245 to my.title.proper
+ marc_spec('245$a/0-1', my.title.charpos)
+
+ # Assign all subfields of second field 650 to my.second.subject
+ marc_spec('650[1]', my.second.subject)
+
+ # Assign values of all subfields of last field 650 to my.last.subject
+ marc_spec('650[#]', my.last.subject)
+
+ # Assign an array of values of all subfields of the first two fields 650
+ # to my.two.split.subjects
+ marc_spec('650[0-1]', my.two.split.subjects, split:1)
+
+ # Assign a joined string of values of all subfields of the last two fields 650
+ # to my.two.join.subjects
+ marc_spec('650[#-1]', my.two.join.subjects, join:'###')
+
+
+ # Assign value of first subfield a of all fields 020 to my.isbn.number
+ marc_spec('020$a[0]', my.isbn.number)
+
+ # Assign value of first subfield q of first field 020 to my.isbn.qual.one
+ marc_spec('020[0]$q[0]', my.isbn.qual.none)
+
+ # Assign values of subfield q and a in the order stated as an array
+ # to my.isbns.pluck.all
+ # without option 'pluck:1' the elments will be in 'natural' order
+ # see example below
+ marc_spec('020$q$a', my.isbns.pluck.all, split:1, pluck:1)
+
+ # Assign value of last subfield q and second subfield a
+ # in 'natural' order of last field 020 as an array to my.isbn.qual.other
+ marc_spec('020[#]$q[#]$a[1]', my.isbn.qual.other, split:1)
+
+ # Assign first five characters of value of last subfield q and last character
+ # of value of second subfield a in 'natural' order of all fields 020
+ # as an array to my.isbn.qual.substring.other
+ marc_spec('020$q[#]/0-4$a[1]/#', my.isbn.qual.substring.other, split:1)
+
+ # Assign values of of all other subfields than a of field 020
+ # to my.isbn.other.subfields
+ marc_spec('020$a' my.isbn.other.subfields, invert:1)
+
+And then on command line:
+
+ catmandu convert MARC to YAML --fix my.fix < perl_books.mrc
+
+See L<Catmandu Importers|http://librecat.org/Catmandu/#importers> and
+L<Catmandu Fixes|http://librecat.org/Catmandu/#fixes> for a deeper
+understanding of how L<Catmandu|http://librecat.org/> works.
+
+=head1 DESCRIPTION
+
+L<Catmandu::Fix::marc_spec|Catmandu::Fix::marc_spec> is a fix for the
+famous L<Catmandu Framework|Catmandu>.
+
+For the most part it behaves like
+L<Catmandu::Fix::marc_map|Catmandu::Fix::marc_map> , but has a more fine
+grained method to reference MARC data content.
+
+See L<MARCspec - A common MARC record path language|http://marcspec.github.io/MARCspec/>
+for documentation on the path syntax.
+
+=head1 METHODS
+
+=head2 marc_spec(Str, Str, Str, ...)
+
+First parameter must be a string, following the syntax of
+L<MARCspec - A common MARC record path language|http://marcspec.github.io/MARCspec/>.
+Do always use single quotes with this first parameter.
+
+Second parameter is a string describing the variable or the variable path
+to assign referenced values to
+(see L<Catmandu Paths|http://librecat.org/Catmandu/#paths>).
+
+You may use one of $first, $last, $prepend or $append to add
+referenced data values to a specific position of an array
+(see L<Catmandu Wildcards|http://librecat.org/Catmandu/#wildcards>).
+
+ # INPUT
+ [245,1,0,"a","Cross-platform Perl /","c","Eric F. Johnson."]
+
+ # CALL
+ marc_spec('245', my.title.$append)
+
+ # OUTPUT
+ {
+ my {
+ title [
+ [0] "Cross-platform Perl /Eric F. Johnson."
+ ]
+ }
+
+ }
+
+Third and every other parameters are optional and must
+be in the form of key:value (see L</"OPTONS"> for a deeper
+understanding of options).
+
+=head1 OPTIONS
+
+=head2 split
+
+If split is set to 1, every fixed fields value or every subfield will be
+an array element.
+
+ # INPUT
+ [650," ",0,"a","Perl (Computer program language)"],
+ [650," ",0,"a","Web servers."]
+
+ # CALL
+ marc_spec('650', my.subjects, split:1)
+
+ # OUTPUT
+ {
+ my {
+ subjects [
+ [0] "Perl (Computer program language)",
+ [1] "Web servers."
+ ]
+ }
+ }
+
+
+=head2 join
+
+If set, value of join will be used to join the referenced data content.
+This will only have an effect if option split is undefined (not set or set to 0).
+
+ # INPUT
+ [650," ",0,"a","Perl (Computer program language)"],
+ [650," ",0,"a","Web servers."]
+
+ # CALL
+ marc_spec('650', my.subjects, join:'###')
+
+ # OUTPUT
+ {
+ my {
+ subjects "Perl (Computer program language)###Web servers."
+ }
+ }
+
+=head2 pluck
+
+This has only an effect on subfield values. By default subfield reference
+happens in 'natural' order (first number 0 to 9 and then letters a to z).
+
+ # INPUT
+ ["020"," ", " ","a","0491001304","q","black leather"]
+
+ # CALL
+ marc_spec('020$q$a', my.isbn, split:1)
+
+ # OUTPUT
+ {
+ my {
+ isbn [
+ [0] 0491001304,
+ [1] "black leather"
+ ]
+ }
+ }
+
+
+If pluck is set to 1, values will be referenced by the order stated in the
+MARCspec.
+
+ # INPUT
+ ["020"," ", " ","a","0491001304","q","black leather"]
+
+ # CALL
+ marc_spec('020$q$a', my.plucked.isbn, split:1, pluck:1)
+
+ # OUTPUT
+ {
+ my {
+ isbn [
+ [0] "black leather",
+ [1] 0491001304
+ ]
+ }
+ }
+
+=head2 value
+
+If set to a value, this value will be assigned to $var if MARCspec references
+data content (if the field or subfield exists).
+
+In case two or more subfields are referenced, the value will be assigned to $var if
+at least one of them exists:
+
+ # INPUT
+ ["020"," ", " ","a","0491001304"]
+
+ # CALL
+ marc_spec('020$a$q', my.isbn, value:'one subfield exists')
+
+ # OUTPUT
+ {
+ my {
+ isbn "one subfield exists"
+ }
+ }
+
+=head2 record
+
+The value of option record is used as a record key. Thus not the default record,
+but the other record will be processed.
+
+This option is useful if you created another (temporary) record and want to
+work on this record instead of the default record.
+
+ copy_field(record, record2)
+ # do some stuff with record2 an later
+ marc_spec('245$a', my.title.other, record:'record2')
+
+=head2 invert
+
+This has only an effect on subfields (values). If set to 1 it will invert the
+last pattern for every subfield. E.g.
+
+ # references all subfields but not subfield a and q
+ marc_spec('020$a$q' my.other.subfields, invert:1)
+
+ # references all subfields but not subfield a and not the last repetition
+ # of subfield q
+ marc_spec('020$a$q[#]' my.other.subfields, invert:1)
+
+ # references all but not the last two characters of first subfield a
+ marc_spec('020$a[0]/#-1' my.other.subfields, invert:1)
+
+=head1 BUGS AND LIMITATIONS
+
+This version of is agnostic of Subspecs as described in L<MARCspec - A common MARC record path language|http://marcspec.github.io/MARCspec/>.
+Later versions will include this feature.
+
+Please report any bugs to L<https://github.com/cKlee/Catmandu-Fix-marc_spec/issues>.
+
+=head1 AUTHOR
+
+Carsten Klee E<lt>klee at cpan.orgE<gt>
+
+=head1 CONTRIBUTORS
+
+=over
+
+=item * Johann Rolschewski, C<< <jorol at cpan> >>,
+
+=item * Patrick Hochstenbach, C<< <patrick.hochstenbach at ugent.be> >>,
+
+=item * Nicolas Steenlant, C<< <nicolas.steenlant at ugent.be> >>
+
+=back
+
+=head1 LICENSE AND COPYRIGHT
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+=over
+
+=item * L<MARCspec - A common MARC record path language|http://marcspec.github.io/MARCspec/>
+
+=item * L<Catmandu|http://librecat.org/>
+
+=item * L<Catmandu Importers|http://librecat.org/Catmandu/#importers>
+
+=item * L<Catmandu Importers|http://librecat.org/Catmandu/#importers>
+
+=item * L<Catmandu Fixes|http://librecat.org/Catmandu/#fixes>
+
+=item * L<Catmandu::MARC::Fix::marc_map|Catmandu::MARC::Fix::marc_map>
+
+=item * L<Catmandu Paths|http://librecat.org/Catmandu/#paths>
+
+=item * L<Catmandu Wildcards|http://librecat.org/Catmandu/#wildcards>
+
+=item * L<MARC::Spec|MARC::Spec>
+
+=item * L<Catmandu::Fix|Catmandu::Fix>
+
+=item * L<Catmandu::MARC|Catmandu::MARC>
+
+=back
+
+=cut
diff --git a/t/00-load.t b/t/00-load.t
index a940a03..e2388b3 100644
--- a/t/00-load.t
+++ b/t/00-load.t
@@ -13,8 +13,9 @@ BEGIN {
use_ok 'Catmandu::Fix::marc_set';
use_ok 'Catmandu::Fix::marc_remove';
use_ok 'Catmandu::Fix::marc_add';
+ use_ok 'Catmandu::Fix::marc_spec';
use_ok 'Catmandu::Fix::marc_decode_dollar_subfields';
use_ok 'Catmandu::Fix::Condition::marc_match';
}
-done_testing 10;
+done_testing 11;
diff --git a/t/21-marc-spec.t b/t/21-marc-spec.t
new file mode 100644
index 0000000..d9cd871
--- /dev/null
+++ b/t/21-marc-spec.t
@@ -0,0 +1,136 @@
+#!/usr/bin/perl
+use strict;
+use warnings qw(FATAL utf8);
+use utf8;
+use Test::More;
+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 $records = $fixer->fix($importer)->to_array;
+
+is $records->[0]->{my}{id}, 'fol05731351 ', 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
+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 $records->[9]->{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->[9]->{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},
+ ['Perl (Computer program language)Web servers.Cross-platform software development.'],
+ 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.'],
+ q|fix: marc_spec('650', my.split.subjects, split:1);|;
+
+is_deeply
+ $records->[9]->{my}{append}{split}{subjects},
+ [
+ [
+ "Perl (Computer program language)",
+ "Web servers.",
+ "Cross-platform software development."
+ ]
+ ],
+ q|fix: marc_spec('650', my.append.split.subjects.$append, split:1);|;
+
+is_deeply
+ $records->[9]->{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 $records->[9]->{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->[9]->{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->[9]->{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->[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_deeply
+ $records->[9]->{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->[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_deeply
+ $records->[9]->{my}{isbns}{all},
+ [
+ "0764547291 (alk. paper)",
+ "0491001304",
+ "test0491001304",
+ "black leather",
+ "blue pigskin",
+ "easel binding"
+ ],
+ q|fix: marc_spec('020$q$a', my.isbns.all, split:1);|;
+is_deeply
+ $records->[9]->{my}{isbns}{pluck}{all},
+ [
+ "0764547291 (alk. paper)",
+ "black leather",
+ "blue pigskin",
+ "easel binding",
+ "0491001304",
+ "test0491001304"
+ ],
+ q|fix: marc_spec('020$q$a', my.isbns.all, split:1, pluck:1);|;
+is_deeply
+ $records->[9]->{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},
+ [
+ "0764547291 (alk. paper)",
+ "0491001304",
+ "test0491001304",
+ "blue pigskin",
+ "easel binding"
+ ],
+ 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},
+ [
+ "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);|;
+
+done_testing;
diff --git a/t/marc_spec.fix b/t/marc_spec.fix
new file mode 100644
index 0000000..ca6b9c2
--- /dev/null
+++ b/t/marc_spec.fix
@@ -0,0 +1,59 @@
+marc_spec('001', my.id)
+
+marc_spec('000', my.no.field, value:'nofield')
+
+marc_spec('666', my.references.$append)
+
+marc_spec('245', my.title.all)
+
+marc_spec('245', my.title.default, value:'the title')
+
+marc_spec('650', my.subjects.all)
+
+marc_spec('650', my.subjects.joined, join:'###')
+
+marc_spec('650', my.append.subjects.$append)
+
+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('...__0', my.fields.indicators_0, split:1)
+
+marc_spec('LDR', my.ldr.all)
+
+marc_spec('LDR/0-3', my.firstcharpos.ldr)
+
+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/0-1', my.title.charpos)
+
+marc_spec('650[1]', my.second.subject)
+marc_spec('650[#]', my.last.subject)
+marc_spec('650[0-1]', my.two.split.subjects, split:1)
+marc_spec('650[#-1]', my.two.join.subjects, join:'###')
+
+marc_add('020', 'a', '0491001304', 'a', 'test0491001304', 'q', 'black leather', 'q', 'blue pigskin', 'q', 'easel binding')
+marc_spec('020$a', my.isbn.number)
+marc_spec('020$a[0]', my.isbn.numbers)
+marc_spec('020$q[0]', my.isbn.qual.first)
+marc_spec('020[0]$q[0]', my.isbn.qual.none)
+marc_spec('020$q[1]', my.isbn.qual.second)
+marc_spec('020$q[#]', my.isbn.qual.last)
+marc_spec('020$q$a', my.isbns.all, split:1)
+marc_spec('020$q$a', my.isbns.pluck.all, split:1, pluck:1)
+marc_spec('020$q[#]$a[1]', my.isbn.qual.other, split:1)
+marc_spec('020$q[#-1]$a[0-1]', my.isbn.qual.range, split:1)
+marc_spec('020$q[#]/0-4$a[1]/#-0', my.isbn.qual.substring.other, split:1)
+
+
+marc_spec('260[#]$b$a', my.level3.inverted, invert:1)
+marc_spec('020$a$q[#]', my.level2.inverted, invert:1)
+marc_spec('020[#]$a$q[#]/1-5', my.level1.inverted, invert:1)
+marc_spec('020[#]$a$q[0]/1-5$q[1]/1-5$q[2]/1-5', my.multi.level1.inverted, invert:1)
--
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