C4/MarcModificationTemplates.pm

   1 package C4::MarcModificationTemplates;
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright 2010 Kyle M Hall <kyle.m.hall@gmail.com>
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21
  22 use DateTime;
  23
  24 use C4::Context;
  25 use Koha::SimpleMARC qw(
  26     add_field
  27     copy_and_replace_field
  28     copy_field
  29     delete_field
  30     field_equals
  31     field_exists
  32     move_field
  33     update_field
  34 );
  35 use Koha::MoreUtils;
  36 use Koha::DateUtils qw( dt_from_string );
  37
  38 use vars qw(@ISA @EXPORT);
  39
  40 BEGIN {
  41     @ISA    = qw(Exporter);
  42     @EXPORT = qw(
  43       GetModificationTemplates
  44       AddModificationTemplate
  45       DelModificationTemplate
  46
  47       GetModificationTemplateAction
  48       GetModificationTemplateActions
  49
  50       AddModificationTemplateAction
  51       ModModificationTemplateAction
  52       DelModificationTemplateAction
  53       MoveModificationTemplateAction
  54
  55       ModifyRecordsWithTemplate
  56       ModifyRecordWithTemplate
  57     );
  58 }
  59
  60
  61 =head1 NAME
  62
  63 C4::MarcModificationTemplates - Module to manage MARC Modification Templates
  64
  65 =head1 DESCRIPTION
  66
  67 MARC Modification Templates are a tool for marc batch imports,
  68 so that librarians can set up templates for various vendors'
  69 files telling Koha what fields to insert data into.
  70
  71 =head1 FUNCTIONS
  72
  73 =cut
  74
  75 =head2 GetModificationTemplates
  76
  77   my @templates = GetModificationTemplates( $template_id );
  78
  79   Passing optional $template_id marks it as the selected template.
  80
  81 =cut
  82
  83 sub GetModificationTemplates {
  84   my ( $template_id ) = @_;
  85
  86   my $dbh = C4::Context->dbh;
  87   my $sth = $dbh->prepare("SELECT * FROM marc_modification_templates ORDER BY name");
  88   $sth->execute();
  89
  90   my @templates;
  91   while ( my $template = $sth->fetchrow_hashref() ) {
  92     $template->{'selected'} = 1
  93         if $template_id && $template->{'template_id'} eq $template_id;
  94     push( @templates, $template );
  95   }
  96
  97   return @templates;
  98 }
  99
 100 =head2
 101   AddModificationTemplate
 102
 103   $template_id = AddModificationTemplate( $template_name[, $template_id ] );
 104
 105   If $template_id is supplied, the actions from that template will be copied
 106   into the newly created template.
 107 =cut
 108
 109 sub AddModificationTemplate {
 110   my ( $template_name, $template_id_copy ) = @_;
 111
 112   my $dbh = C4::Context->dbh;
 113   my $sth = $dbh->prepare("INSERT INTO marc_modification_templates ( name ) VALUES ( ? )");
 114   $sth->execute( $template_name );
 115
 116   $sth = $dbh->prepare("SELECT * FROM marc_modification_templates WHERE name = ?");
 117   $sth->execute( $template_name );
 118   my $row = $sth->fetchrow_hashref();
 119   my $template_id = $row->{'template_id'};
 120
 121   if ( $template_id_copy ) {
 122     my @actions = GetModificationTemplateActions( $template_id_copy );
 123     foreach my $action ( @actions ) {
 124       AddModificationTemplateAction(
 125         $template_id,
 126         $action->{'action'},
 127         $action->{'field_number'},
 128         $action->{'from_field'},
 129         $action->{'from_subfield'},
 130         $action->{'field_value'},
 131         $action->{'to_field'},
 132         $action->{'to_subfield'},
 133         $action->{'to_regex_search'},
 134         $action->{'to_regex_replace'},
 135         $action->{'to_regex_modifiers'},
 136         $action->{'conditional'},
 137         $action->{'conditional_field'},
 138         $action->{'conditional_subfield'},
 139         $action->{'conditional_comparison'},
 140         $action->{'conditional_value'},
 141         $action->{'conditional_regex'},
 142         $action->{'description'},
 143       );
 144
 145     }
 146   }
 147
 148   return $template_id;
 149 }
 150
 151 =head2
 152   DelModificationTemplate
 153
 154   DelModificationTemplate( $template_id );
 155 =cut
 156
 157 sub DelModificationTemplate {
 158   my ( $template_id ) = @_;
 159
 160   my $dbh = C4::Context->dbh;
 161   my $sth = $dbh->prepare("DELETE FROM marc_modification_templates WHERE template_id = ?");
 162   $sth->execute( $template_id );
 163 }
 164
 165 =head2
 166   GetModificationTemplateAction
 167
 168   my $action = GetModificationTemplateAction( $mmta_id );
 169 =cut
 170
 171 sub GetModificationTemplateAction {
 172   my ( $mmta_id ) = @_;
 173
 174   my $dbh = C4::Context->dbh;
 175   my $sth = $dbh->prepare("SELECT * FROM marc_modification_template_actions WHERE mmta_id = ?");
 176   $sth->execute( $mmta_id );
 177   my $action = $sth->fetchrow_hashref();
 178
 179   return $action;
 180 }
 181
 182 =head2
 183   GetModificationTemplateActions
 184
 185   my @actions = GetModificationTemplateActions( $template_id );
 186 =cut
 187
 188 sub GetModificationTemplateActions {
 189   my ( $template_id ) = @_;
 190
 191   my $dbh = C4::Context->dbh;
 192   my $sth = $dbh->prepare("SELECT * FROM marc_modification_template_actions WHERE template_id = ? ORDER BY ordering");
 193   $sth->execute( $template_id );
 194
 195   my @actions;
 196   while ( my $action = $sth->fetchrow_hashref() ) {
 197     push( @actions, $action );
 198   }
 199
 200   return @actions;
 201 }
 202
 203 =head2
 204   AddModificationTemplateAction
 205
 206   AddModificationTemplateAction(
 207     $template_id, $action, $field_number,
 208     $from_field, $from_subfield, $field_value,
 209     $to_field, $to_subfield, $to_regex_search, $to_regex_replace, $to_regex_modifiers
 210     $conditional, $conditional_field, $conditional_subfield,
 211     $conditional_comparison, $conditional_value,
 212     $conditional_regex, $description
 213   );
 214
 215   Adds a new action to the given modification template.
 216
 217 =cut
 218
 219 sub AddModificationTemplateAction {
 220   my (
 221     $template_id,
 222     $action,
 223     $field_number,
 224     $from_field,
 225     $from_subfield,
 226     $field_value,
 227     $to_field,
 228     $to_subfield,
 229     $to_regex_search,
 230     $to_regex_replace,
 231     $to_regex_modifiers,
 232     $conditional,
 233     $conditional_field,
 234     $conditional_subfield,
 235     $conditional_comparison,
 236     $conditional_value,
 237     $conditional_regex,
 238     $description
 239   ) = @_;
 240
 241   $conditional ||= undef;
 242   $conditional_comparison ||= undef;
 243   $conditional_regex ||= '0';
 244
 245   my $dbh = C4::Context->dbh;
 246   my $sth = $dbh->prepare( 'SELECT MAX(ordering) + 1 AS next_ordering FROM marc_modification_template_actions WHERE template_id = ?' );
 247   $sth->execute( $template_id );
 248   my $row = $sth->fetchrow_hashref;
 249   my $ordering = $row->{'next_ordering'} || 1;
 250
 251   my $query = "
 252   INSERT INTO marc_modification_template_actions (
 253   mmta_id,
 254   template_id,
 255   ordering,
 256   action,
 257   field_number,
 258   from_field,
 259   from_subfield,
 260   field_value,
 261   to_field,
 262   to_subfield,
 263   to_regex_search,
 264   to_regex_replace,
 265   to_regex_modifiers,
 266   conditional,
 267   conditional_field,
 268   conditional_subfield,
 269   conditional_comparison,
 270   conditional_value,
 271   conditional_regex,
 272   description
 273   )
 274   VALUES ( NULL, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
 275
 276   $sth = $dbh->prepare( $query );
 277
 278   $sth->execute(
 279     $template_id,
 280     $ordering,
 281     $action,
 282     $field_number,
 283     $from_field,
 284     $from_subfield,
 285     $field_value,
 286     $to_field,
 287     $to_subfield,
 288     $to_regex_search,
 289     $to_regex_replace,
 290     $to_regex_modifiers,
 291     $conditional,
 292     $conditional_field,
 293     $conditional_subfield,
 294     $conditional_comparison,
 295     $conditional_value,
 296     $conditional_regex,
 297     $description
 298   );
 299 }
 300
 301 =head2
 302   ModModificationTemplateAction
 303
 304   ModModificationTemplateAction(
 305     $mmta_id, $action, $field_number, $from_field,
 306     $from_subfield, $field_value, $to_field,
 307     $to_subfield, $to_regex_search, $to_regex_replace, $to_regex_modifiers, $conditional,
 308     $conditional_field, $conditional_subfield,
 309     $conditional_comparison, $conditional_value,
 310     $conditional_regex, $description
 311   );
 312
 313   Modifies an existing action.
 314
 315 =cut
 316
 317 sub ModModificationTemplateAction {
 318   my (
 319     $mmta_id,
 320     $action,
 321     $field_number,
 322     $from_field,
 323     $from_subfield,
 324     $field_value,
 325     $to_field,
 326     $to_subfield,
 327     $to_regex_search,
 328     $to_regex_replace,
 329     $to_regex_modifiers,
 330     $conditional,
 331     $conditional_field,
 332     $conditional_subfield,
 333     $conditional_comparison,
 334     $conditional_value,
 335     $conditional_regex,
 336     $description
 337   ) = @_;
 338
 339   my $dbh = C4::Context->dbh;
 340   $conditional ||= undef;
 341   $conditional_comparison ||= undef;
 342   $conditional_regex ||= '0';
 343
 344   my $query = "
 345   UPDATE marc_modification_template_actions SET
 346   action = ?,
 347   field_number = ?,
 348   from_field = ?,
 349   from_subfield = ?,
 350   field_value = ?,
 351   to_field = ?,
 352   to_subfield = ?,
 353   to_regex_search = ?,
 354   to_regex_replace = ?,
 355   to_regex_modifiers = ?,
 356   conditional = ?,
 357   conditional_field = ?,
 358   conditional_subfield = ?,
 359   conditional_comparison = ?,
 360   conditional_value = ?,
 361   conditional_regex = ?,
 362   description = ?
 363   WHERE mmta_id = ?";
 364
 365   my $sth = $dbh->prepare( $query );
 366
 367   $sth->execute(
 368     $action,
 369     $field_number,
 370     $from_field,
 371     $from_subfield,
 372     $field_value,
 373     $to_field,
 374     $to_subfield,
 375     $to_regex_search,
 376     $to_regex_replace,
 377     $to_regex_modifiers,
 378     $conditional,
 379     $conditional_field,
 380     $conditional_subfield,
 381     $conditional_comparison,
 382     $conditional_value,
 383     $conditional_regex,
 384     $description,
 385     $mmta_id
 386   );
 387 }
 388
 389
 390 =head2
 391   DelModificationTemplateAction
 392
 393   DelModificationTemplateAction( $mmta_id );
 394
 395   Deletes the given template action.
 396 =cut
 397
 398 sub DelModificationTemplateAction {
 399   my ( $mmta_id ) = @_;
 400
 401   my $action = GetModificationTemplateAction( $mmta_id );
 402
 403   my $dbh = C4::Context->dbh;
 404   my $sth = $dbh->prepare("DELETE FROM marc_modification_template_actions WHERE mmta_id = ?");
 405   $sth->execute( $mmta_id );
 406
 407   $sth = $dbh->prepare("UPDATE marc_modification_template_actions SET ordering = ordering - 1 WHERE template_id = ? AND ordering > ?");
 408   $sth->execute( $action->{'template_id'}, $action->{'ordering'} );
 409 }
 410
 411 =head2
 412   MoveModificationTemplateAction
 413
 414   MoveModificationTemplateAction( $mmta_id, $where );
 415
 416   Changes the order for the given action.
 417   Options for $where are 'up', 'down', 'top' and 'bottom'
 418 =cut
 419 sub MoveModificationTemplateAction {
 420   my ( $mmta_id, $where ) = @_;
 421
 422   my $action = GetModificationTemplateAction( $mmta_id );
 423
 424   return if ( $action->{'ordering'} eq '1' && ( $where eq 'up' || $where eq 'top' ) );
 425   return if ( $action->{'ordering'} eq GetModificationTemplateActions( $action->{'template_id'} ) && ( $where eq 'down' || $where eq 'bottom' ) );
 426
 427   my $dbh = C4::Context->dbh;
 428   my ( $sth, $query );
 429
 430   if ( $where eq 'up' || $where eq 'down' ) {
 431
 432     ## For up and down, we just swap the ordering number with the one above or below it.
 433
 434     ## Change the ordering for the other action
 435     $query = "UPDATE marc_modification_template_actions SET ordering = ? WHERE template_id = ? AND ordering = ?";
 436
 437     my $ordering = $action->{'ordering'};
 438     $ordering-- if ( $where eq 'up' );
 439     $ordering++ if ( $where eq 'down' );
 440
 441     $sth = $dbh->prepare( $query );
 442     $sth->execute( $action->{'ordering'}, $action->{'template_id'}, $ordering );
 443
 444     ## Change the ordering for this action
 445     $query = "UPDATE marc_modification_template_actions SET ordering = ? WHERE mmta_id = ?";
 446     $sth = $dbh->prepare( $query );
 447     $sth->execute( $ordering, $action->{'mmta_id'} );
 448
 449   } elsif ( $where eq 'top' ) {
 450
 451     $sth = $dbh->prepare('UPDATE marc_modification_template_actions SET ordering = ordering + 1 WHERE template_id = ? AND ordering < ?');
 452     $sth->execute( $action->{'template_id'}, $action->{'ordering'} );
 453
 454     $sth = $dbh->prepare('UPDATE marc_modification_template_actions SET ordering = 1 WHERE mmta_id = ?');
 455     $sth->execute( $mmta_id );
 456
 457   } elsif ( $where eq 'bottom' ) {
 458
 459     my $ordering = GetModificationTemplateActions( $action->{'template_id'} );
 460
 461     $sth = $dbh->prepare('UPDATE marc_modification_template_actions SET ordering = ordering - 1 WHERE template_id = ? AND ordering > ?');
 462     $sth->execute( $action->{'template_id'}, $action->{'ordering'} );
 463
 464     $sth = $dbh->prepare('UPDATE marc_modification_template_actions SET ordering = ? WHERE mmta_id = ?');
 465     $sth->execute( $ordering, $mmta_id );
 466
 467   }
 468
 469 }
 470
 471 =head2
 472   ModifyRecordsWithTemplate
 473
 474   ModifyRecordsWithTemplate( $template_id, $batch );
 475
 476   Accepts a template id and a MARC::Batch object.
 477 =cut
 478
 479 sub ModifyRecordsWithTemplate {
 480   my ( $template_id, $batch ) = @_;
 481
 482   while ( my $record = $batch->next() ) {
 483     ModifyRecordWithTemplate( $template_id, $record );
 484   }
 485 }
 486
 487 =head2
 488   ModifyRecordWithTemplate
 489
 490   ModifyRecordWithTemplate( $template_id, $record )
 491
 492   Accepts a MARC::Record object ( $record ) and modifies
 493   it based on the actions for the given $template_id
 494 =cut
 495
 496 sub ModifyRecordWithTemplate {
 497     my ( $template_id, $record ) = @_;
 498
 499     my $current_date = dt_from_string()->ymd();
 500     my $branchcode = '';
 501     $branchcode = C4::Context->userenv->{branch} if C4::Context->userenv;
 502
 503     my @actions = GetModificationTemplateActions( $template_id );
 504
 505     foreach my $a ( @actions ) {
 506         my $action = $a->{'action'};
 507         my $field_number = $a->{'field_number'} // 1;
 508         my $from_field = $a->{'from_field'};
 509         my $from_subfield = $a->{'from_subfield'};
 510         my $field_value = $a->{'field_value'};
 511         my $to_field = $a->{'to_field'};
 512         my $to_subfield = $a->{'to_subfield'};
 513         my $to_regex_search = $a->{'to_regex_search'};
 514         my $to_regex_replace = $a->{'to_regex_replace'};
 515         my $to_regex_modifiers = $a->{'to_regex_modifiers'};
 516         my $conditional = $a->{'conditional'};
 517         my $conditional_field = $a->{'conditional_field'};
 518         my $conditional_subfield = $a->{'conditional_subfield'};
 519         my $conditional_comparison = $a->{'conditional_comparison'};
 520         my $conditional_value = $a->{'conditional_value'};
 521         my $conditional_regex = $a->{'conditional_regex'};
 522
 523         if ( $field_value ) {
 524             $field_value =~ s/__CURRENTDATE__/$current_date/g;
 525             $field_value =~ s/__BRANCHCODE__/$branchcode/g;
 526         }
 527
 528         my $do = 1;
 529         my $field_numbers = [];
 530         if ( $conditional ) {
 531             if ( $conditional_comparison eq 'exists' ) {
 532                 $field_numbers = field_exists({
 533                         record => $record,
 534                         field => $conditional_field,
 535                         subfield => $conditional_subfield,
 536                     });
 537                 $do = $conditional eq 'if'
 538                     ? @$field_numbers
 539                     : not @$field_numbers;
 540             }
 541             elsif ( $conditional_comparison eq 'not_exists' ) {
 542                 $field_numbers = field_exists({
 543                         record => $record,
 544                         field => $conditional_field,
 545                         subfield => $conditional_subfield
 546                     });
 547                 $do = $conditional eq 'if'
 548                     ? not @$field_numbers
 549                     : @$field_numbers;
 550             }
 551             elsif ( $conditional_comparison eq 'equals' ) {
 552                 $field_numbers = field_equals({
 553                     record => $record,
 554                     value => $conditional_value,
 555                     field => $conditional_field,
 556                     subfield => $conditional_subfield,
 557                     is_regex => $conditional_regex,
 558                 });
 559                 $do = $conditional eq 'if'
 560                     ? @$field_numbers
 561                     : not @$field_numbers;
 562             }
 563             elsif ( $conditional_comparison eq 'not_equals' ) {
 564                 $field_numbers = field_equals({
 565                     record => $record,
 566                     value => $conditional_value,
 567                     field => $conditional_field,
 568                     subfield => $conditional_subfield,
 569                     is_regex => $conditional_regex,
 570                 });
 571                 my $all_fields = [
 572                     1 .. scalar @{
 573                         field_exists(
 574                             {
 575                                 record   => $record,
 576                                 field    => $conditional_field,
 577                                 subfield => $conditional_subfield
 578                             }
 579                         )
 580                     }
 581                 ];
 582                 $field_numbers = [Koha::MoreUtils::singleton ( @$field_numbers, @$all_fields ) ];
 583                 if ( $from_field == $conditional_field ){
 584                     $do = $conditional eq 'if'
 585                         ? @$field_numbers
 586                         : not @$field_numbers;
 587                 } else {
 588                     $do = $conditional eq 'if'
 589                         ? not @$field_numbers
 590                         : @$field_numbers;
 591                 }
 592             }
 593         }
 594
 595         if ( $do ) {
 596
 597             # field_number == 0 if all field need to be updated
 598             # or 1 if only the first field need to be updated
 599
 600             # A condition has been given
 601             if ( @$field_numbers > 0 ) {
 602                 if ( $field_number == 1 ) {
 603                     # We want only the first
 604                     if ( $from_field == $conditional_field ){
 605                         # want first field matching condition
 606                         $field_numbers = [ $field_numbers->[0] ];
 607                     } else {
 608                         # condition doesn't match, so just want first occurrence of from field
 609                         $field_numbers = [ 1 ];
 610                     }
 611                 } else {
 612                     unless ( $from_field == $conditional_field ){
 613                         # condition doesn't match from fields so need all occurrences of from fields for action
 614                         $field_numbers = field_exists({
 615                             record => $record,
 616                             field => $from_field,
 617                             subfield => $from_subfield,
 618                         });
 619                     }
 620                 }
 621             }
 622             # There was no condition
 623             else {
 624                 if ( $field_number == 1 ) {
 625                     # We want to process the first field
 626                     $field_numbers = [ 1 ];
 627                 }
 628             }
 629
 630             if ( $action eq 'copy_field' ) {
 631                 copy_field({
 632                     record => $record,
 633                     from_field => $from_field,
 634                     from_subfield => $from_subfield,
 635                     to_field => $to_field,
 636                     to_subfield => $to_subfield,
 637                     regex => {
 638                         search => $to_regex_search,
 639                         replace => $to_regex_replace,
 640                         modifiers => $to_regex_modifiers
 641                     },
 642                     field_numbers => $field_numbers,
 643                 });
 644             }
 645             elsif ( $action eq 'copy_and_replace_field' ) {
 646                 copy_and_replace_field({
 647                     record => $record,
 648                     from_field => $from_field,
 649                     from_subfield => $from_subfield,
 650                     to_field => $to_field,
 651                     to_subfield => $to_subfield,
 652                     regex => {
 653                         search => $to_regex_search,
 654                         replace => $to_regex_replace,
 655                         modifiers => $to_regex_modifiers
 656                     },
 657                     field_numbers => $field_numbers,
 658                 });
 659             }
 660             elsif ( $action eq 'add_field' ) {
 661                 add_field({
 662                     record => $record,
 663                     field => $from_field,
 664                     subfield => $from_subfield,
 665                     values => [ $field_value ],
 666                     field_numbers => $field_numbers,
 667                 });
 668             }
 669             elsif ( $action eq 'update_field' ) {
 670                 update_field({
 671                     record => $record,
 672                     field => $from_field,
 673                     subfield => $from_subfield,
 674                     values => [ $field_value ],
 675                     field_numbers => $field_numbers,
 676                 });
 677             }
 678             elsif ( $action eq 'move_field' ) {
 679                 move_field({
 680                     record => $record,
 681                     from_field => $from_field,
 682                     from_subfield => $from_subfield,
 683                     to_field => $to_field,
 684                     to_subfield => $to_subfield,
 685                     regex => {
 686                         search => $to_regex_search,
 687                         replace => $to_regex_replace,
 688                         modifiers => $to_regex_modifiers
 689                     },
 690                     field_numbers => $field_numbers,
 691                 });
 692             }
 693             elsif ( $action eq 'delete_field' ) {
 694                 delete_field({
 695                     record => $record,
 696                     field => $from_field,
 697                     subfield => $from_subfield,
 698                     field_numbers => $field_numbers,
 699                 });
 700             }
 701         }
 702     }
 703
 704     return;
 705 }
 706 1;
 707 __END__
 708
 709 =head1 AUTHOR
 710
 711 Kyle M Hall
 712
 713 =cut