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