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