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