diff --git a/Changes b/Changes index 0860f19..6e3b16f 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,7 @@ Changelog for Catmandu-PICA {{$NEXT}} + - Add Fix: pica_append (#82) 1.16 2023-08-11T07:06:23Z - Add Fix: pica_update (#82) diff --git a/lib/Catmandu/Fix/pica_append.pm b/lib/Catmandu/Fix/pica_append.pm new file mode 100644 index 0000000..f62da9e --- /dev/null +++ b/lib/Catmandu/Fix/pica_append.pm @@ -0,0 +1,62 @@ +package Catmandu::Fix::pica_append; + +use Catmandu::Sane; + +our $VERSION = '1.16'; + +use Moo; +use Catmandu::Fix::Has; +use PICA::Path; +use Scalar::Util 'reftype'; +use PICA::Data 'pica_parser'; + +with 'Catmandu::Fix::Inlineable'; + +has fields => ( + fix_arg => 1, + coerce => sub { + my $record = pica_parser( plain => \$_[0], strict => 1 )->next; + return $record ? $record->{record} : []; + } +); + +sub fix { + my ( $self, $data ) = @_; + + if ( $data->{record} ) { + return $data if reftype( $data->{record} ) ne 'ARRAY'; + } + else { + $data->{record} = []; + } + + push @{ $data->{record} }, @{ $self->fields }; + + return $data; +} + +1; +__END__ + +=head1 NAME + +Catmandu::Fix::pica_append - parse and append full PICA fields + +=head1 SYNOPSIS + + pica_append('021A $abook$hto read'); + +=head1 DESCRIPTION + +=head1 FUNCTIONS + +=head2 pica_append(PICA) + +Add one or more PICA+ fields given in PICA Plain syntax. + +=head1 SEE ALSO + +See L and L to add +subfield values to existing fields and optionally add non-existing fields. + +=cut diff --git a/lib/Catmandu/Fix/pica_update.pm b/lib/Catmandu/Fix/pica_update.pm index 3877fcb..9b84796 100644 --- a/lib/Catmandu/Fix/pica_update.pm +++ b/lib/Catmandu/Fix/pica_update.pm @@ -21,25 +21,21 @@ has value => ( fix_arg => 1 ); has all => ( fix_opt => 1, default => sub { 1 } ); has add => ( fix_opt => 1, default => sub { 0 } ); +sub pica_parse_subfields { + my ( $pp, $s, @sf ) = ( $_[0], $_[0] ); + while ( $s =~ s/^\$([A-Za-u0-9])([^\$]+|\$\$)+(.*)/$3/ ) { + push @sf, $1, $2; + } + die "invalid PICA field value: $pp\n" if $pp eq '' or $s ne ""; + return \@sf; +} + sub BUILD { my ($self) = @_; - my $path = $self->{path}; - my $value = $self->{value}; - # Update full field, given in PICA Plain syntax - if ( !$path->{subfield} ) { - my @sf; - my $value = $self->{value}; - while ( $value =~ s/^\$([A-Za-u0-9])([^\$]+|\$\$)+(.*)/$3/ ) { - push @sf, $1, $2; - } - - die "invalid PICA field value: $self->{value}\n" - if $self->{value} eq '' or $value ne ""; - - $self->{value} = \@sf; - } + $self->{value} = pica_parse_subfields( $self->{value} ) + unless $self->{path}{subfield}; } sub fix { @@ -140,4 +136,6 @@ Change or add value of PICA+ field(s) or subfields, specified by PICA Path expre See L and L for setting/adding PICA (sub)fields to values from other record fields. +See L to add a full field to a record. + =cut diff --git a/lib/Catmandu/PICA.pm b/lib/Catmandu/PICA.pm index 683f22b..e40e211 100644 --- a/lib/Catmandu/PICA.pm +++ b/lib/Catmandu/PICA.pm @@ -59,6 +59,8 @@ introduction into Catmandu. =item * L change/add PICA values to fixed strings +=item * L parse and append full PICA fields + =item * L set PICA values from other fields =item * L add PICA values from other fields diff --git a/t/09-pica-update.t b/t/09-pica-update.t index 1c6575b..0a3d1b3 100644 --- a/t/09-pica-update.t +++ b/t/09-pica-update.t @@ -3,7 +3,6 @@ use Test::More; use Test::Exception; use Catmandu::Fix::pica_update as => 'pica_update'; -use Catmandu::Importer::PICA; my $record = { record => [ ['021A', '', 'a', 'title'], diff --git a/t/11-pica-append.t b/t/11-pica-append.t new file mode 100644 index 0000000..e012184 --- /dev/null +++ b/t/11-pica-append.t @@ -0,0 +1,19 @@ +use v5.14; +use Test::More; +use Test::Exception; + +use Catmandu::Fix::pica_append as => 'pica_append'; + +my $record = {}; +pica_append($record, '012X $ab$cd'); +is_deeply $record->{record}, [ + ['012X', '', 'a', 'b', 'c', 'd'], +], 'append fields'; + +throws_ok { pica_append($record) } qr/Missing/; +throws_ok { pica_append($record, 'xy' ) } qr/invalid/; + +# FIXME: https://github.com/gbv/PICA-Data/issues/136 +#throws_ok { pica_append($record, '021A -$' ) } qr/invalid/; + +done_testing;