From c7d862bb7b98e854daa0bfd871f1e8f9f0f2eb39 Mon Sep 17 00:00:00 2001
From: Jonathan Druart <jonathan.druart@biblibre.com>
Date: Wed, 11 Dec 2013 15:39:49 +0100
Subject: [PATCH] Bug 11319: Add the field management for Koha::SimpleMARC

Currently the Koha::SimpleMARC module call a "field" a "subfield".
And the way to manage field is not implemented for all routines.

This patch does not modify the API. The routine's names are kept. It
just creates 2 privates routines for each action (e.g. delete_field
will call _delete_field if the action affects field and _delete_subfield
if the action affects subfields).

Before this patch the move action was authorised by the interface but
caused an error if executed.

Note: I don't see the meaning for the add/update action if no subfield
is given. So the call without subfield raises an error.

Test plan:
- apply all patches
- create or modify an existent template
- try at least the correct behavior for the following actions:
  * delete subfield and field
  * add new subfield to an existing field
  * add new subfield to an nonexisting field
  * move a subfield
  * move an entire field
  * copy a subfield
  * copy an entire field
- import a biblio and use this template
- verify the imported biblio matches actions defined.

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Tomas Cohen Arazi <tomascohen@gmail.com>
---
 Koha/SimpleMARC.pm | 485 +++++++++++++++++++++++++++++++++------------
 1 file changed, 356 insertions(+), 129 deletions(-)

diff --git a/Koha/SimpleMARC.pm b/Koha/SimpleMARC.pm
index f5728d1a38..f9adf400f0 100644
--- a/Koha/SimpleMARC.pm
+++ b/Koha/SimpleMARC.pm
@@ -73,111 +73,151 @@ at your option, any later version of Perl 5 you may have available.
 =cut
 
 sub copy_field {
-  my ( $params ) = @_;
-  my $record = $params->{record};
-  my $fromFieldName = $params->{from_field};
-  my $fromSubfieldName = $params->{from_subfield};
-  my $toFieldName = $params->{to_field};
-  my $toSubfieldName = $params->{to_subfield};
-  my $regex = $params->{regex};
-  my $n = $params->{n};
-  my $dont_erase = $params->{dont_erase};
-
-  if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
-
-  my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
-  @values = ( $values[$n-1] ) if ( $n );
-
-  if ( $regex and $regex->{search} ) {
-    $regex->{modifiers} //= q||;
-    my @available_modifiers = qw( i g );
-    my $modifiers = q||;
-    for my $modifier ( split //, $regex->{modifiers} ) {
-        $modifiers .= $modifier
-            if grep {/$modifier/} @available_modifiers;
-    }
-    foreach my $value (@values) {
-        if ( $modifiers =~ m/^(ig|gi)$/ ) {
-            $value =~ s/$regex->{search}/$regex->{replace}/ig;
-        }
-        elsif ( $modifiers eq 'i' ) {
-            $value =~ s/$regex->{search}/$regex->{replace}/i;
-        }
-        elsif ( $modifiers eq 'g' ) {
-            $value =~ s/$regex->{search}/$regex->{replace}/g;
-        }
-        else {
-            $value =~ s/$regex->{search}/$regex->{replace}/;
-        }
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fromFieldName = $params->{from_field};
+    my $fromSubfieldName = $params->{from_subfield};
+    my $toFieldName = $params->{to_field};
+    my $toSubfieldName = $params->{to_subfield};
+    my $regex = $params->{regex};
+    my $n = $params->{n};
+
+    if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
+
+
+    if ( not $fromSubfieldName or $fromSubfieldName eq ''
+      or not $toSubfieldName or $toSubfieldName eq ''
+    ) {
+        _copy_field({
+            record => $record,
+            from_field => $fromFieldName,
+            to_field => $toFieldName,
+            regex => $regex,
+            n => $n
+        });
+    } else {
+        _copy_subfield({
+            record => $record,
+            from_field => $fromFieldName,
+            from_subfield => $fromSubfieldName,
+            to_field => $toFieldName,
+            to_subfield => $toSubfieldName,
+            regex => $regex,
+            n => $n
+        });
     }
-  }
-  update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => $dont_erase, values => \@values });
-}
-
-=head2 update_field
 
-  update_field( $record, $fieldName, $subfieldName, $dont_erase, $value[, $value,[ $value ... ] ] );
-
-  Updates a field with the given value, creating it if neccessary.
-
-  If multiple values are supplied, they will be used to update a list of repeatable fields
-  until either the fields or the values are all used.
+}
 
