ffzg/recall_notices.pl: added --interval and --dedup
[koha.git] / C4 / MarcModificationTemplates.pm
index 2c8bbaf..da8f0a4 100644 (file)
@@ -1,58 +1,52 @@
 package C4::MarcModificationTemplates;
 
-# Copyright 2010 Kyle M Hall <kyle.m.hall@gmail.com>
-#
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Copyright 2010 Kyle M Hall <kyle.m.hall@gmail.com>
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# You should have received a copy of the GNU General Public License along
-# with Koha; if not, write to the Free Software Foundation, Inc.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-
-## NOTE:
-## Parts of this module are used from cgi scripts that are detached from apache before
-## execution. For this reason, the C4::Koha::Log function has been used to capture
-## output for debugging purposes.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
-use strict;
-use warnings;
+use Modern::Perl;
 
 use DateTime;
 
 use C4::Context;
 use Koha::SimpleMARC;
+use Koha::MoreUtils;
 
-use vars qw($VERSION @ISA @EXPORT);
+use vars qw(@ISA @EXPORT);
 
 use constant DEBUG => 0;
 
 BEGIN {
-       $VERSION = 1.00;        # set the version for version checking
-       @ISA = qw(Exporter);
-       @EXPORT = qw(
-               &GetModificationTemplates
-               &AddModificationTemplate
-               &DelModificationTemplate
-
-               &GetModificationTemplateAction
-               &GetModificationTemplateActions
-
-               &AddModificationTemplateAction
-               &ModModificationTemplateAction
-               &DelModificationTemplateAction
-               &MoveModificationTemplateAction
-
-                &ModifyRecordsWithTemplate
-               &ModifyRecordWithTemplate
-       );
+    @ISA = qw(Exporter);
+    @EXPORT = qw(
+        &GetModificationTemplates
+        &AddModificationTemplate
+        &DelModificationTemplate
+
+        &GetModificationTemplateAction
+        &GetModificationTemplateActions
+
+        &AddModificationTemplateAction
+        &ModModificationTemplateAction
+        &DelModificationTemplateAction
+        &MoveModificationTemplateAction
+
+        &ModifyRecordsWithTemplate
+        &ModifyRecordWithTemplate
+    );
 }
 
 
@@ -72,23 +66,24 @@ files telling Koha what fields to insert data into.
 
 =head2 GetModificationTemplates
 
-  my @templates = GetModificationTemplates( [ $template_id ] );
+  my @templates = GetModificationTemplates( $template_id );
+
+  Passing optional $template_id marks it as the selected template.
 
