Bug 10403: (follow-up) fix test to use vendor created earlier during test

[koha.git] / Koha / SimpleMARC.pm

diff --git a/Koha/SimpleMARC.pm b/Koha/SimpleMARC.pm
index 82abe00..2195143 100644 (file)
--- a/Koha/SimpleMARC.pm
+++ b/Koha/SimpleMARC.pm
@@ -2,8 +2,7 @@ package Koha::SimpleMARC;
 
 # Copyright 2009 Kyle M. Hall <kyle.m.hall@gmail.com>
 
-use strict;
-use warnings;
+use Modern::Perl;
 
 #use MARC::Record;
 
@@ -32,7 +31,7 @@ our $debug = 0;
 
 =head1 NAME
 
-SimpleMARC - Perl modle for making simple MARC record alterations.
+SimpleMARC - Perl module for making simple MARC record alterations.
 
 =head1 SYNOPSIS
 
@@ -60,13 +59,13 @@ at your option, any later version of Perl 5 you may have available.
 
 =head1 FUNCTIONS
 
-=head2
+=head2 copy_field
 
   copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex[, $n ] ] );
 
   Copies a value from one field to another. If a regular expression ( $regex ) is supplied,
   the value will be transformed by the given regex before being copied into the new field.
-  Example: $regex = 's/Old Text/Replacement Text/'
+  Example: $regex = { search => 'Old Text', replace => 'Replacement Text', modifiers => 'g' };
 
   If $n is passed, copy_field will only copy the Nth field of the list of fields.
   E.g. $n = 1 will only use the first field's value, $n = 2 will use only the 2nd field's value.
@@ -75,28 +74,43 @@ at your option, any later version of Perl 5 you may have available.
 
 sub copy_field {
   my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n, $dont_erase ) = @_;
-  C4::Koha::Log( "C4::SimpleMARC::copy_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
 
   if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
 
   my @values = read_field( $record, $fromFieldName, $fromSubfieldName );
   @values = ( $values[$n-1] ) if ( $n );
-  C4::Koha::Log( "@values = read_field( $record, $fromFieldName, $fromSubfieldName )" ) if $debug >= 3;
 
-  if ( $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 ) {
-      C4::Koha::Log( "\$value =~ s$regex" ) if ( $debug >= 3 );
-      eval "\$value =~ s$regex";
+        for ( $modifiers ) {
+          when ( /^(ig|gi)$/ ) {
+            $value =~ s/$regex->{search}/$regex->{replace}/ig;
+          }
+          when ( /^i$/ ) {
+            $value =~ s/$regex->{search}/$regex->{replace}/i;
+          }
+          when ( /^g$/ ) {
+            $value =~ s/$regex->{search}/$regex->{replace}/g;
+          }
+          default {
+            $value =~ s/$regex->{search}/$regex->{replace}/;
+          }
+      }
     }
   }
-
-  update_field( $record, $toFieldName, $toSubfieldName, @values, $dont_erase );
-
+  update_field( $record, $toFieldName, $toSubfieldName, $dont_erase, @values );
 }
 
-=head2
+=head2 update_field
 
-  update_field( $record, $fieldName, $subfieldName, $value[, $value,[ $value ... ] ] );
+  update_field( $record, $fieldName, $subfieldName, $dont_erase, $value[, $value,[ $value ... ] ] );
 
   Updates a field with the given value, creating it if neccessary.
 