-  If a single value is supplied for a repeated field, that value will be used to update
-  each of the repeated fields.
+sub _copy_field {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fromFieldName = $params->{from_field};
+    my $toFieldName = $params->{to_field};
+    my $regex = $params->{regex};
+    my $n = $params->{n};
+
+    _copy_move_field({
+        record => $record,
+        from_field => $fromFieldName,
+        to_field => $toFieldName,
+        regex => $regex,
+        n => $n
+    });
+}
 
-=cut
+sub _copy_subfield {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fromFieldName = $params->{from_field};
+    my $fromSubfieldName = $params->{from_subfield};
+    my $toFieldName = $params->{to_field};
+    my $toSubfieldName = $params->{to_subfield};
+    my $regex = $params->{regex};
+    my $n = $params->{n};
+
+    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
+    @values = ( $values[$n-1] ) if ( $n );
+    _modify_values({ values => \@values, regex => $regex });
+
+    update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values });
+}
 
 sub update_field {
-  my ( $params ) = @_;
-  my $record = $params->{record};
-  my $fieldName = $params->{field};
-  my $subfieldName = $params->{subfield};
-  my $dont_erase = $params->{dont_erase};
-  my @values = @{ $params->{values} };
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fieldName = $params->{field};
+    my $subfieldName = $params->{subfield};
+    my @values = @{ $params->{values} };
+
+    if ( ! ( $record && $fieldName ) ) { return; }
+
+    if ( not $subfieldName or $subfieldName eq '' ) {
+        # FIXME I'm not sure the actual implementation is correct.
+        die "This action is not implemented yet";
+        #_update_field({ record => $record, field => $fieldName, values => \@values });
+    } else {
+        _update_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, values => \@values });
+    }
+}
 
-  if ( ! ( $record && $fieldName ) ) { return; }
+sub _update_field {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fieldName = $params->{field};
+    my @values = @{ $params->{values} };
 
-  my $i = 0;
-  my $field;
-  if ( $subfieldName ) {
+    my $i = 0;
     if ( my @fields = $record->field( $fieldName ) ) {
-      unless ( $dont_erase ) {
         @values = ($values[0]) x scalar( @fields )
-          if @values == 1;
+            if @values == 1;
         foreach my $field ( @fields ) {
-          $field->update( "$subfieldName" => $values[$i++] );
+            $field->update( $values[$i++] );
         }
-      }
-      if ( $i <= scalar ( @values ) - 1 ) {
-        foreach my $field ( @fields ) {
-          foreach my $j ( $i .. scalar( @values ) - 1) {
-            $field->add_subfields( "$subfieldName" => $values[$j] );
-          }
-        }
-      }
     } else {
-      ## Field does not exist, create it.
-      foreach my $value ( @values ) {
-        $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
-        $record->append_fields( $field );
-      }
+        ## Field does not exists, create it
+        if ( $fieldName < 10 ) {
+            foreach my $value ( @values ) {
+                my $field = MARC::Field->new( $fieldName, $value );
+                $record->append_fields( $field );
+            }
+        } else {
+            warn "Invalid operation, trying to add a new field without subfield";
+        }
     }
-  } else { ## No subfield
+}
+
+sub _update_subfield {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fieldName = $params->{field};
+    my $subfieldName = $params->{subfield};
+    my @values = @{ $params->{values} };
+    my $dont_erase = $params->{dont_erase};
+    my $i = 0;
+
     if ( my @fields = $record->field( $fieldName ) ) {
-      @values = ($values[0]) x scalar( @fields )
-        if @values == 1;
-      foreach my $field ( @fields ) {
-        $field->update( $values[$i++] );
-      }
+        unless ( $dont_erase ) {
+            @values = ($values[0]) x scalar( @fields )
+                if @values == 1;
+            foreach my $field ( @fields ) {
+                $field->update( "$subfieldName" => $values[$i++] );
+            }
+        }
+        if ( $i <= scalar ( @values ) - 1 ) {
+            foreach my $field ( @fields ) {
+                foreach my $j ( $i .. scalar( @values ) - 1) {
+                    $field->add_subfields( "$subfieldName" => $values[$j] );
+                }
+            }
+        }
     } else {
-      ## Field does not exists, create it
-      foreach my $value ( @values ) {
-        $field = MARC::Field->new( $fieldName, $value );
-        $record->append_fields( $field );
-      }
+        ## Field does not exist, create it.
+        foreach my $value ( @values ) {
+            my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
+            $record->append_fields( $field );
+        }
     }
-  }
 }
 
 =head2 read_field
