Add Fix: pica_append (#82)

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)

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<Catmandu::Fix::pica_update> and L<Catmandu::Fix::pica_add> to add
+subfield values to existing fields and optionally add non-existing fields.
+
+=cut

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<Catmandu::Fix::pica_set> and L<Catmandu::Fix::pica_add> for
 setting/adding PICA (sub)fields to values from other record fields.
 
+See L<Catmandu::Fix::pica_append> to add a full field to a record.
+
 =cut

lib/Catmandu/PICA.pm

@@ -59,6 +59,8 @@ introduction into Catmandu.
 
 =item * L<Catmandu::Fix::pica_update> change/add PICA values to fixed strings
 
+=item * L<Catmandu::Fix::pica_append> parse and append full PICA fields
+
 =item * L<Catmandu::Fix::pica_set> set PICA values from other fields
 
 =item * L<Catmandu::Fix::pica_add> add PICA values from other fields

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'],

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;