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

(-)a/Koha/SimpleMARC.pm (-132 / +358 lines)
Lines 73-185 at your option, any later version of Perl 5 you may have available. Link Here
73
=cut
73
=cut
74
74
75
sub copy_field {
75
sub copy_field {
76
  my ( $params ) = @_;
76
    my ( $params ) = @_;
77
  my $record = $params->{record};
77
    my $record = $params->{record};
78
  my $fromFieldName = $params->{from_field};
78
    my $fromFieldName = $params->{from_field};
79
  my $fromSubfieldName = $params->{from_subfield};
79
    my $fromSubfieldName = $params->{from_subfield};
80
  my $toFieldName = $params->{to_field};
80
    my $toFieldName = $params->{to_field};
81
  my $toSubfieldName = $params->{to_subfield};
81
    my $toSubfieldName = $params->{to_subfield};
82
  my $regex = $params->{regex};
82
    my $regex = $params->{regex};
83
  my $n = $params->{n};
83
    my $n = $params->{n};
84
  my $dont_erase = $params->{dont_erase};
84
85
85
    if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
86
  if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
86
87
87
88
  my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
88
    if ( not $fromSubfieldName or $fromSubfieldName eq ''
89
  @values = ( $values[$n-1] ) if ( $n );
89
      or not $toSubfieldName or $toSubfieldName eq ''
90
90
    ) {
91
  if ( $regex and $regex->{search} ) {
91
        _copy_field({
92
    $regex->{modifiers} //= q||;
92
            record => $record,
93
    my @available_modifiers = qw( i g );
93
            from_field => $fromFieldName,
94
    my $modifiers = q||;
94
            to_field => $toFieldName,
95
    for my $modifier ( split //, $regex->{modifiers} ) {
95
            regex => $regex,
96
        $modifiers .= $modifier
96
            n => $n
97
            if grep {/$modifier/} @available_modifiers;
97
        });
98
    }
98
    } else {
99
    foreach my $value ( @values ) {
99
        _copy_subfield({
100
        for ( $modifiers ) {
100
            record => $record,
101
          when ( /^(ig|gi)$/ ) {
101
            from_field => $fromFieldName,
102
            $value =~ s/$regex->{search}/$regex->{replace}/ig;
102
            from_subfield => $fromSubfieldName,
103
          }
103
            to_field => $toFieldName,
104
          when ( /^i$/ ) {
104
            to_subfield => $toSubfieldName,
105
            $value =~ s/$regex->{search}/$regex->{replace}/i;
105
            regex => $regex,
106
          }
106
            n => $n
107
          when ( /^g$/ ) {
107
        });
108
            $value =~ s/$regex->{search}/$regex->{replace}/g;
109
          }
110
          default {
111
            $value =~ s/$regex->{search}/$regex->{replace}/;
112
          }
113
      }
114
    }
108
    }
115
  }
116
  update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => $dont_erase, values => \@values });
117
}
118
119
=head2 update_field
120
109
121
  update_field( $record, $fieldName, $subfieldName, $dont_erase, $value[, $value,[ $value ... ] ] );
110
}
122
123
  Updates a field with the given value, creating it if neccessary.
124
125
  If multiple values are supplied, they will be used to update a list of repeatable fields
126
  until either the fields or the values are all used.
127
111
128
  If a single value is supplied for a repeated field, that value will be used to update
112
sub _copy_field {
129
  each of the repeated fields.
113
    my ( $params ) = @_;
114
    my $record = $params->{record};
115
    my $fromFieldName = $params->{from_field};
116
    my $toFieldName = $params->{to_field};
117
    my $regex = $params->{regex};
118
    my $n = $params->{n};
119
120
    _copy_move_field({
121
        record => $record,
122
        from_field => $fromFieldName,
123
        to_field => $toFieldName,
124
        regex => $regex,
125
        n => $n
126
    });
127
}
130
128
131
=cut
129
sub _copy_subfield {
130
    my ( $params ) = @_;
131
    my $record = $params->{record};
132
    my $fromFieldName = $params->{from_field};
133
    my $fromSubfieldName = $params->{from_subfield};
134
    my $toFieldName = $params->{to_field};
135
    my $toSubfieldName = $params->{to_subfield};
136
    my $regex = $params->{regex};
137
    my $n = $params->{n};
138
139
    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
140
    @values = ( $values[$n-1] ) if ( $n );
141
    _modify_values({ values => \@values, regex => $regex });
142
143
    update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values });
