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