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 |
- |
|
|