@@ -192,27 +232,70 @@ sub update_field {
 =cut
 
 sub read_field {
-  my ( $params ) = @_;
-  my $record = $params->{record};
-  my $fieldName = $params->{field};
-  my $subfieldName = $params->{subfield};
-  my $n = $params->{n};
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fieldName = $params->{field};
+    my $subfieldName = $params->{subfield};
+    my $n = $params->{n};
+
+    if ( not $subfieldName or $subfieldName eq '' ) {
+        _read_field({ record => $record, field => $fieldName, n => $n });
+    } else {
+        _read_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
+    }
+}
 
-  my @fields = $record->field( $fieldName );
+sub _read_field {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fieldName = $params->{field};
+    my $n = $params->{n};
 
-  return map { $_->data() } @fields unless $subfieldName;
+    my @fields = $record->field( $fieldName );
 
-  my @subfields;
-  foreach my $field ( @fields ) {
-    my @sf = $field->subfield( $subfieldName );
-    push( @subfields, @sf );
-  }
+    return unless @fields;
 
-  if ( $n ) {
-    return $subfields[$n-1];
-  } else {
-    return @subfields;
-  }
+    return map { $_->data() } @fields
+        if $fieldName < 10;
+
+    my @values;
+    if ( $n ) {
+        if ( $n <= scalar( @fields ) ) {
+            for my $sf ( $fields[$n - 1]->subfields ) {
+                push @values, $sf->[1];
+            }
+        }
+    } else {
+        foreach my $field ( @fields ) {
+            for my $sf ( $field->subfields ) {
+                push @values, $sf->[1];
+            }
+        }
+    }
+
+    return @values;
+}
+
+sub _read_subfield {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fieldName = $params->{field};
+    my $subfieldName = $params->{subfield};
+    my $n = $params->{n};
+
+    my @fields = $record->field( $fieldName );
+
+    return unless @fields;
+
+    my @values;
+    foreach my $field ( @fields ) {
+        my @sf = $field->subfield( $subfieldName );
+        push( @values, @sf );
+    }
+
+    return $n
+        ? $values[$n-1]
+        : @values;
 }
 
 =head2 field_exists
@@ -291,22 +374,83 @@ sub field_equals {
 =cut
 
 sub move_field {
-  my ( $params ) = @_;
-  my $record = $params->{record};
-  my $fromFieldName = $params->{from_field};
-  my $fromSubfieldName = $params->{from_subfield};
-  my $toFieldName = $params->{to_field};
-  my $toSubfieldName = $params->{to_subfield};
-  my $regex = $params->{regex};
-  my $n = $params->{n};
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fromFieldName = $params->{from_field};
+    my $fromSubfieldName = $params->{from_subfield};
+    my $toFieldName = $params->{to_field};
+    my $toSubfieldName = $params->{to_subfield};
+    my $regex = $params->{regex};
+    my $n = $params->{n};
+
+    if ( not $fromSubfieldName or $fromSubfieldName eq ''
+        or not $toSubfieldName or $toSubfieldName eq ''
+    ) {
+        _move_field({
+            record => $record,
+            from_field => $fromFieldName,
+            to_field => $toFieldName,
+            regex => $regex,
+            n => $n,
+        });
+    } else {
+        _move_subfield({
+            record => $record,
+            from_field => $fromFieldName,
+            from_subfield => $fromSubfieldName,
+            to_field => $toFieldName,
+            to_subfield => $toSubfieldName,
+            regex => $regex,
+            n => $n,
+        });
+    }
+}
 
-  copy_field({ record => $record, from_field => $fromFieldName, from_subfield => $fromSubfieldName, to_field => $toFieldName, to_subfield => $toSubfieldName, regex => $regex, n => $n , dont_erase => 1 });
-  delete_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName, n => $n });
+sub _move_field {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fromFieldName = $params->{from_field};
+    my $toFieldName = $params->{to_field};
+    my $regex = $params->{regex};
+    my $n = $params->{n};
+    _copy_move_field({
+        record => $record,
+        from_field => $fromFieldName,
+        to_field => $toFieldName,
+        regex => $regex,
+        n => $n,
+        action => 'move',
+    });
 }
 
