View | Details | Raw Unified | Return to bug 8015
Collapse All | Expand All

(-)a/C4/Koha.pm (-16 lines)
Lines 1488-1509 sub _isbn_cleanup { Link Here
1488
    return;
1488
    return;
1489
}
1489
}
1490
1490
1491
=head2 Log( $message );
1492
1493
  Writes data to /tmp/koha.log.
1494
1495
  This is useful for debugging forked processes
1496
  that do not write to the apache error log
1497
1498
=cut
1499
1500
sub Log {
1501
  my ($data) = @_;
1502
  warn $data;
1503
  open my $fh, '>>', '/tmp/koha.log';
1504
  print $fh "$data\n";
1505
  close $fh;
1506
}
1507
1;
1491
1;
1508
1492
1509
__END__
1493
__END__
(-)a/C4/MarcModificationTemplates.pm (-16 lines)
Lines 17-27 package C4::MarcModificationTemplates; Link Here
17
# You should have received a copy of the GNU General Public License
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>.
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
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;
20
use Modern::Perl;
26
21
27
use DateTime;
22
use DateTime;
Lines 78-84 files telling Koha what fields to insert data into. Link Here
78
73
79
sub GetModificationTemplates {
74
sub GetModificationTemplates {
80
  my ( $template_id ) = @_;
75
  my ( $template_id ) = @_;
81
  C4::Koha::Log("C4::MarcModificationTemplates::GetModificationTemplates( $template_id )") if DEBUG;
82
  warn("C4::MarcModificationTemplates::GetModificationTemplates( $template_id )") if DEBUG;
76
  warn("C4::MarcModificationTemplates::GetModificationTemplates( $template_id )") if DEBUG;
83
77
84
  my $dbh = C4::Context->dbh;
78
  my $dbh = C4::Context->dbh;
Lines 185-191 sub GetModificationTemplateAction { Link Here
185
sub GetModificationTemplateActions {
179
sub GetModificationTemplateActions {
186
  my ( $template_id ) = @_;
180
  my ( $template_id ) = @_;
187
181
188
  C4::Koha::Log( "C4::MarcModificationTemplates::GetModificationTemplateActions( $template_id )" ) if DEBUG;
189
  warn( "C4::MarcModificationTemplates::GetModificationTemplateActions( $template_id )" ) if DEBUG;
182
  warn( "C4::MarcModificationTemplates::GetModificationTemplateActions( $template_id )" ) if DEBUG;
190
183
191
  my $dbh = C4::Context->dbh;
184
  my $dbh = C4::Context->dbh;
Lines 197-203 sub GetModificationTemplateActions { Link Here
197
    push( @actions, $action );
190
    push( @actions, $action );
198
  }
191
  }
199
192
200
  C4::Koha::Log( Data::Dumper::Dumper( @actions ) ) if DEBUG > 4;
201
  warn( Data::Dumper::Dumper( @actions ) ) if DEBUG > 4;
193
  warn( Data::Dumper::Dumper( @actions ) ) if DEBUG > 4;
202
194
203
  return @actions;
195
  return @actions;
Lines 241-250 sub AddModificationTemplateAction { Link Here
241
    $description
233
    $description
242
  ) = @_;
234
  ) = @_;
243
235
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,
236
  warn( "C4::MarcModificationTemplates::AddModificationTemplateAction( $template_id, $action,
249
                    $field_number, $from_field, $from_subfield, $field_value, $to_field, $to_subfield,
237
                    $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,
238
                    $to_regex_search, $to_regex_replace, $to_regex_modifiers, $conditional, $conditional_field, $conditional_subfield, $conditional_comparison,
Lines 485-491 sub MoveModificationTemplateAction { Link Here
485
473
486
sub ModifyRecordsWithTemplate {
474
sub ModifyRecordsWithTemplate {
487
  my ( $template_id, $batch ) = @_;
475
  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;
476
  warn( "C4::MarcModificationTemplates::ModifyRecordsWithTemplate( $template_id, $batch )" ) if DEBUG;
490
477
491
  while ( my $record = $batch->next() ) {
478
  while ( my $record = $batch->next() ) {
Lines 504-512 sub ModifyRecordsWithTemplate { Link Here
504
491
505
sub ModifyRecordWithTemplate {
492
sub ModifyRecordWithTemplate {
506
    my ( $template_id, $record ) = @_;
493
    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;
494
    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;
495
    warn( "Unmodified Record:\n" . $record->as_formatted() ) if DEBUG >= 10;
511
496
512
    my $current_date = DateTime->now()->ymd();
497
    my $current_date = DateTime->now()->ymd();
Lines 607-613 sub ModifyRecordWithTemplate { Link Here
607
            }
592
            }
608
        }
593
        }
609
594
610
        C4::Koha::Log( $record->as_formatted() ) if DEBUG >= 10;
611
        warn( $record->as_formatted() ) if DEBUG >= 10;
595
        warn( $record->as_formatted() ) if DEBUG >= 10;
612
    }
596
    }
613
}
597
}
(-)a/Koha/SimpleMARC.pm (-13 / +1 lines)
Lines 31-37 our $debug = 0; Link Here
31
31
32
=head1 NAME
32
=head1 NAME
33
33
34
SimpleMARC - Perl modle for making simple MARC record alterations.
34
SimpleMARC - Perl module for making simple MARC record alterations.
35
35
36
=head1 SYNOPSIS
36
=head1 SYNOPSIS
37
37
Lines 74-86 at your option, any later version of Perl 5 you may have available. Link Here
74
74
75
sub copy_field {
75
sub copy_field {
76
  my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n, $dont_erase ) = @_;
76
  my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n, $dont_erase ) = @_;
77
  C4::Koha::Log( "C4::SimpleMARC::copy_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
78
77
79
  if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
78
  if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
80
79
81
  my @values = read_field( $record, $fromFieldName, $fromSubfieldName );
80
  my @values = read_field( $record, $fromFieldName, $fromSubfieldName );
82
  @values = ( $values[$n-1] ) if ( $n );
81
  @values = ( $values[$n-1] ) if ( $n );
83
  C4::Koha::Log( "@values = read_field( $record, $fromFieldName, $fromSubfieldName )" ) if $debug >= 3;
84
82
85
  if ( $regex and $regex->{search} ) {
83
  if ( $regex and $regex->{search} ) {
86
    $regex->{modifiers} //= q||;
84
    $regex->{modifiers} //= q||;
Lines 91-97 sub copy_field { Link Here
91
            if grep {/$modifier/} @available_modifiers;
89
            if grep {/$modifier/} @available_modifiers;
92
    }
90
    }
93
    foreach my $value ( @values ) {
91
    foreach my $value ( @values ) {
94
      C4::Koha::Log( "\$value =~ s/$regex->{search}/$regex->{replace}/$modifiers" ) if ( $debug >= 3 );
95
        for ( $modifiers ) {
92
        for ( $modifiers ) {
96
          when ( /^(ig|gi)$/ ) {
93
          when ( /^(ig|gi)$/ ) {
97
            $value =~ s/$regex->{search}/$regex->{replace}/ig;
94
            $value =~ s/$regex->{search}/$regex->{replace}/ig;
Lines 127-133 sub copy_field { Link Here
127
124
128
sub update_field {
125
sub update_field {
129
  my ( $record, $fieldName, $subfieldName, $dont_erase, @values ) = @_;
126
  my ( $record, $fieldName, $subfieldName, $dont_erase, @values ) = @_;
130
  C4::Koha::Log( "C4::SimpleMARC::update_field( $record, $fieldName, $subfieldName, $dont_erase, @values )" ) if $debug;
131
127
132
  if ( ! ( $record && $fieldName ) ) { return; }
128
  if ( ! ( $record && $fieldName ) ) { return; }
133
129
Lines 186-192 sub update_field { Link Here
186
182
187
sub read_field {
183
sub read_field {
188
  my ( $record, $fieldName, $subfieldName, $n ) = @_;
184
  my ( $record, $fieldName, $subfieldName, $n ) = @_;
189
  C4::Koha::Log( "C4::SimpleMARC::read_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
190
185
191
  my @fields = $record->field( $fieldName );
186
  my @fields = $record->field( $fieldName );
192
187
Lines 215-221 sub read_field { Link Here
215
210
216
sub field_exists {
211
sub field_exists {
217
  my ( $record, $fieldName, $subfieldName ) = @_;
212
  my ( $record, $fieldName, $subfieldName ) = @_;
218
  C4::Koha::Log( "C4::SimpleMARC::field_exists( $record, $fieldName, $subfieldName )" ) if $debug;
219
213
220
  if ( ! $record ) { return; }
214
  if ( ! $record ) { return; }
221
215
Lines 226-232 sub field_exists { Link Here
226
    $return = $record->field( $fieldName ) && 1;
220
    $return = $record->field( $fieldName ) && 1;
227
  }
221
  }
228
222
229
  C4::Koha::Log( "C4:SimpleMARC::field_exists: Returning '$return'" ) if $debug >= 2;
230
  return $return;
223
  return $return;
231
}
224
}
232
225
Lines 247-253 sub field_exists { Link Here
247
sub field_equals {
240
sub field_equals {
248
  my ( $record, $value, $fieldName, $subfieldName, $regex, $n ) = @_;
241
  my ( $record, $value, $fieldName, $subfieldName, $regex, $n ) = @_;
249
  $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
242
  $n = 1 unless ( $n ); ## $n defaults to first field of a repeatable field series
250
  C4::Koha::Log( "C4::SimpleMARC::field_equals( '$record', '$value', '$fieldName', '$subfieldName', '$regex', '$n')" ) if $debug;
251
243
252
  if ( ! $record ) { return; }
244
  if ( ! $record ) { return; }
253
245
Lines 255-261 sub field_equals { Link Here
255
  my $field_value = $field_values[$n-1];
247
  my $field_value = $field_values[$n-1];
256
248
257
  if ( $regex ) {
249
  if ( $regex ) {
258
    C4::Koha::Log( "Testing '$field_value' =~ m/$value/" ) if $debug >= 3;
259
    return $field_value =~ m/$value/;
250
    return $field_value =~ m/$value/;
260
  } else {
251
  } else {
261
    return $field_value eq $value;
252
    return $field_value eq $value;
Lines 277-283 sub field_equals { Link Here
277
268
278
sub move_field {
269
sub move_field {
279
  my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
270
  my ( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n ) = @_;
280
  C4::Koha::Log( "C4::SimpleMARC::move_field( '$record', '$fromFieldName', '$fromSubfieldName', '$toFieldName', '$toSubfieldName', '$regex', '$n' )" ) if $debug;
281
  copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n , 'dont_erase' );
271
  copy_field( $record, $fromFieldName, $fromSubfieldName, $toFieldName, $toSubfieldName, $regex, $n , 'dont_erase' );
282
  delete_field( $record, $fromFieldName, $fromSubfieldName, $n );
272
  delete_field( $record, $fromFieldName, $fromSubfieldName, $n );
283
}
273
}
Lines 295-301 sub move_field { Link Here
295
285
296
sub delete_field {
286
sub delete_field {
297
  my ( $record, $fieldName, $subfieldName, $n ) = @_;
287
  my ( $record, $fieldName, $subfieldName, $n ) = @_;
298
  C4::Koha::Log( "C4::SimpleMARC::delete_field( '$record', '$fieldName', '$subfieldName', '$n' )" ) if $debug;
299
288
300
  my @fields = $record->field( $fieldName );
289
  my @fields = $record->field( $fieldName );
301
290
302
- 

Return to bug 8015