144
}
132
145
133
sub update_field {
146
sub update_field {
134
  my ( $params ) = @_;
147
    my ( $params ) = @_;
135
  my $record = $params->{record};
148
    my $record = $params->{record};
136
  my $fieldName = $params->{field};
149
    my $fieldName = $params->{field};
137
  my $subfieldName = $params->{subfield};
150
    my $subfieldName = $params->{subfield};
138
  my $dont_erase = $params->{dont_erase};
151
    my @values = @{ $params->{values} };
139
  my @values = @{ $params->{values} };
152
153
    if ( ! ( $record && $fieldName ) ) { return; }
154
155
    if ( not $subfieldName or $subfieldName eq '' ) {
156
        # FIXME I'm not sure the actual implementation is correct.
157
        die "This action is not implemented yet";
158
        #_update_field({ record => $record, field => $fieldName, values => \@values });
159
    } else {
160
        _update_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, values => \@values });
161
    }
162
}
140
163
141
  if ( ! ( $record && $fieldName ) ) { return; }
164
sub _update_field {
165
    my ( $params ) = @_;
166
    my $record = $params->{record};
167
    my $fieldName = $params->{field};
168
    my @values = @{ $params->{values} };
142
169
143
  my $i = 0;
170
    my $i = 0;
144
  my $field;
145
  if ( $subfieldName ) {
146
    if ( my @fields = $record->field( $fieldName ) ) {
171
    if ( my @fields = $record->field( $fieldName ) ) {
147
      unless ( $dont_erase ) {
148
        @values = ($values[0]) x scalar( @fields )
172
        @values = ($values[0]) x scalar( @fields )
149
          if @values == 1;
173
            if @values == 1;
150
        foreach my $field ( @fields ) {
151
          $field->update( "$subfieldName" => $values[$i++] );
152
        }
153
      }
154
      if ( $i <= scalar ( @values ) - 1 ) {
155
        foreach my $field ( @fields ) {
174
        foreach my $field ( @fields ) {
156
          foreach my $j ( $i .. scalar( @values ) - 1) {
175
            $field->update( $values[$i++] );
157
            $field->add_subfields( "$subfieldName" => $values[$j] );
158
          }
159
        }
176
        }
160
      }
161
    } else {
177
    } else {
162
      ## Field does not exist, create it.
178
        ## Field does not exists, create it
163
      foreach my $value ( @values ) {
179
        if ( $fieldName < 10 ) {
164
        $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
180
            foreach my $value ( @values ) {
165
        $record->append_fields( $field );
181
                my $field = MARC::Field->new( $fieldName, $value );
166
      }
182
                $record->append_fields( $field );
183
            }
184
        } else {
185
            warn "Invalid operation, trying to add a new field without subfield";
186
        }
167
    }
187
    }
168
  } else { ## No subfield
188
}
189
190
sub _update_subfield {
191
    my ( $params ) = @_;
192
    my $record = $params->{record};
193
    my $fieldName = $params->{field};
194
    my $subfieldName = $params->{subfield};
195
    my @values = @{ $params->{values} };
196
    my $dont_erase = $params->{dont_erase};
197
    my $i = 0;
198
169
    if ( my @fields = $record->field( $fieldName ) ) {
199
    if ( my @fields = $record->field( $fieldName ) ) {
170
      @values = ($values[0]) x scalar( @fields )
200
        unless ( $dont_erase ) {
171
        if @values == 1;
201
            @values = ($values[0]) x scalar( @fields )
172
      foreach my $field ( @fields ) {
202
                if @values == 1;
173
        $field->update( $values[$i++] );
203
            foreach my $field ( @fields ) {
174
      }
204
                $field->update( "$subfieldName" => $values[$i++] );
205
            }
206
        }
207
        if ( $i <= scalar ( @values ) - 1 ) {
208
            foreach my $field ( @fields ) {
209
                foreach my $j ( $i .. scalar( @values ) - 1) {
210
                    $field->add_subfields( "$subfieldName" => $values[$j] );
211
                }
212
            }
213
        }
175
    } else {
214
    } else {
176
      ## Field does not exists, create it
215
        ## Field does not exist, create it.
177
      foreach my $value ( @values ) {
216
        foreach my $value ( @values ) {
178
        $field = MARC::Field->new( $fieldName, $value );
217
            my $field = MARC::Field->new( $fieldName, '', '', "$subfieldName" => $values[$i++] );
179
        $record->append_fields( $field );
218
            $record->append_fields( $field );
180
      }
219
        }
181
    }
220
    }
182
  }
183
}
221
}
184
222
185
=head2 read_field
223
=head2 read_field
Lines 194-220 sub update_field { Link Here
194
=cut
232
=cut
195
233
196
sub read_field {
234
sub read_field {
197
  my ( $params ) = @_;
235
    my ( $params ) = @_;
198
  my $record = $params->{record};
236
    my $record = $params->{record};
199
  my $fieldName = $params->{field};
237
    my $fieldName = $params->{field};
200
  my $subfieldName = $params->{subfield};
238
    my $subfieldName = $params->{subfield};
201
  my $n = $params->{n};
239
    my $n = $params->{n};
240
241
    if ( not $subfieldName or $subfieldName eq '' ) {
242
        _read_field({ record => $record, field => $fieldName, n => $n });
243
    } else {
244
        _read_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
245
    }
246
}
202
247
203
  my @fields = $record->field( $fieldName );
248
sub _read_field {
249
    my ( $params ) = @_;
250
    my $record = $params->{record};
251
    my $fieldName = $params->{field};
252
    my $n = $params->{n};
204
253
205
  return map { $_->data() } @fields unless $subfieldName;
254
    my @fields = $record->field( $fieldName );
206
255
207
  my @subfields;
256
    return unless @fields;
208
  foreach my $field ( @fields ) {
209
    my @sf = $field->subfield( $subfieldName );
210
    push( @subfields, @sf );
211
  }
212
257
213
  if ( $n ) {
258
    return map { $_->data() } @fields
214
    return $subfields[$n-1];
259
        if $fieldName < 10;
215
  } else {
260
216
    return @subfields;
261
    my @values;
217
  }
262
    if ( $n ) {
263
        if ( $n <= scalar( @fields ) ) {
264
            for my $sf ( $fields[$n - 1]->subfields ) {
265
                push @values, $sf->[1];
266
            }
267
        }
268
    } else {
269
        foreach my $field ( @fields ) {
270
            for my $sf ( $field->subfields ) {
271
                push @values, $sf->[1];
272
            }
273
        }
274
    }
275
276
    return @values;
277
}
278
279
sub _read_subfield {
280
    my ( $params ) = @_;
281
    my $record = $params->{record};
282
    my $fieldName = $params->{field};
283
    my $subfieldName = $params->{subfield};
284
    my $n = $params->{n};
285
286
    my @fields = $record->field( $fieldName );
287
288
    return unless @fields;
289
290
    my @values;
291
    foreach my $field ( @fields ) {
292
        my @sf = $field->subfield( $subfieldName );
293
        push( @values, @sf );
294
    }
295
296
    return $n
297
        ? $values[$n-1]
298
        : @values;
218
}
299
}
219
300
220
=head2 field_exists
301
=head2 field_exists
Lines 293-314 sub field_equals { Link Here
293
=cut
374
=cut
294
375
295
sub move_field {
376
sub move_field {
296
  my ( $params ) = @_;
377
    my ( $params ) = @_;
297
  my $record = $params->{record};
378
    my $record = $params->{record};
298
  my $fromFieldName = $params->{from_field};
379
    my $fromFieldName = $params->{from_field};
299
  my $fromSubfieldName = $params->{from_subfield};
380
    my $fromSubfieldName = $params->{from_subfield};
300
  my $toFieldName = $params->{to_field};
381
    my $toFieldName = $params->{to_field};
301
  my $toSubfieldName = $params->{to_subfield};
382
    my $toSubfieldName = $params->{to_subfield};
302
  my $regex = $params->{regex};
383
    my $regex = $params->{regex};
303
  my $n = $params->{n};
384
    my $n = $params->{n};
385
386
    if ( not $fromSubfieldName or $fromSubfieldName eq ''
387
        or not $toSubfieldName or $toSubfieldName eq ''
388
    ) {
389
        _move_field({
390
            record => $record,
391
            from_field => $fromFieldName,
392
            to_field => $toFieldName,
393
            regex => $regex,
394
            n => $n,
395
        });
396
    } else {
397
        _move_subfield({
398
            record => $record,
399
            from_field => $fromFieldName,
400
            from_subfield => $fromSubfieldName,
401
            to_field => $toFieldName,
402
            to_subfield => $toSubfieldName,
403
            regex => $regex,
404
            n => $n,
405
        });
406
    }
407
}
408
409
sub _move_field {
410
    my ( $params ) = @_;
411
    my $record = $params->{record};
412
    my $fromFieldName = $params->{from_field};
413
    my $toFieldName = $params->{to_field};
414
    my $regex = $params->{regex};
415
    my $n = $params->{n};
416
    _copy_move_field({
417
        record => $record,
418
        from_field => $fromFieldName,
419
        to_field => $toFieldName,
420
        regex => $regex,
421
        n => $n,
422
        action => 'move',
423
    });
424
}
304
425
305
  copy_field({ record => $record, from_field => $fromFieldName, from_subfield => $fromSubfieldName, to_field => $toFieldName, to_subfield => $toSubfieldName, regex => $regex, n => $n , dont_erase => 1 });
426
sub _move_subfield {
306
  delete_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName, n => $n });
427
    my ( $params ) = @_;
428
    my $record = $params->{record};
429
    my $fromFieldName = $params->{from_field};
430
    my $fromSubfieldName = $params->{from_subfield};
431
    my $toFieldName = $params->{to_field};
432
    my $toSubfieldName = $params->{to_subfield};
433
    my $regex = $params->{regex};
434
    my $n = $params->{n};
435
436
    # Copy
437
    my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
438
    @values = ( $values[$n-1] ) if $n;
439
    _modify_values({ values => \@values, regex => $regex });
440
    _update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => 1, values => \@values });
