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