1 package Koha::MarcModificationTemplates;
3 # Copyright 2010 Kyle M Hall <kyle.m.hall@gmail.com>
5 # This file is part of Koha.
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
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.
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.
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.
33 use vars qw($VERSION @ISA @EXPORT);
35 use constant DEBUG => 0;
38 $VERSION = 1.00; # set the version for version checking
41 &GetModificationTemplates
42 &AddModificationTemplate
43 &DelModificationTemplate
45 &GetModificationTemplateAction
46 &GetModificationTemplateActions
48 &AddModificationTemplateAction
49 &ModModificationTemplateAction
50 &DelModificationTemplateAction
51 &MoveModificationTemplateAction
53 &ModifyRecordsWithTemplate
54 &ModifyRecordWithTemplate
61 Koha::MarcModificationTemplates - Module to manage MARC Modification Templates
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.
73 =head2 GetModificationTemplates
75 my @templates = GetModificationTemplates( [ $template_id ] );
77 Passing a $template_id will mark the given id as the selected template.
80 sub GetModificationTemplates {
81 my ( $template_id ) = @_;
82 C4::Koha::Log("Koha::MarcModificationTemplates::GetModificationTemplates( $template_id )") if DEBUG;
83 warn("Koha::MarcModificationTemplates::GetModificationTemplates( $template_id )") if DEBUG;
85 my $dbh = C4::Context->dbh;
86 my $sth = $dbh->prepare("SELECT * FROM marc_modification_templates");
90 while ( my $template = $sth->fetchrow_hashref() ) {
91 $template->{'selected'} = 1 if ( $template->{'template_id'} eq $template_id );
92 push( @templates, $template );
99 AddModificationTemplate
101 $template_id = AddModificationTemplate( $template_name[, $template_id ] );
103 If $template_id is supplied, the actions from that template will be copied
104 into the newly created template.
107 sub AddModificationTemplate {
108 my ( $template_name, $template_id_copy ) = @_;
110 my $dbh = C4::Context->dbh;
111 my $sth = $dbh->prepare("INSERT INTO marc_modification_templates ( name ) VALUES ( ? )");
112 $sth->execute( $template_name );
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'};
119 if ( $template_id_copy ) {
120 my @actions = GetModificationTemplateActions( $template_id_copy );
121 foreach my $action ( @actions ) {
122 AddModificationTemplateAction(
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'},
148 DelModificationTemplate
150 DelModificationTemplate( $template_id );
153 sub DelModificationTemplate {
154 my ( $template_id ) = @_;
156 my $dbh = C4::Context->dbh;
157 my $sth = $dbh->prepare("DELETE FROM marc_modification_templates WHERE template_id = ?");
158 $sth->execute( $template_id );
160 $sth = $dbh->prepare("DELETE FROM marc_modification_template_actions WHERE template_id = ?");
161 $sth->execute( $template_id );
165 GetModificationTemplateAction
167 my $action = GetModificationTemplateAction( $mmta_id );
170 sub GetModificationTemplateAction {
171 my ( $mmta_id ) = @_;
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();
182 GetModificationTemplateActions
184 my @actions = GetModificationTemplateActions( $template_id );
187 sub GetModificationTemplateActions {
188 my ( $template_id ) = @_;
190 C4::Koha::Log( "Koha::MarcModificationTemplates::GetModificationTemplateActions( $template_id )" ) if DEBUG;
191 warn( "Koha::MarcModificationTemplates::GetModificationTemplateActions( $template_id )" ) if DEBUG;
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 );
198 while ( my $action = $sth->fetchrow_hashref() ) {
199 push( @actions, $action );
202 C4::Koha::Log( Data::Dumper::Dumper( @actions ) ) if DEBUG > 4;
203 warn( Data::Dumper::Dumper( @actions ) ) if DEBUG > 4;
209 AddModificationTemplateAction
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
220 Adds a new action to the given modification template.
224 sub AddModificationTemplateAction {
237 $conditional_subfield,
238 $conditional_comparison,
244 C4::Koha::Log( "Koha::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( "Koha::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;
253 $conditional_regex ||= '0';
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;
262 INSERT INTO marc_modification_template_actions (
276 conditional_subfield,
277 conditional_comparison,
282 VALUES ( NULL, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )";
284 $sth = $dbh->prepare( $query );
299 $conditional_subfield,
300 $conditional_comparison,
308 ModModificationTemplateAction
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
319 Modifies an existing action.
323 sub ModModificationTemplateAction {
336 $conditional_subfield,
337 $conditional_comparison,
343 my $dbh = C4::Context->dbh;
346 UPDATE marc_modification_template_actions SET
356 conditional_field = ?,
357 conditional_subfield = ?,
358 conditional_comparison = ?,
359 conditional_value = ?,
360 conditional_regex = ?,
364 my $sth = $dbh->prepare( $query );
377 $conditional_subfield,
378 $conditional_comparison,
388 DelModificationTemplateAction
390 DelModificationTemplateAction( $mmta_id );
392 Deletes the given template action.
395 sub DelModificationTemplateAction {
396 my ( $mmta_id ) = @_;
398 my $action = GetModificationTemplateAction( $mmta_id );
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 );
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'} );
409 MoveModificationTemplateAction
411 MoveModificationTemplateAction( $mmta_id, $where );
413 Changes the order for the given action.
414 Options for $where are 'up', 'down', 'top' and 'bottom'
416 sub MoveModificationTemplateAction {
417 my ( $mmta_id, $where ) = @_;
419 my $action = GetModificationTemplateAction( $mmta_id );
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' ) );
424 my $dbh = C4::Context->dbh;
427 if ( $where eq 'up' || $where eq 'down' ) {
429 ## For up and down, we just swap the ordering number with the one above or below it.
431 ## Change the ordering for the other action
432 $query = "UPDATE marc_modification_template_actions SET ordering = ? WHERE template_id = ? AND ordering = ?";
434 my $ordering = $action->{'ordering'};
435 $ordering-- if ( $where eq 'up' );
436 $ordering++ if ( $where eq 'down' );
438 $sth = $dbh->prepare( $query );
439 $sth->execute( $action->{'ordering'}, $action->{'template_id'}, $ordering );
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'} );
446 } elsif ( $where eq 'top' ) {
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'} );
451 $sth = $dbh->prepare('UPDATE marc_modification_template_actions SET ordering = 1 WHERE mmta_id = ?');
452 $sth->execute( $mmta_id );
454 } elsif ( $where eq 'bottom' ) {
456 my $ordering = GetModificationTemplateActions( $action->{'template_id'} );
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'} );
461 $sth = $dbh->prepare('UPDATE marc_modification_template_actions SET ordering = ? WHERE mmta_id = ?');
462 $sth->execute( $ordering, $mmta_id );
469 ModifyRecordsWithTemplate
471 ModifyRecordsWithTemplate( $template_id, $batch );
473 Accepts a template id and a MARC::Batch object.
476 sub ModifyRecordsWithTemplate {
477 my ( $template_id, $batch ) = @_;
478 C4::Koha::Log( "Koha::MarcModificationTemplates::ModifyRecordsWithTemplate( $template_id, $batch )" ) if DEBUG;
479 warn( "Koha::MarcModificationTemplates::ModifyRecordsWithTemplate( $template_id, $batch )" ) if DEBUG;
481 while ( my $record = $batch->next() ) {
482 ModifyRecordWithTemplate( $template_id, $record );
487 ModifyRecordWithTemplate
489 ModifyRecordWithTemplate( $template_id, $record )
491 Accepts a MARC::Record object ( $record ) and modifies
492 it based on the actions for the given $template_id
495 sub ModifyRecordWithTemplate {
496 my ( $template_id, $record ) = @_;
497 C4::Koha::Log( "Koha::MarcModificationTemplates::ModifyRecordWithTemplate( $template_id, $record )" ) if DEBUG;
498 warn( "Koha::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;
502 my $current_date = DateTime->now()->ymd();
503 my $branchcode = C4::Context->userenv->{branch};
505 my @actions = GetModificationTemplateActions( $template_id );
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'};
523 my $eval = "$action( \$record, '$from_field', '$from_subfield', ";
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 );
529 $field_value =~ s/__CURRENTDATE__/$current_date/g;
530 $field_value =~ s/__BRANCHCODE__/$branchcode/g;
532 $eval .= " '$field_value' ";
534 C4::Koha::Log( "Field value after replacements: $field_value" ) if ( DEBUG >= 3 );
535 warn( "Field value after replacements: $field_value" ) if ( DEBUG >= 3 );
536 } elsif ( $to_field ) {
537 $eval .= " '$to_field', '$to_subfield', '$to_regex' ";
540 $eval .= ", '$field_number' " if ( $field_number );
543 if ( $conditional ) {
544 $eval .= " $conditional ( ";
546 if ( $conditional_comparison eq 'exists' ) {
547 $eval .= "field_exists( \$record, '$conditional_field', '$conditional_subfield' )";
549 } elsif ( $conditional_comparison eq 'not_exists' ) {
550 $eval .= "!field_exists( \$record, '$conditional_field', '$conditional_subfield' )";
552 } elsif ( $conditional_comparison eq 'equals' ) {
553 $eval .= "field_equals( \$record, '$conditional_value', '$conditional_field', '$conditional_subfield', '$conditional_regex' ) ";
555 } elsif ( $conditional_comparison eq 'not_equals' ) {
556 $eval .= "!field_equals( \$record, '$conditional_value', '$conditional_field', '$conditional_subfield', '$conditional_regex' ) ";
564 C4::Koha::Log("eval $eval") if DEBUG >= 2;
565 warn("eval $eval") if DEBUG >= 2;
567 C4::Koha::Log( $record->as_formatted() ) if DEBUG >= 10;
568 warn( $record->as_formatted() ) if DEBUG >= 10;