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