441
442
    # And delete
443
    _delete_subfield({
444
        record => $record,
445
        field => $fromFieldName,
446
        subfield => $fromSubfieldName,
447
        n => $n,
448
    });
307
}
449
}
308
450
309
=head2 delete_field
451
=head2 _delete_field
310
452
311
  delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
453
  _delete_field( $record, $fieldName[, $subfieldName [, $n ] ] );
312
454
313
  Deletes the given field.
455
  Deletes the given field.
314
456
Lines 318-343 sub move_field { Link Here
318
=cut
460
=cut
319
461
320
sub delete_field {
462
sub delete_field {
321
  my ( $params ) = @_;
463
    my ( $params ) = @_;
322
  my $record = $params->{record};
464
    my $record = $params->{record};
323
  my $fieldName = $params->{field};
465
    my $fieldName = $params->{field};
324
  my $subfieldName = $params->{subfield};
466
    my $subfieldName = $params->{subfield};
325
  my $n = $params->{n};
467
    my $n = $params->{n};
468
469
    if ( not $subfieldName or $subfieldName eq '' ) {
470
        _delete_field({ record => $record, field => $fieldName, n => $n });
471
    } else {
472
        _delete_subfield({ record => $record, field => $fieldName, subfield => $subfieldName, n => $n });
473
    }
474
}
326
475
327
  my @fields = $record->field( $fieldName );
476
sub _delete_field {
477
    my ( $params ) = @_;
478
    my $record = $params->{record};
479
    my $fieldName = $params->{field};
480
    my $n = $params->{n};
328
481
329
  @fields = ( $fields[$n-1] ) if ( $n );
482
    my @fields = $record->field( $fieldName );
330
483
331
  if ( @fields && !$subfieldName ) {
484
    @fields = ( $fields[$n-1] ) if ( $n );
332
    foreach my $field ( @fields ) {
485
    foreach my $field ( @fields ) {
333
      $record->delete_field( $field );
486
        $record->delete_field( $field );
334
    }
487
    }
335
  } elsif ( @fields && $subfieldName ) {
488
}
489
490
sub _delete_subfield {
491
    my ( $params ) = @_;
492
    my $record = $params->{record};
493
    my $fieldName = $params->{field};
494
    my $subfieldName = $params->{subfield};
495
    my $n = $params->{n};
496
497
    my @fields = $record->field( $fieldName );
498
499
    @fields = ( $fields[$n-1] ) if ( $n );
500
336
    foreach my $field ( @fields ) {
501
    foreach my $field ( @fields ) {
337
      $field->delete_subfield( code => $subfieldName );
502
        $field->delete_subfield( code => $subfieldName );
338
    }
503
    }
339
  }
340
}
504
}
341
505
506
507
sub _copy_move_field {
508
    my ( $params ) = @_;
509
    my $record = $params->{record};
510
    my $fromFieldName = $params->{from_field};
511
    my $toFieldName = $params->{to_field};
512
    my $regex = $params->{regex};
513
    my $n = $params->{n};
514
    my $action = $params->{action} || 'copy';
515
516
    my @fields = $record->field( $fromFieldName );
517
    if ( $n and $n <= scalar( @fields ) ) {
518
        @fields = ( $fields[$n - 1] );
519
    }
520
521
    for my $field ( @fields ) {
522
        my $new_field = $field->clone;
523
        $new_field->{_tag} = $toFieldName; # Should be replaced by set_tag, introduced by MARC::Field 2.0.4
524
        if ( $regex and $regex->{search} ) {
525
            for my $subfield ( $new_field->subfields ) {
526
                my $value = $subfield->[1];
527
                ( $value ) = _modify_values({ values => [ $value ], regex => $regex });
528
                $new_field->update( $subfield->[0], $value );
529
            }
530
        }
531
        $record->append_fields( $new_field );
532
        $record->delete_field( $field )
533
            if $action eq 'move';
534
    }
535
}
536
537
sub _modify_values {
538
    my ( $params ) = @_;
539
    my $values = $params->{values};
540
    my $regex = $params->{regex};
541
542
    if ( $regex and $regex->{search} ) {
543
        $regex->{modifiers} //= q||;
544
        my @available_modifiers = qw( i g );
545
        my $modifiers = q||;
546
        for my $modifier ( split //, $regex->{modifiers} ) {
547
            $modifiers .= $modifier
548
                if grep {/$modifier/} @available_modifiers;
549
        }
550
        foreach my $value ( @$values ) {
551
            for ( $modifiers ) {
552
                when ( /^(ig|gi)$/ ) {
553
                    $value =~ s/$regex->{search}/$regex->{replace}/ig;
554
                }
555
                when ( /^i$/ ) {
556
                    $value =~ s/$regex->{search}/$regex->{replace}/i;
557
                }
558
                when ( /^g$/ ) {
559
                    $value =~ s/$regex->{search}/$regex->{replace}/g;
560
                }
561
                default {
562
                    $value =~ s/$regex->{search}/$regex->{replace}/;
563
                }
564
            }
565
        }
566
    }
567
    return @$values;
568
}
342
1;
569
1;
343
__END__
570
__END__
344
- 

Return to bug 11319