C4/MarcModificationTemplates.pm

   1 package C4::MarcModificationTemplates;
   2
   3 # Copyright 2010 Kyle M Hall <kyle.m.hall@gmail.com>
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  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 strict;
  26 use warnings;
  27
  28 use DateTime;
  29
  30 use C4::Context;
  31 use Koha::SimpleMARC;
  32
  33 use vars qw($VERSION @ISA @EXPORT);
  34
  35 use constant DEBUG => 0;
  36
  37 BEGIN {
  38     $VERSION = 1.00;    # set the version for version checking
  39     @ISA = qw(Exporter);
  40     @EXPORT = qw(
  41         &GetModificationTemplates
  42         &AddModificationTemplate
  43         &DelModificationTemplate
  44
  45         &GetModificationTemplateAction
  46         &GetModificationTemplateActions
  47
  48         &AddModificationTemplateAction
  49         &ModModificationTemplateAction
  50         &DelModificationTemplateAction
  51         &MoveModificationTemplateAction
  52
  53         &ModifyRecordsWithTemplate
  54         &ModifyRecordWithTemplate
  55     );
  56 }
  57
  58
  59 =head1 NAME
  60
  61 C4::MarcModificationTemplates - Module to manage MARC Modification Templates
  62
  63 =head1 DESCRIPTION
  64
  65 MARC Modification Templates are a tool for marc batch imports,
  66 so that librarians can set up templates for various vendors'
  67 files telling Koha what fields to insert data into.
  68
  69 =head1 FUNCTIONS
  70
  71 =cut
  72
  73 =head2 GetModificationTemplates
  74
  75   my @templates = GetModificationTemplates( [ $template_id ] );
  76
  77   Passing a $template_id will mark the given id as the selected template.
  78 =cut
  79
  80 sub GetModificationTemplates {
  81   my ( $template_id ) = @_;
  82   C4::Koha::Log("C4::MarcModificationTemplates::GetModificationTemplates( $template_id )") if DEBUG;
  83   warn("C4::MarcModificationTemplates::GetModificationTemplates( $template_id )") if DEBUG;
  84
  85   my $dbh = C4::Context->dbh;
  86   my $sth = $dbh->prepare("SELECT * FROM marc_modification_templates");
  87   $sth->execute();
  88
  89   my @templates;
  90   while ( my $template = $sth->fetchrow_hashref() ) {
  91     $template->{'selected'} = 1 if ( $template->{'template_id'} eq $template_id );
  92     push( @templates, $template );
  93   }
  94
  95   return @templates;
  96 }
  97
  98 =head2
  99   AddModificationTemplate
 100
 101   $template_id = AddModificationTemplate( $template_name[, $template_id ] );
 102
 103   If $template_id is supplied, the actions from that template will be copied
 104   into the newly created template.
 105 =cut
 106
 107 sub AddModificationTemplate {
 108   my ( $template_name, $template_id_copy ) = @_;
 109
 110   my $dbh = C4::Context->dbh;
 111   my $sth = $dbh->prepare("INSERT INTO marc_modification_templates ( name ) VALUES ( ? )");
 112   $sth->execute( $template_name );
 113
 114   $sth = $dbh->prepare("SELECT * FROM marc_modification_templates WHERE name = ?");
 115   $sth->execute( $template_name );
 116   my $row = $sth->fetchrow_hashref();
 117   my $template_id = $row->{'template_id'};
 118
 119   if ( $template_id_copy ) {
 120     my @actions = GetModificationTemplateActions( $template_id_copy );
 121     foreach my $action ( @actions ) {
 122       AddModificationTemplateAction(
 123         $template_id,
 124         $action->{'action'},
 125         $action->{'field_number'},
 126         $action->{'from_field'},
 127         $action->{'from_subfield'},
 128         $action->{'field_value'},
 129         $action->{'to_field'},
 130         $action->{'to_subfield'},
 131         $action->{'to_regex'},
 132         $action->{'conditional'},
 133         $action->{'conditional_field'},
 134         $action->{'conditional_subfield'},
 135         $action->{'conditional_comparison'},
 136         $action->{'conditional_value'},
 137         $action->{'conditional_regex'},
 138         $action->{'description'},
 139       );
 140
 141     }
 142   }
 143
 144   return $template_id;
 145 }
 146
 147 =head2
 148   DelModificationTemplate
 149
 150   DelModificationTemplate( $template_id );
 151 =cut
 152
 153 sub DelModificationTemplate {
 154   my ( $template_id ) = @_;
 155
 156   my $dbh = C4::Context->dbh;
 157   my $sth = $dbh->prepare("DELETE FROM marc_modification_templates WHERE template_id = ?");
 158   $sth->execute( $template_id );
 159
 160   $sth = $dbh->prepare("DELETE FROM marc_modification_template_actions WHERE template_id = ?");
 161   $sth->execute( $template_id );
 162 }
 163
 164 =head2
 165   GetModificationTemplateAction
 166
 167   my $action = GetModificationTemplateAction( $mmta_id );
 168 =cut
 169
 170 sub GetModificationTemplateAction {
 171   my ( $mmta_id ) = @_;
 172
 173   my $dbh = C4::Context->dbh;
 174   my $sth = $dbh->prepare("SELECT * FROM marc_modification_template_actions WHERE mmta_id = ?");
 175   $sth->execute( $mmta_id );
 176   my $action = $sth->fetchrow_hashref();
 177
 178   return $action;
 179 }
 180
 181 =head2
 182   GetModificationTemplateActions
 183
 184   my @actions = GetModificationTemplateActions( $template_id );
 185 =cut
 186
 187 sub GetModificationTemplateActions {
 188   my ( $template_id ) = @_;
 189
 190   C4::Koha::Log( "C4::MarcModificationTemplates::GetModificationTemplateActions( $template_id )" ) if DEBUG;
 191   warn( "C4::MarcModificationTemplates::GetModificationTemplateActions( $template_id )" ) if DEBUG;
 192
 193   my $dbh = C4::Context->dbh;
 194   my $sth = $dbh->prepare("SELECT * FROM marc_modification_template_actions WHERE template_id = ? ORDER BY ordering");
 195   $sth->execute( $template_id );
 196
 197   my @actions;
 198   while ( my $action = $sth->fetchrow_hashref() ) {
 199     push( @actions, $action );
 200   }
 201
 202   C4::Koha::Log( Data::Dumper::Dumper( @actions ) ) if DEBUG > 4;
 203   warn( Data::Dumper::Dumper( @actions ) ) if DEBUG > 4;
 204
 205   return @actions;
 206 }
 207
 208 =head2
 209   AddModificationTemplateAction
 210
 211   AddModificationTemplateAction(
 212     $template_id, $action, $field_number,
 213     $from_field, $from_subfield, $field_value,
 214     $to_field, $to_subfield, $to_regex,
 215     $conditional, $conditional_field, $conditional_subfield,
 216     $conditional_comparison, $conditional_value,
 217     $conditional_regex, $description
 218   );
 219
 220   Adds a new action to the given modification template.
 221
 222 =cut
 223
 224 sub AddModificationTemplateAction {
 225   my (
 226     $template_id,
 227     $action,
 228     $field_number,
 229     $from_field,
 230     $from_subfield,
 231     $field_value,
 232     $to_field,
 233     $to_subfield,
 234     $to_regex,
 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, $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, $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,
 274   conditional,
 275   conditional_field,
 276   conditional_subfield,
 277   conditional_comparison,
 278   conditional_value,
 279   conditional_regex,
 280   description
 281   )
 282   VALUES ( NULL, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
 283
 284   $sth = $dbh->prepare( $query );
 285
 286   $sth->execute(
 287     $template_id,
 288     $ordering,
 289     $action,
 290     $field_number,
 291     $from_field,
 292     $from_subfield,
 293     $field_value,
 294     $to_field,
 295     $to_subfield,
 296     $to_regex,
 297     $conditional,
 298     $conditional_field,
 299     $conditional_subfield,
 300     $conditional_comparison,
 301     $conditional_value,
 302     $conditional_regex,
 303     $description
 304   );
 305 }
 306
 307 =head2
 308   ModModificationTemplateAction
 309
 310   ModModificationTemplateAction(
 311     $mmta_id, $action, $field_number, $from_field,
 312     $from_subfield, $field_value, $to_field,
 313     $to_subfield, $to_regex, $conditional,
 314     $conditional_field, $conditional_subfield,
 315     $conditional_comparison, $conditional_value,
 316     $conditional_regex, $description
 317   );
 318
 319   Modifies an existing action.
 320
 321 =cut
 322
 323 sub ModModificationTemplateAction {
 324   my (
 325     $mmta_id,
 326     $action,
 327     $field_number,
 328     $from_field,
 329     $from_subfield,
 330     $field_value,
 331     $to_field,
 332     $to_subfield,
 333     $to_regex,
 334     $conditional,
 335     $conditional_field,
 336     $conditional_subfield,
 337     $conditional_comparison,
 338     $conditional_value,
 339     $conditional_regex,
 340     $description
 341   ) = @_;
 342
 343   my $dbh = C4::Context->dbh;
 344
 345   my $query = "
 346   UPDATE marc_modification_template_actions SET
 347   action = ?,
 348   field_number = ?,
 349   from_field = ?,
 350   from_subfield = ?,
 351   field_value = ?,
 352   to_field = ?,
 353   to_subfield = ?,
 354   to_regex = ?,
 355   conditional = ?,
 356   conditional_field = ?,
 357   conditional_subfield = ?,
 358   conditional_comparison = ?,
 359   conditional_value = ?,
 360   conditional_regex = ?,
 361   description = ?
 362   WHERE mmta_id = ?";
 363
 364   my $sth = $dbh->prepare( $query );
 365
 366   $sth->execute(
 367     $action,
 368     $field_number,
 369     $from_field,
 370     $from_subfield,
 371     $field_value,
 372     $to_field,
 373     $to_subfield,
 374     $to_regex,
 375     $conditional,
 376     $conditional_field,
 377     $conditional_subfield,
 378     $conditional_comparison,
 379     $conditional_value,
 380     $conditional_regex,
 381     $description,
 382     $mmta_id
 383   );
 384 }
 385
 386
 387 =head2
 388   DelModificationTemplateAction
 389
 390   DelModificationTemplateAction( $mmta_id );
 391
 392   Deletes the given template action.
 393 =cut
 394
 395 sub DelModificationTemplateAction {
 396   my ( $mmta_id ) = @_;
 397
 398   my $action = GetModificationTemplateAction( $mmta_id );
 399
 400   my $dbh = C4::Context->dbh;
 401   my $sth = $dbh->prepare("DELETE FROM marc_modification_template_actions WHERE mmta_id = ?");
 402   $sth->execute( $mmta_id );
 403
 404   $sth = $dbh->prepare("UPDATE marc_modification_template_actions SET ordering = ordering - 1 WHERE template_id = ? AND ordering > ?");
 405   $sth->execute( $action->{'template_id'}, $action->{'ordering'} );
 406 }
 407
 408 =head2
 409   MoveModificationTemplateAction
 410
 411   MoveModificationTemplateAction( $mmta_id, $where );
 412
 413   Changes the order for the given action.
 414   Options for $where are 'up', 'down', 'top' and 'bottom'
 415 =cut
 416 sub MoveModificationTemplateAction {
 417   my ( $mmta_id, $where ) = @_;
 418
 419   my $action = GetModificationTemplateAction( $mmta_id );
 420
 421   return if ( $action->{'ordering'} eq '1' && ( $where eq 'up' || $where eq 'top' ) );
 422   return if ( $action->{'ordering'} eq GetModificationTemplateActions( $action->{'template_id'} ) && ( $where eq 'down' || $where eq 'bottom' ) );
 423
 424   my $dbh = C4::Context->dbh;
 425   my ( $sth, $query );
 426
 427   if ( $where eq 'up' || $where eq 'down' ) {
 428
 429     ## For up and down, we just swap the ordering number with the one above or below it.
 430
 431     ## Change the ordering for the other action
 432     $query = "UPDATE marc_modification_template_actions SET ordering = ? WHERE template_id = ? AND ordering = ?";
 433
 434     my $ordering = $action->{'ordering'};
 435     $ordering-- if ( $where eq 'up' );
 436     $ordering++ if ( $where eq 'down' );
 437
 438     $sth = $dbh->prepare( $query );
 439     $sth->execute( $action->{'ordering'}, $action->{'template_id'}, $ordering );
 440
 441     ## Change the ordering for this action
 442     $query = "UPDATE marc_modification_template_actions SET ordering = ? WHERE mmta_id = ?";
 443     $sth = $dbh->prepare( $query );
 444     $sth->execute( $ordering, $action->{'mmta_id'} );
 445
 446   } elsif ( $where eq 'top' ) {
 447
 448     $sth = $dbh->prepare('UPDATE marc_modification_template_actions SET ordering = ordering + 1 WHERE template_id = ? AND ordering < ?');
 449     $sth->execute( $action->{'template_id'}, $action->{'ordering'} );
 450
 451     $sth = $dbh->prepare('UPDATE marc_modification_template_actions SET ordering = 1 WHERE mmta_id = ?');
 452     $sth->execute( $mmta_id );
 453
 454   } elsif ( $where eq 'bottom' ) {
 455
 456     my $ordering = GetModificationTemplateActions( $action->{'template_id'} );
 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 = ? WHERE mmta_id = ?');
 462     $sth->execute( $ordering, $mmta_id );
 463
 464   }
 465
 466 }
 467
 468 =head2
 469   ModifyRecordsWithTemplate
 470
 471   ModifyRecordsWithTemplate( $template_id, $batch );
 472
 473   Accepts a template id and a MARC::Batch object.
 474 =cut
 475
 476 sub ModifyRecordsWithTemplate {
 477   my ( $template_id, $batch ) = @_;
 478   C4::Koha::Log( "C4::MarcModificationTemplates::ModifyRecordsWithTemplate( $template_id, $batch )" ) if DEBUG;
 479   warn( "C4::MarcModificationTemplates::ModifyRecordsWithTemplate( $template_id, $batch )" ) if DEBUG;
 480
 481   while ( my $record = $batch->next() ) {
 482     ModifyRecordWithTemplate( $template_id, $record );
 483   }
 484 }
 485
 486 =head2
 487   ModifyRecordWithTemplate
 488
 489   ModifyRecordWithTemplate( $template_id, $record )
 490
 491   Accepts a MARC::Record object ( $record ) and modifies
 492   it based on the actions for the given $template_id
 493 =cut
 494
 495 sub ModifyRecordWithTemplate {
 496   my ( $template_id, $record ) = @_;
 497   C4::Koha::Log( "C4::MarcModificationTemplates::ModifyRecordWithTemplate( $template_id, $record )" ) if DEBUG;
 498   warn( "C4::MarcModificationTemplates::ModifyRecordWithTemplate( $template_id, $record )" ) if DEBUG;
 499   C4::Koha::Log( "Unmodified Record:\n" . $record->as_formatted() ) if DEBUG >= 10;
 500   warn( "Unmodified Record:\n" . $record->as_formatted() ) if DEBUG >= 10;
 501
 502   my $current_date = DateTime->now()->ymd();
 503   my $branchcode = C4::Context->userenv->{branch};
 504
 505   my @actions = GetModificationTemplateActions( $template_id );
 506
 507   foreach my $a ( @actions ) {
 508     my $action = $a->{'action'};
 509     my $field_number = $a->{'field_number'};
 510     my $from_field = $a->{'from_field'};
 511     my $from_subfield = $a->{'from_subfield'};
 512     my $field_value = $a->{'field_value'};
 513     my $to_field = $a->{'to_field'};
 514     my $to_subfield = $a->{'to_subfield'};
 515     my $to_regex = $a->{'to_regex'};
 516     my $conditional = $a->{'conditional'};
 517     my $conditional_field = $a->{'conditional_field'};
 518     my $conditional_subfield = $a->{'conditional_subfield'};
 519     my $conditional_comparison = $a->{'conditional_comparison'};
 520     my $conditional_value = $a->{'conditional_value'};
 521     my $conditional_regex = $a->{'conditional_regex'};
 522
 523     my $eval = "$action( \$record, '$from_field', '$from_subfield', ";
 524
 525     if ( $field_value ) {
 526       C4::Koha::Log( "Field value before replacements: $field_value" ) if ( DEBUG >= 3 );
 527       warn( "Field value before replacements: $field_value" ) if ( DEBUG >= 3 );
 528
 529       $field_value =~ s/__CURRENTDATE__/$current_date/g;
 530       $field_value =~ s/__BRANCHCODE__/$branchcode/g;
 531
 532       $eval .= " undef, " if ( $action eq 'update_field' );
 533       $eval .= " '$field_value' ";
 534
 535       C4::Koha::Log( "Field value after replacements: $field_value" ) if ( DEBUG >= 3 );
 536       warn( "Field value after replacements: $field_value" ) if ( DEBUG >= 3 );
 537     } elsif ( $to_field ) {
 538       $eval .= " '$to_field', '$to_subfield', '$to_regex' ";
 539     }
 540
 541     $eval .= ", '$field_number' " if ( $field_number );
 542     $eval .= ') ';
 543
 544     if ( $conditional ) {
 545       $eval .= " $conditional ( ";
 546
 547       if ( $conditional_comparison eq 'exists' ) {
 548         $eval .= "field_exists( \$record, '$conditional_field', '$conditional_subfield' )";
 549
 550       } elsif ( $conditional_comparison eq 'not_exists' ) {
 551         $eval .= "!field_exists( \$record, '$conditional_field', '$conditional_subfield' )";
 552
 553       } elsif ( $conditional_comparison eq 'equals' ) {
 554         $eval .= "field_equals( \$record, '$conditional_value', '$conditional_field', '$conditional_subfield', '$conditional_regex' ) ";
 555
 556       } elsif ( $conditional_comparison eq 'not_equals' ) {
 557         $eval .= "!field_equals( \$record, '$conditional_value', '$conditional_field', '$conditional_subfield', '$conditional_regex' ) ";
 558       }
 559
 560       $eval .= " )";
 561     }
 562
 563     $eval .= ";";
 564
 565     C4::Koha::Log("eval $eval") if DEBUG >= 2;
 566     warn("eval $eval") if DEBUG >= 2;
 567     eval {$eval};
 568     C4::Koha::Log( $record->as_formatted() ) if DEBUG >= 10;
 569     warn( $record->as_formatted() ) if DEBUG >= 10;
 570
 571   }
 572 }
 573 1;
 574 __END__
 575
 576 =head1 AUTHOR
 577
 578 Kyle M Hall
 579
 580 =cut