@@ -109,26 +123,22 @@ sub copy_field {
 =cut
 
 sub update_field {
-  my ( $record, $fieldName, $subfieldName, @values, $dont_erase ) = @_;
-  C4::Koha::Log( "C4::SimpleMARC::update_field( $record, $fieldName, $subfieldName, @values )" ) if $debug;
+  my ( $record, $fieldName, $subfieldName, $dont_erase, @values ) = @_;
 
   if ( ! ( $record && $fieldName ) ) { return; }
 
-  if ( @values eq 1 ) {
-    _update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, @values );
-    return;
-  }
-
   my $i = 0;
   my $field;
   if ( $subfieldName ) {
     if ( my @fields = $record->field( $fieldName ) ) {
       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 ) {
+      if ( $i <= scalar ( @values ) - 1 ) {
         foreach my $field ( @fields ) {
           foreach my $j ( $i .. scalar( @values ) - 1) {
             $field->add_subfields( "$subfieldName" => $values[$j] );
@@ -144,6 +154,8 @@ sub update_field {
     }
   } else { ## No subfield
     if ( my @fields = $record->field( $fieldName ) ) {
+      @values = ($values[0]) x scalar( @fields )
+        if @values == 1;
       foreach my $field ( @fields ) {
         $field->update( $values[$i++] );
       }
@@ -157,7 +169,7 @@ sub update_field {
   }
 }
 
-=head2
+=head2 read_field
 
   my @values = read_field( $record, $fieldName[, $subfieldName, [, $n ] ] );
 
@@ -170,11 +182,10 @@ sub update_field {
 
 sub read_field {
   my ( $record, $fieldName, $subfieldName, $n ) = @_;
-  C4::Koha::Log( "C4::SimpleMARC::read_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
 
   my @fields = $record->field( $fieldName );
 
-  return @fields unless $subfieldName;
+  return map { $_->data() } @fields unless $subfieldName;
 
   my @subfields;
   foreach my $field ( @fields ) {
@@ -189,7 +200,7 @@ sub read_field {
   }
 }
 
-=head2
+=head2 field_exists
 
   $bool = field_exists( $record, $fieldName[, $subfieldName ]);
 
@@ -199,7 +210,6 @@ sub read_field {
 
 sub field_exists {
   my ( $record, $fieldName, $subfieldName ) = @_;
-  C4::Koha::Log( "C4::SimpleMARC::field_exists( $record, $fieldName, $subfieldName )" ) if $debug;
 
   if ( ! $record ) { return; }
 
@@ -210,18 +220,17 @@ sub field_exists {
     $return = $record->field( $fieldName ) && 1;
   }
 
-  C4::Koha::Log( "C4:SimpleMARC::field_exists: Returning '$return'" ) if $debug >= 2;
   return $return;
 }
 
-=head2
+=head2 field_equals
 
   $bool = field_equals( $record, $value, $fieldName[, $subfieldName[, $regex [, $n ] ] ]);
 
   Returns true if the field equals the given value, false otherwise.
 
   If a regular expression ( $regex ) is supplied, the value will be compared using
-  the given regex. Example: $regex = 'm/sought_text/'
+  the given regex. Example: $regex = 'sought_text'
 
   If $n is passed, the Nth field of a repeatable series will be used for comparison.
   Set $n to 1 or leave empty for a non-repeatable field.
@@ -231,7 +240,6 @@ sub field_exists {
 sub field_equals {
   my ( $record, $value, $fieldName, $subfieldName, $regex, $n ) = @_;
   $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
-  C4::Koha::Log( "C4::SimpleMARC::field_equals( '$record', '$value', '$fieldName', '$subfieldName', '$regex', '$n')" ) if $debug;
 
   if ( ! $record ) { return; }
 
@@ -239,14 +247,13 @@ sub field_equals {
   my $field_value = $field_values[$n-1];
 
   if ( $regex ) {
-    C4::Koha::Log( "Testing '$field_value' =~ m$value" ) if $debug >= 3;
-    return eval "\$field_value =~ m$value";
+    return $field_value =~ m/$value/;
   } else {
     return $field_value eq $value;
   }
 }
 
-=head2
+=head2 move_field
 
   move_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName[, $regex [, $n ] ] );
 
@@ -261,12 +268,11 @@ sub field_equals {
 
 sub move_field {
   my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
-  C4::Koha::Log( "C4::SimpleMARC::move_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
-  copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n , "don't_erase");
+  copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n , 'dont_erase' );
   delete_field( $record, $fromFieldName, $fromSubfieldName, $n );
 }
 
-=head2
+=head2 delete_field
 
   delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
 
@@ -279,7 +285,6 @@ sub move_field {
 
 sub delete_field {
   my ( $record, $fieldName, $subfieldName, $n ) = @_;
-  C4::Koha::Log( "C4::SimpleMARC::delete_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
 
   my @fields = $record->field( $fieldName );
 
@@ -296,45 +301,5 @@ sub delete_field {
   }
 }
 
-=head2
-
-  _update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value );
-
-  Updates a repeatable field, giving all existing copies of that field the given value.
-
-  This is an internal function, and thus is not exported.
-
-=cut
-
-sub _update_repeatable_field_with_single_value {
-  my ( $record, $fieldName, $subfieldName, $value ) = @_;
-  C4::Koha::Log( "C4::SimpleMARC::_update_repeatable_field_with_single_value( $record, $fieldName, $subfieldName, $value )" ) if $debug;
-
-  if ( ! ( $record && $fieldName ) ) { return; }
-
-  my $field;
-  if ( $subfieldName ) {
-    if ( my @fields = $record->field( $fieldName ) ) {
-      foreach my $field ( @fields ) {
-        $field->update( "$subfieldName" => $value );
-      }
-    } else {
-      ## Field does not exist, create it.
-      $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $value );
-      $record->append_fields( $field );
-    }
-  } else { ## No subfield
-    if ( my @fields = $record->field( $fieldName ) ) {
-      foreach my $field ( @fields ) {
-        $field->update( $value );
-      }
-    } else {
-      ## Field does not exists, create it
-      $field = MARC::Field->new( $fieldName, $value );
-      $record->append_fields( $field );
-    }
-  }
-}
-
 1;
 __END__