-=head2 delete_field
+sub _move_subfield {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fromFieldName = $params->{from_field};
+    my $fromSubfieldName = $params->{from_subfield};
+    my $toFieldName = $params->{to_field};
+    my $toSubfieldName = $params->{to_subfield};
+    my $regex = $params->{regex};
+    my $n = $params->{n};
+
+    # Copy
+    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
+    @values = ( $values[$n-1] ) if $n;
+    _modify_values({ values => \@values, regex => $regex });
+    _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => 1, values => \@values });
+
+    # And delete
+    _delete_subfield({
+        record => $record,
+        field => $fromFieldName,
+        subfield => $fromSubfieldName,
+        n => $n,
+    });
+}
+
+=head2 _delete_field
 
-  delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
+  _delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
 
   Deletes the given field.
 
@@ -316,26 +460,109 @@ sub move_field {
 =cut
 
 sub delete_field {
-  my ( $params ) = @_;
-  my $record = $params->{record};
-  my $fieldName = $params->{field};
-  my $subfieldName = $params->{subfield};
-  my $n = $params->{n};
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fieldName = $params->{field};
+    my $subfieldName = $params->{subfield};
+    my $n = $params->{n};
+
+    if ( not $subfieldName or $subfieldName eq '' ) {
+        _delete_field({ record => $record, field => $fieldName, n => $n });
+    } else {
+        _delete_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
+    }
+}
 
-  my @fields = $record->field( $fieldName );
+sub _delete_field {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fieldName = $params->{field};
+    my $n = $params->{n};
 
-  @fields = ( $fields[$n-1] ) if ( $n );
+    my @fields = $record->field( $fieldName );
 
-  if ( @fields && !$subfieldName ) {
+    @fields = ( $fields[$n-1] ) if ( $n );
     foreach my $field ( @fields ) {
-      $record->delete_field( $field );
+        $record->delete_field( $field );
     }
-  } elsif ( @fields && $subfieldName ) {
+}
+
+sub _delete_subfield {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fieldName = $params->{field};
+    my $subfieldName = $params->{subfield};
+    my $n = $params->{n};
+
+    my @fields = $record->field( $fieldName );
+
+    @fields = ( $fields[$n-1] ) if ( $n );
+
     foreach my $field ( @fields ) {
-      $field->delete_subfield( code => $subfieldName );
+        $field->delete_subfield( code => $subfieldName );
     }
-  }
 }
 
+
+sub _copy_move_field {
+    my ( $params ) = @_;
+    my $record = $params->{record};
+    my $fromFieldName = $params->{from_field};
+    my $toFieldName = $params->{to_field};
+    my $regex = $params->{regex};
+    my $n = $params->{n};
+    my $action = $params->{action} || 'copy';
+
+    my @fields = $record->field( $fromFieldName );
+    if ( $n and $n <= scalar( @fields ) ) {
+        @fields = ( $fields[$n - 1] );
+    }
+
+    for my $field ( @fields ) {
+        my $new_field = $field->clone;
+        $new_field->{_tag} = $toFieldName; # Should be replaced by set_tag, introduced by MARC::Field 2.0.4
+        if ( $regex and $regex->{search} ) {
+            for my $subfield ( $new_field->subfields ) {
+                my $value = $subfield->[1];
+                ( $value ) = _modify_values({ values => [ $value ], regex => $regex });
+                $new_field->update( $subfield->[0], $value );
+            }
+        }
+        $record->append_fields( $new_field );
+        $record->delete_field( $field )
+            if $action eq 'move';
+    }
+}
+
+sub _modify_values {
+    my ( $params ) = @_;
+    my $values = $params->{values};
+    my $regex = $params->{regex};
+
+    if ( $regex and $regex->{search} ) {
+        $regex->{modifiers} //= q||;
+        my @available_modifiers = qw( i g );
+        my $modifiers = q||;
+        for my $modifier ( split //, $regex->{modifiers} ) {
+            $modifiers .= $modifier
+                if grep {/$modifier/} @available_modifiers;
+        }
+        foreach my $value ( @$values ) {
+            if ( $modifiers =~ m/^(ig|gi)$/ ) {
+                $value =~ s/$regex->{search}/$regex->{replace}/ig;
+            }
+            elsif ( $modifiers eq 'i' ) {
+                $value =~ s/$regex->{search}/$regex->{replace}/i;
+            }
+            elsif ( $modifiers eq 'g' ) {
+                $value =~ s/$regex->{search}/$regex->{replace}/g;
+            }
+            else {
+                $value =~ s/$regex->{search}/$regex->{replace}/;
+            }
+        }
+    }
+    return @$values;
+}
 1;
 __END__
-- 
2.39.5