-  Passing a $template_id will mark the given id as the selected template.
 =cut
 
 sub GetModificationTemplates {
   my ( $template_id ) = @_;
-  C4::Koha::Log("C4::MarcModificationTemplates::GetModificationTemplates( $template_id )") if DEBUG;
   warn("C4::MarcModificationTemplates::GetModificationTemplates( $template_id )") if DEBUG;
 
   my $dbh = C4::Context->dbh;
-  my $sth = $dbh->prepare("SELECT * FROM marc_modification_templates");
+  my $sth = $dbh->prepare("SELECT * FROM marc_modification_templates ORDER BY name");
   $sth->execute();
 
   my @templates;
   while ( my $template = $sth->fetchrow_hashref() ) {
-    $template->{'selected'} = 1 if ( $template->{'template_id'} eq $template_id );
+    $template->{'selected'} = 1
+        if $template_id && $template->{'template_id'} eq $template_id;
     push( @templates, $template );
   }
 
@@ -128,7 +123,9 @@ sub AddModificationTemplate {
         $action->{'field_value'},
         $action->{'to_field'},
         $action->{'to_subfield'},
-        $action->{'to_regex'},
+        $action->{'to_regex_search'},
+        $action->{'to_regex_replace'},
+        $action->{'to_regex_modifiers'},
         $action->{'conditional'},
         $action->{'conditional_field'},
         $action->{'conditional_subfield'},
@@ -156,9 +153,6 @@ sub DelModificationTemplate {
   my $dbh = C4::Context->dbh;
   my $sth = $dbh->prepare("DELETE FROM marc_modification_templates WHERE template_id = ?");
   $sth->execute( $template_id );
-
-  $sth = $dbh->prepare("DELETE FROM marc_modification_template_actions WHERE template_id = ?");
-  $sth->execute( $template_id );
 }
 
 =head2
@@ -187,7 +181,6 @@ sub GetModificationTemplateAction {
 sub GetModificationTemplateActions {
   my ( $template_id ) = @_;
 
-  C4::Koha::Log( "C4::MarcModificationTemplates::GetModificationTemplateActions( $template_id )" ) if DEBUG;
   warn( "C4::MarcModificationTemplates::GetModificationTemplateActions( $template_id )" ) if DEBUG;
 
   my $dbh = C4::Context->dbh;
@@ -199,7 +192,6 @@ sub GetModificationTemplateActions {
     push( @actions, $action );
   }
 
-  C4::Koha::Log( Data::Dumper::Dumper( @actions ) ) if DEBUG > 4;
   warn( Data::Dumper::Dumper( @actions ) ) if DEBUG > 4;
 
   return @actions;
@@ -211,7 +203,7 @@ sub GetModificationTemplateActions {
   AddModificationTemplateAction(
     $template_id, $action, $field_number,
     $from_field, $from_subfield, $field_value,
-    $to_field, $to_subfield, $to_regex,
+    $to_field, $to_subfield, $to_regex_search, $to_regex_replace, $to_regex_modifiers
     $conditional, $conditional_field, $conditional_subfield,
     $conditional_comparison, $conditional_value,
     $conditional_regex, $description
@@ -231,7 +223,9 @@ sub AddModificationTemplateAction {
     $field_value,
     $to_field,
     $to_subfield,
-    $to_regex,
+    $to_regex_search,
+    $to_regex_replace,
+    $to_regex_modifiers,
     $conditional,
     $conditional_field,
     $conditional_subfield,
@@ -241,15 +235,13 @@ sub AddModificationTemplateAction {
     $description
   ) = @_;
 
-  C4::Koha::Log( "C4::MarcModificationTemplates::AddModificationTemplateAction( $template_id, $action,
-                    $field_number, $from_field, $from_subfield, $field_value, $to_field, $to_subfield,
-                    $to_regex, $conditional, $conditional_field, $conditional_subfield, $conditional_comparison,
-                    $conditional_value, $conditional_regex, $description )" ) if DEBUG;
   warn( "C4::MarcModificationTemplates::AddModificationTemplateAction( $template_id, $action,
                     $field_number, $from_field, $from_subfield, $field_value, $to_field, $to_subfield,
-                    $to_regex, $conditional, $conditional_field, $conditional_subfield, $conditional_comparison,
+                    $to_regex_search, $to_regex_replace, $to_regex_modifiers, $conditional, $conditional_field, $conditional_subfield, $conditional_comparison,
                     $conditional_value, $conditional_regex, $description )" ) if DEBUG;
 
+  $conditional ||= undef;
+  $conditional_comparison ||= undef;
   $conditional_regex ||= '0';
 
   my $dbh = C4::Context->dbh;
@@ -270,7 +262,9 @@ sub AddModificationTemplateAction {
   field_value,
   to_field,
   to_subfield,
-  to_regex,
+  to_regex_search,
+  to_regex_replace,
+  to_regex_modifiers,
   conditional,
   conditional_field,
   conditional_subfield,
@@ -279,7 +273,7 @@ sub AddModificationTemplateAction {
   conditional_regex,
   description
   )
-  VALUES ( NULL, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
+  VALUES ( NULL, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
 
   $sth = $dbh->prepare( $query );
 
@@ -293,7 +287,9 @@ sub AddModificationTemplateAction {
     $field_value,
     $to_field,
     $to_subfield,
-    $to_regex,
+    $to_regex_search,
+    $to_regex_replace,
+    $to_regex_modifiers,
     $conditional,
     $conditional_field,
     $conditional_subfield,
@@ -310,7 +306,7 @@ sub AddModificationTemplateAction {
   ModModificationTemplateAction(
     $mmta_id, $action, $field_number, $from_field,
     $from_subfield, $field_value, $to_field,
-    $to_subfield, $to_regex, $conditional,
+    $to_subfield, $to_regex_search, $to_regex_replace, $to_regex_modifiers, $conditional,
     $conditional_field, $conditional_subfield,
     $conditional_comparison, $conditional_value,
     $conditional_regex, $description
@@ -330,7 +326,9 @@ sub ModModificationTemplateAction {
     $field_value,
     $to_field,
     $to_subfield,
-    $to_regex,
+    $to_regex_search,
+    $to_regex_replace,
+    $to_regex_modifiers,
     $conditional,
     $conditional_field,
     $conditional_subfield,
@@ -341,6 +339,9 @@ sub ModModificationTemplateAction {
   ) = @_;
 
   my $dbh = C4::Context->dbh;
+  $conditional ||= undef;
+  $conditional_comparison ||= undef;
+  $conditional_regex ||= '0';
 
   my $query = "
   UPDATE marc_modification_template_actions SET
@@ -351,7 +352,9 @@ sub ModModificationTemplateAction {
   field_value = ?,
   to_field = ?,
   to_subfield = ?,
-  to_regex = ?,
+  to_regex_search = ?,
+  to_regex_replace = ?,
+  to_regex_modifiers = ?,
   conditional = ?,
   conditional_field = ?,
   conditional_subfield = ?,
@@ -371,7 +374,9 @@ sub ModModificationTemplateAction {
     $field_value,
     $to_field,
     $to_subfield,
-    $to_regex,
+    $to_regex_search,
+    $to_regex_replace,
+    $to_regex_modifiers,
     $conditional,
     $conditional_field,
     $conditional_subfield,
@@ -475,7 +480,6 @@ sub MoveModificationTemplateAction {
 
 sub ModifyRecordsWithTemplate {
   my ( $template_id, $batch ) = @_;
-  C4::Koha::Log( "C4::MarcModificationTemplates::ModifyRecordsWithTemplate( $template_id, $batch )" ) if DEBUG;
   warn( "C4::MarcModificationTemplates::ModifyRecordsWithTemplate( $template_id, $batch )" ) if DEBUG;
 
   while ( my $record = $batch->next() ) {
@@ -493,81 +497,200 @@ sub ModifyRecordsWithTemplate {
 =cut
 
 sub ModifyRecordWithTemplate {
-  my ( $template_id, $record ) = @_;
-  C4::Koha::Log( "C4::MarcModificationTemplates::ModifyRecordWithTemplate( $template_id, $record )" ) if DEBUG;
-  warn( "C4::MarcModificationTemplates::ModifyRecordWithTemplate( $template_id, $record )" ) if DEBUG;
-  C4::Koha::Log( "Unmodified Record:\n" . $record->as_formatted() ) if DEBUG >= 10;
-  warn( "Unmodified Record:\n" . $record->as_formatted() ) if DEBUG >= 10;
-
-  my $current_date = DateTime->now()->ymd();
-  my $branchcode = C4::Context->userenv->{branch};
-
-  my @actions = GetModificationTemplateActions( $template_id );
-
-  foreach my $a ( @actions ) {
-    my $action = $a->{'action'};
-    my $field_number = $a->{'field_number'};
-    my $from_field = $a->{'from_field'};
-    my $from_subfield = $a->{'from_subfield'};
-    my $field_value = $a->{'field_value'};
-    my $to_field = $a->{'to_field'};
-    my $to_subfield = $a->{'to_subfield'};
-    my $to_regex = $a->{'to_regex'};
-    my $conditional = $a->{'conditional'};
-    my $conditional_field = $a->{'conditional_field'};
-    my $conditional_subfield = $a->{'conditional_subfield'};
-    my $conditional_comparison = $a->{'conditional_comparison'};
-    my $conditional_value = $a->{'conditional_value'};
-    my $conditional_regex = $a->{'conditional_regex'};
-
-    my $eval = "$action( \$record, '$from_field', '$from_subfield', ";
-
-    if ( $field_value ) {
-      C4::Koha::Log( "Field value before replacements: $field_value" ) if ( DEBUG >= 3 );
-      warn( "Field value before replacements: $field_value" ) if ( DEBUG >= 3 );
-
-      $field_value =~ s/__CURRENTDATE__/$current_date/g;
-      $field_value =~ s/__BRANCHCODE__/$branchcode/g;
-
-      $eval .= " '$field_value' ";
-
-      C4::Koha::Log( "Field value after replacements: $field_value" ) if ( DEBUG >= 3 );
-      warn( "Field value after replacements: $field_value" ) if ( DEBUG >= 3 );
-    } elsif ( $to_field ) {
-      $eval .= " '$to_field', '$to_subfield', '$to_regex' ";
+    my ( $template_id, $record ) = @_;
+    warn( "C4::MarcModificationTemplates::ModifyRecordWithTemplate( $template_id, $record )" ) if DEBUG;
+    warn( "Unmodified Record:\n" . $record->as_formatted() ) if DEBUG >= 10;
+
+    my $current_date = DateTime->now()->ymd();
+    my $branchcode = '';
+    $branchcode = C4::Context->userenv->{branch} if C4::Context->userenv;
+
+    my @actions = GetModificationTemplateActions( $template_id );
+
+    foreach my $a ( @actions ) {
+        my $action = $a->{'action'};
+        my $field_number = $a->{'field_number'} // 1;
+        my $from_field = $a->{'from_field'};
+        my $from_subfield = $a->{'from_subfield'};
+        my $field_value = $a->{'field_value'};
+        my $to_field = $a->{'to_field'};
+        my $to_subfield = $a->{'to_subfield'};
+        my $to_regex_search = $a->{'to_regex_search'};
+        my $to_regex_replace = $a->{'to_regex_replace'};
+        my $to_regex_modifiers = $a->{'to_regex_modifiers'};
+        my $conditional = $a->{'conditional'};
+        my $conditional_field = $a->{'conditional_field'};
+        my $conditional_subfield = $a->{'conditional_subfield'};
+        my $conditional_comparison = $a->{'conditional_comparison'};
+        my $conditional_value = $a->{'conditional_value'};
+        my $conditional_regex = $a->{'conditional_regex'};
+
+        if ( $field_value ) {
+            $field_value =~ s/__CURRENTDATE__/$current_date/g;
+            $field_value =~ s/__BRANCHCODE__/$branchcode/g;
+        }
+
+        my $do = 1;
+        my $field_numbers = [];
+        if ( $conditional ) {
+            if ( $conditional_comparison eq 'exists' ) {
+                $field_numbers = field_exists({
+                        record => $record,
+                        field => $conditional_field,
+                        subfield => $conditional_subfield,
+                    });
+                $do = $conditional eq 'if'
+                    ? @$field_numbers
+                    : not @$field_numbers;
+            }
+            elsif ( $conditional_comparison eq 'not_exists' ) {
+                $field_numbers = field_exists({
+                        record => $record,
+                        field => $conditional_field,
+                        subfield => $conditional_subfield
+                    });
+                $do = $conditional eq 'if'
+                    ? not @$field_numbers
+                    : @$field_numbers;
+            }
+            elsif ( $conditional_comparison eq 'equals' ) {
+                $field_numbers = field_equals({
+                    record => $record,
+                    value => $conditional_value,
+                    field => $conditional_field,
+                    subfield => $conditional_subfield,
+                    is_regex => $conditional_regex,
+                });
+                $do = $conditional eq 'if'
+                    ? @$field_numbers
+                    : not @$field_numbers;
+            }
+            elsif ( $conditional_comparison eq 'not_equals' ) {
+                $field_numbers = field_equals({
+                    record => $record,
+                    value => $conditional_value,
+                    field => $conditional_field,
+                    subfield => $conditional_subfield,
+                    is_regex => $conditional_regex,
+                });
+                my $all_fields = [
+                    1 .. scalar @{
+                        field_exists(
+                            {
+                                record   => $record,
+                                field    => $conditional_field,
+                                subfield => $conditional_subfield
+                            }
+                        )
+                    }
+                ];
+                $field_numbers = [Koha::MoreUtils::singleton ( @$field_numbers, @$all_fields ) ];
+                $do = $conditional eq 'if'
+                    ? @$field_numbers
+                    : not @$field_numbers;
+            }
+        }
+
+        if ( $do ) {
+
+            # field_number == 0 if all field need to be updated
+            # or 1 if only the first field need to be updated
+
+            # A condition has been given
+            if ( @$field_numbers > 0 ) {
+                if ( $field_number == 1 ) {
+                    # We want only the first matching
+                    $field_numbers = [ $field_numbers->[0] ];
+                }
+            }
+            # There was no condition
+            else {
+                if ( $field_number == 1 ) {
+                    # We want to process the first field
+                    $field_numbers = [ 1 ];
+                } elsif ( $to_field and $from_field ne $to_field ) {
+                    # If the from and to fields are not the same, we only process the first field.
+                    $field_numbers = [ 1 ];
+                }
+            }
+
+            if ( $action eq 'copy_field' ) {
+                copy_field({
+                    record => $record,
+                    from_field => $from_field,
+                    from_subfield => $from_subfield,
+                    to_field => $to_field,
+                    to_subfield => $to_subfield,
+                    regex => {
+                        search => $to_regex_search,
+                        replace => $to_regex_replace,
+                        modifiers => $to_regex_modifiers
+                    },
+                    field_numbers => $field_numbers,
+                });
+            }
+            elsif ( $action eq 'copy_and_replace_field' ) {
+                copy_and_replace_field({
+                    record => $record,
+                    from_field => $from_field,
+                    from_subfield => $from_subfield,
+                    to_field => $to_field,
+                    to_subfield => $to_subfield,
+                    regex => {
+                        search => $to_regex_search,
+                        replace => $to_regex_replace,
+                        modifiers => $to_regex_modifiers
+                    },
+                    field_numbers => $field_numbers,
+                });
+            }
+            elsif ( $action eq 'add_field' ) {
+                add_field({
+                    record => $record,
+                    field => $from_field,
+                    subfield => $from_subfield,
+                    values => [ $field_value ],
+                    field_numbers => $field_numbers,
+                });
+            }
+            elsif ( $action eq 'update_field' ) {
+                update_field({
+                    record => $record,
+                    field => $from_field,
+                    subfield => $from_subfield,
+                    values => [ $field_value ],
+                    field_numbers => $field_numbers,
+                });
+            }
+            elsif ( $action eq 'move_field' ) {
+                move_field({
+                    record => $record,
+                    from_field => $from_field,
+                    from_subfield => $from_subfield,
+                    to_field => $to_field,
+                    to_subfield => $to_subfield,
+                    regex => {
+                        search => $to_regex_search,
+                        replace => $to_regex_replace,
+                        modifiers => $to_regex_modifiers
+                    },
+                    field_numbers => $field_numbers,
+                });
+            }
+            elsif ( $action eq 'delete_field' ) {
+                delete_field({
+                    record => $record,
+                    field => $from_field,
+                    subfield => $from_subfield,
+                    field_numbers => $field_numbers,
+                });
+            }
+        }
+
+        warn( $record->as_formatted() ) if DEBUG >= 10;
     }
 
-    $eval .= ", '$field_number' " if ( $field_number );
-    $eval .= ') ';
-
-    if ( $conditional ) {
-      $eval .= " $conditional ( ";
-
-      if ( $conditional_comparison eq 'exists' ) {
-        $eval .= "field_exists( \$record, '$conditional_field', '$conditional_subfield' )";
-
-      } elsif ( $conditional_comparison eq 'not_exists' ) {
-        $eval .= "!field_exists( \$record, '$conditional_field', '$conditional_subfield' )";
-
-      } elsif ( $conditional_comparison eq 'equals' ) {
-        $eval .= "field_equals( \$record, '$conditional_value', '$conditional_field', '$conditional_subfield', '$conditional_regex' ) ";
-
-      } elsif ( $conditional_comparison eq 'not_equals' ) {
-        $eval .= "!field_equals( \$record, '$conditional_value', '$conditional_field', '$conditional_subfield', '$conditional_regex' ) ";
-      }
-
-      $eval .= " )";
-    }
-
-    $eval .= ";";
-
-    C4::Koha::Log("eval $eval") if DEBUG >= 2;
-    warn("eval $eval") if DEBUG >= 2;
-    eval $eval;
-    C4::Koha::Log( $record->as_formatted() ) if DEBUG >= 10;
-    warn( $record->as_formatted() ) if DEBUG >= 10;
-
-  }
+    return;
 }
 1;
 __END__