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

(-)a/C4/MarcModificationTemplates.pm (+15 lines)
Lines 612-617 sub ModifyRecordWithTemplate { Link Here
612
                    field_numbers => $field_numbers,
612
                    field_numbers => $field_numbers,
613
                });
613
                });
614
            }
614
            }
615
            elsif ( $action eq 'copy_and_replace_field' ) {
616
                copy_and_replace_field({
617
                    record => $record,
618
                    from_field => $from_field,
619
                    from_subfield => $from_subfield,
620
                    to_field => $to_field,
621
                    to_subfield => $to_subfield,
622
                    regex => {
623
                        search => $to_regex_search,
624
                        replace => $to_regex_replace,
625
                        modifiers => $to_regex_modifiers
626
                    },
627
                    field_numbers => $field_numbers,
628
                });
629
            }
615
            elsif ( $action eq 'update_field' ) {
630
            elsif ( $action eq 'update_field' ) {
616
                update_field({
631
                update_field({
617
                    record => $record,
632
                    record => $record,
(-)a/Koha/SimpleMARC.pm (-7 / +57 lines)
Lines 19-24 our @EXPORT = qw( Link Here
19
  read_field
19
  read_field
20
  update_field
20
  update_field
21
  copy_field
21
  copy_field
22
  copy_and_replace_field
22
  move_field
23
  move_field
23
  delete_field
24
  delete_field
24
  field_exists
25
  field_exists
Lines 113-118 sub copy_field { Link Here
113
    }
114
    }
114
}
115
}
115
116
117
sub copy_and_replace_field {
118
    my ( $params ) = @_;
119
    my $record = $params->{record};
120
    my $fromFieldName = $params->{from_field};
121
    my $fromSubfieldName = $params->{from_subfield};
122
    my $toFieldName = $params->{to_field};
123
    my $toSubfieldName = $params->{to_subfield};
124
    my $regex = $params->{regex};
125
    my $field_numbers = $params->{field_numbers} // [];
126
127
    if ( ! ( $record && $fromFieldName && $toFieldName ) ) { return; }
128
129
130
    if ( not $fromSubfieldName or $fromSubfieldName eq ''
131
      or not $toSubfieldName or $toSubfieldName eq ''
132
    ) {
133
        _copy_move_field(
134
            {   record        => $record,
135
                from_field    => $fromFieldName,
136
                to_field      => $toFieldName,
137
                regex         => $regex,
138
                field_numbers => $field_numbers,
139
                action        => 'replace',
140
            }
141
        );
142
    } else {
143
        _copy_move_subfield(
144
            {   record        => $record,
145
                from_field    => $fromFieldName,
146
                from_subfield => $fromSubfieldName,
147
                to_field      => $toFieldName,
148
                to_subfield   => $toSubfieldName,
149
                regex         => $regex,
150
                field_numbers => $field_numbers,
151
                action        => 'replace',
152
            }
153
        );
154
    }
155
}
156
116
sub update_field {
157
sub update_field {
117
    my ( $params ) = @_;
158
    my ( $params ) = @_;
118
    my $record = $params->{record};
159
    my $record = $params->{record};
Lines 477-489 sub _copy_move_field { Link Here
477
    my $field_numbers = $params->{field_numbers} // [];
518
    my $field_numbers = $params->{field_numbers} // [];
478
    my $action = $params->{action} || 'copy';
519
    my $action = $params->{action} || 'copy';
479
520
480
    my @fields = $record->field( $fromFieldName );
521
    my @from_fields = $record->field( $fromFieldName );
481
    if ( @$field_numbers ) {
522
    if ( @$field_numbers ) {
482
        @fields = map { $_ <= @fields ? $fields[ $_ - 1 ] : () } @$field_numbers;
523
        @from_fields = map { $_ <= @from_fields ? $from_fields[ $_ - 1 ] : () } @$field_numbers;
483
    }
524
    }
484
525
485
    for my $field ( @fields ) {
526
    my @new_fields;
486
        my $new_field = $field->clone;
527
    for my $from_field ( @from_fields ) {
528
        my $new_field = $from_field->clone;
487
        $new_field->{_tag} = $toFieldName; # Should be replaced by set_tag, introduced by MARC::Field 2.0.4
529
        $new_field->{_tag} = $toFieldName; # Should be replaced by set_tag, introduced by MARC::Field 2.0.4
488
        if ( $regex and $regex->{search} ) {
530
        if ( $regex and $regex->{search} ) {
489
            for my $subfield ( $new_field->subfields ) {
531
            for my $subfield ( $new_field->subfields ) {
Lines 492-501 sub _copy_move_field { Link Here
492
                $new_field->update( $subfield->[0], $value );
534
                $new_field->update( $subfield->[0], $value );
493
            }
535
            }
494
        }
536
        }
495
        $record->append_fields( $new_field );
537
        if ( $action eq 'move' ) {
496
        $record->delete_field( $field )
538
            $record->delete_field( $from_field )
497
            if $action eq 'move';
539
        }
540
        elsif ( $action eq 'replace' ) {
541
            my @to_fields = $record->field( $toFieldName );
542
            if ( @to_fields ) {
543
                $record->delete_field( $to_fields[0] );
544
            }
545
        }
546
        push @new_fields, $new_field;
498
    }
547
    }
548
    $record->append_fields( @new_fields );
499
}
549
}
500
550
501
sub _copy_move_subfield {
551
sub _copy_move_subfield {
(-)a/t/SimpleMARC.t (-3 / +576 lines)
Lines 1-6 Link Here
1
use Modern::Perl;
1
use Modern::Perl;
2
2
3
use Test::More tests => 9;
3
use Test::More tests => 10;
4
4
5
use_ok("MARC::Field");
5
use_ok("MARC::Field");
6
use_ok("MARC::Record");
6
use_ok("MARC::Record");
Lines 804-810 subtest 'copy_field' => sub { Link Here
804
                )
804
                )
805
            ],
805
            ],
806
            [ '4242423917', 'BK', 'GEN', '2001-06-25' ],
806
            [ '4242423917', 'BK', 'GEN', '2001-06-25' ],
807
            "copy all wirh regex: first original fields has been copied"
807
            "copy all with regex: first original fields has been copied"
808
        );
808
        );
809
        is_deeply(
809
        is_deeply(
810
            [
810
            [
Lines 857-862 subtest 'copy_field' => sub { Link Here
857
    };
857
    };
858
};
858
};
859
859
860
# copy_and_replace_field - subfield
861
subtest 'copy_and_replace_field' => sub {
862
    plan tests              => 2;
863
    subtest 'copy and replace subfield' => sub {
864
        plan tests => 19;
865
        my $record = new_record;
866
        $record->append_fields(
867
            MARC::Field->new(
868
                650, ' ', '0',
869
                a => 'Computer algorithms.',
870
                9 => '463',
871
            )
872
        );
873
        copy_and_replace_field(
874
            {
875
                record        => $record,
876
                from_field    => '245',
877
                from_subfield => 'a',
878
                to_field      => '246',
879
                to_subfield   => 'a'
880
            }
881
        );
882
        is_deeply(
883
            [
884
                read_field(
885
                    { record => $record, field => '245', subfield => 'a' }
886
                )
887
            ],
888
            ['The art of computer programming'],
889
            'Copy and replace should not have modify original subfield 245$a (same as copy)'
890
        );
891
        is_deeply(
892
            [
893
                read_field(
894
                    { record => $record, field => '246', subfield => 'a' }
895
                )
896
            ],
897
            ['The art of computer programming'],
898
            'Copy and replace should create a new 246$a (same as copy)'
899
        );
900
901
        $record = new_record;
902
        $record->append_fields(
903
            MARC::Field->new(
904
                650, ' ', '0',
905
                a => 'Computer algorithms.',
906
                9 => '463',
907
            )
908
        );
909
        copy_and_replace_field(
910
            {
911
                record        => $record,
912
                from_field    => '650',
913
                from_subfield => 'a',
914
                to_field      => '651',
915
                to_subfield   => 'a'
916
            }
917
        );
918
        my @fields_651a =
919
          read_field( { record => $record, field => '651', subfield => 'a' } );
920
        is_deeply(
921
            \@fields_651a,
922
            [ 'Computer programming.', 'Computer algorithms.' ],
923
            'Copy and replace multivalued field (same as copy)'
924
        );
925
        delete_field( { record => $record, field => '651' } );
926
927
        copy_and_replace_field(
928
            {
929
                record        => $record,
930
                from_field    => '650',
931
                from_subfield => 'a',
932
                to_field      => '651',
933
                to_subfield   => 'a',
934
                field_numbers => [1]
935
            }
936
        );
937
        is_deeply(
938
            [
939
                read_field(
940
                    { record => $record, field => '651', subfield => 'a' }
941
                )
942
            ],
943
            ['Computer programming.'],
944
            'Copy and replace first field 650$a should only copy the 1st (same as copy)'
945
        );
946
947
        copy_and_replace_field(
948
            {
949
                record        => $record,
950
                from_field    => '650',
951
                from_subfield => 'a',
952
                to_field      => '651',
953
                to_subfield   => 'a',
954
                field_numbers => [2]
955
            }
956
        );
957
        is_deeply(
958
            [
959
                read_field(
960
                    { record => $record, field => '651', subfield => 'a' }
961
                )
962
            ],
963
            ['Computer algorithms.'],
964
            'Copy and replace second field 650$a should erase 651$a'
965
        );
966
        delete_field( { record => $record, field => '651' } );
967
968
        copy_and_replace_field(
969
            {
970
                record        => $record,
971
                from_field    => '650',
972
                from_subfield => 'a',
973
                to_field      => '651',
974
                to_subfield   => 'a',
975
                regex => { search => 'Computer', replace => 'The art of' }
976
            }
977
        );
978
        @fields_651a =
979
          read_field( { record => $record, field => '651', subfield => 'a' } );
980
        is_deeply(
981
            \@fields_651a,
982
            [ 'The art of programming.', 'The art of algorithms.' ],
983
            'Copy and replace field using regex (same as copy)'
984
        );
985
        delete_field( { record => $record, field => '651' } );
986
987
        copy_and_replace_field(
988
            {
989
                record        => $record,
990
                from_field    => '650',
991
                from_subfield => 'a',
992
                to_field      => '651',
993
                to_subfield   => 'a',
994
                regex => { search => 'Computer', replace => 'The mistake of' }
995
            }
996
        );
997
        @fields_651a =
998
          read_field( { record => $record, field => '651', subfield => 'a' } );
999
        is_deeply(
1000
            \@fields_651a,
1001
            [ 'The mistake of programming.', 'The mistake of algorithms.' ],
1002
            'Copy and replace fields using regex on existing fields (same as copy)'
1003
        );
1004
        delete_field( { record => $record, field => '651' } );
1005
1006
        copy_and_replace_field(
1007
            {
1008
                record        => $record,
1009
                from_field    => '650',
1010
                from_subfield => 'a',
1011
                to_field      => '651',
1012
                to_subfield   => 'a',
1013
                regex => { search => 'Computer', replace => 'The art of' }
1014
            }
1015
        );
1016
        @fields_651a =
1017
          read_field( { record => $record, field => '651', subfield => 'a' } );
1018
        is_deeply(
1019
            \@fields_651a,
1020
            [ 'The art of programming.', 'The art of algorithms.', ],
1021
            'Copy and replace all fields using regex (same as copy)'
1022
        );
1023
        delete_field( { record => $record, field => '651' } );
1024
1025
        copy_and_replace_field(
1026
            {
1027
                record        => $record,
1028
                from_field    => '650',
1029
                from_subfield => 'a',
1030
                to_field      => '651',
1031
                to_subfield   => 'a',
1032
                regex => { search => 'Computer', replace => 'The art of' },
1033
                field_numbers => [1]
1034
            }
1035
        );
1036
        @fields_651a =
1037
          read_field( { record => $record, field => '651', subfield => 'a' } );
1038
        is_deeply(
1039
            \@fields_651a,
1040
            [ 'The art of programming.', ],
1041
            'Copy and replace first field using regex (same as copy)'
1042
        );
1043
        delete_field( { record => $record, field => '651' } );
1044
1045
        # Copy and replace with regex modifiers
1046
        $record = new_record;
1047
        $record->append_fields(
1048
            MARC::Field->new(
1049
                650, ' ', '0',
1050
                a => 'Computer algorithms.',
1051
                9 => '463',
1052
            )
1053
        );
1054
        copy_and_replace_field(
1055
            {
1056
                record        => $record,
1057
                from_field    => '650',
1058
                from_subfield => 'a',
1059
                to_field      => '652',
1060
                to_subfield   => 'a',
1061
                regex         => { search => 'o', replace => 'foo' }
1062
            }
1063
        );
1064
        my @fields_652a =
1065
          read_field( { record => $record, field => '652', subfield => 'a' } );
1066
        is_deeply(
1067
            \@fields_652a,
1068
            [ 'Cfoomputer programming.', 'Cfoomputer algorithms.' ],
1069
            'Copy and replace field using regex (same as copy)'
1070
        );
1071
1072
        copy_and_replace_field(
1073
            {
1074
                record        => $record,
1075
                from_field    => '650',
1076
                from_subfield => 'a',
1077
                to_field      => '653',
1078
                to_subfield   => 'a',
1079
                regex => { search => 'o', replace => 'foo', modifiers => 'g' }
1080
            }
1081
        );
1082
        my @fields_653a =
1083
          read_field( { record => $record, field => '653', subfield => 'a' } );
1084
        is_deeply(
1085
            \@fields_653a,
1086
            [ 'Cfoomputer prfoogramming.', 'Cfoomputer algfoorithms.' ],
1087
            'Copy and replace field using regex (same as copy)'
1088
        );
1089
1090
        copy_and_replace_field(
1091
            {
1092
                record        => $record,
1093
                from_field    => '650',
1094
                from_subfield => 'a',
1095
                to_field      => '654',
1096
                to_subfield   => 'a',
1097
                regex => { search => 'O', replace => 'foo', modifiers => 'i' }
1098
            }
1099
        );
1100
        my @fields_654a =
1101
          read_field( { record => $record, field => '654', subfield => 'a' } );
1102
        is_deeply(
1103
            \@fields_654a,
1104
            [ 'Cfoomputer programming.', 'Cfoomputer algorithms.' ],
1105
            'Copy and replace field using regex (same as copy)'
1106
        );
1107
1108
        copy_and_replace_field(
1109
            {
1110
                record        => $record,
1111
                from_field    => '650',
1112
                from_subfield => 'a',
1113
                to_field      => '655',
1114
                to_subfield   => 'a',
1115
                regex => { search => 'O', replace => 'foo', modifiers => 'gi' }
1116
            }
1117
        );
1118
        my @fields_655a =
1119
          read_field( { record => $record, field => '655', subfield => 'a' } );
1120
        is_deeply(
1121
            \@fields_655a,
1122
            [ 'Cfoomputer prfoogramming.', 'Cfoomputer algfoorithms.' ],
1123
            'Copy and replace field using regex (same as copy)'
1124
        );
1125
1126
        $record = new_record;
1127
        $record->append_fields(
1128
            MARC::Field->new(
1129
                952, ' ', ' ',
1130
                p => '3010023917',
1131
                y => 'BK',
1132
            ),
1133
        );
1134
1135
        copy_and_replace_field(
1136
            {
1137
                record        => $record,
1138
                from_field    => '952',
1139
                from_subfield => 'd',
1140
                to_field      => '952',
1141
                to_subfield   => 'd'
1142
            }
1143
        );
1144
        my @fields_952d =
1145
          read_field( { record => $record, field => '952', subfield => 'd' } );
1146
        is_deeply(
1147
            \@fields_952d,
1148
            [ '2001-06-25', '2001-06-25' ],
1149
            'copy and replace 952$d into others 952 field'
1150
        );
1151
1152
        copy_and_replace_field(
1153
            {
1154
                record        => $record,
1155
                from_field    => '111',
1156
                from_subfield => '1',
1157
                to_field      => '999',
1158
                to_subfield   => '9'
1159
            }
1160
        );
1161
        my @fields_9999 =
1162
          read_field( { record => $record, field => '999', subfield => '9' } );
1163
        is_deeply( \@fields_9999, [],
1164
            'copy and replace a nonexistent subfield does not create a new one (same as copy)' );
1165
1166
        $record = new_record;
1167
        copy_and_replace_field(
1168
            {
1169
                record        => $record,
1170
                from_field    => 245,
1171
                from_subfield => 'a',
1172
                to_field      => 245,
1173
                to_subfield   => 'a',
1174
                regex         => { search => '^', replace => 'BEGIN ' }
1175
            }
1176
        );
1177
        # This is the same as update the subfield
1178
        is_deeply(
1179
            [
1180
                read_field(
1181
                    { record => $record, field => '245', subfield => 'a' }
1182
                )
1183
            ],
1184
            ['BEGIN The art of computer programming'],
1185
            'Copy and replace - Update a subfield: add a string at the beginning'
1186
        );
1187
1188
        $record = new_record;
1189
        copy_and_replace_field(
1190
            {
1191
                record        => $record,
1192
                from_field    => 245,
1193
                from_subfield => 'a',
1194
                to_field      => 245,
1195
                to_subfield   => 'a',
1196
                regex         => { search => '$', replace => ' END' }
1197
            }
1198
        );
1199
        # This is the same as update the subfield
1200
        is_deeply(
1201
            [
1202
                read_field(
1203
                    { record => $record, field => '245', subfield => 'a' }
1204
                )
1205
            ],
1206
            ['The art of computer programming END'],
1207
            'Copy and replace - Update a subfield: add a string at the end'
1208
        );
1209
1210
        $record = new_record;
1211
        copy_and_replace_field(
1212
            {
1213
                record        => $record,
1214
                from_field    => 245,
1215
                from_subfield => 'c',
1216
                to_field      => 650,
1217
                to_subfield   => 'c',
1218
            }
1219
        );
1220
1221
        is_deeply(
1222
            [
1223
                read_field(
1224
                    { record => $record, field => '650' }
1225
                )
1226
            ],
1227
            [ 'Computer programming.', '462', 'Donald E. Knuth.' ],
1228
            'Copy and replace a subfield to an existent field but inexistent subfield (same as copy)'
1229
        );
1230
1231
        $record = new_record;
1232
        copy_and_replace_field(
1233
            {
1234
                record        => $record,
1235
                from_field    => 245,
1236
                from_subfield => 'c',
1237
                to_field      => 650,
1238
                to_subfield   => '9',
1239
            }
1240
        );
1241
1242
        is_deeply(
1243
            [
1244
                read_field(
1245
                    { record => $record, field => '650' }
1246
                )
1247
            ],
1248
            [ 'Computer programming.', 'Donald E. Knuth.' ],
1249
            'Copy and replace a subfield to an existent field / subfield, the origin subfield is replaced'
1250
        );
1251
    };
1252
1253
    subtest 'copy and replace field' => sub {
1254
        plan tests => 14;
1255
        my $record = new_record;
1256
        $record->append_fields(
1257
            MARC::Field->new(
1258
                952, ' ', ' ',
1259
                p => '3010023918',
1260
                y => 'CD',
1261
            ),
1262
        );
1263
1264
        #- copy all fields
1265
        copy_and_replace_field(
1266
            { record => $record, from_field => '952', to_field => '953' } );
1267
        my @fields_952 = read_field( { record => $record, field => '952' } );
1268
        is_deeply(
1269
            [
1270
                read_field(
1271
                    { record => $record, field => '952', field_numbers => [1] }
1272
                )
1273
            ],
1274
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
1275
            "copy all: original first field still exists (same as copy)"
1276
        );
1277
        is_deeply(
1278
            [
1279
                read_field(
1280
                    { record => $record, field => '952', field_numbers => [2] }
1281
                )
1282
            ],
1283
            [ '3010023918', 'CD' ],
1284
            "copy all: original second field still exists (same as copy)"
1285
        );
1286
        is_deeply(
1287
            [
1288
                read_field(
1289
                    { record => $record, field => '953', field_numbers => [1] }
1290
                )
1291
            ],
1292
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
1293
            "copy all: first original fields has been copied (same as copy)"
1294
        );
1295
        is_deeply(
1296
            [
1297
                read_field(
1298
                    { record => $record, field => '953', field_numbers => [2] }
1299
                )
1300
            ],
1301
            [ '3010023918', 'CD' ],
1302
            "copy all: second original fields has been copied (same as copy)"
1303
        );
1304
1305
        #- copy only the first field
1306
        copy_and_replace_field(
1307
            {
1308
                record        => $record,
1309
                from_field    => '953',
1310
                to_field      => '954',
1311
                field_numbers => [1]
1312
            }
1313
        );
1314
        is_deeply(
1315
            [
1316
                read_field(
1317
                    { record => $record, field => '953', field_numbers => [1] }
1318
                )
1319
            ],
1320
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
1321
            "copy and replace first: first original fields has been copied (same as copy)"
1322
        );
1323
        is_deeply(
1324
            [
1325
                read_field(
1326
                    { record => $record, field => '953', field_numbers => [2] }
1327
                )
1328
            ],
1329
            [ '3010023918', 'CD' ],
1330
            "copy and replace first: second original fields has been copied (same as copy)"
1331
        );
1332
        is_deeply(
1333
            [ read_field( { record => $record, field => '954' } ) ],
1334
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
1335
            "copy and replace first: only first, first 953 has been copied (same as copy)"
1336
        );
1337
1338
        $record = new_record;
1339
        $record->append_fields(
1340
            MARC::Field->new(
1341
                952, ' ', ' ',
1342
                p => '3010023918',
1343
                y => 'CD',
1344
            ),
1345
        );
1346
1347
        #- copy and replace all fields and modify values using a regex
1348
        copy_and_replace_field(
1349
            {
1350
                record     => $record,
1351
                from_field => '952',
1352
                to_field   => '953',
1353
                regex      => { search => '30100', replace => '42424' }
1354
            }
1355
        );
1356
        is_deeply(
1357
            [
1358
                read_field(
1359
                    { record => $record, field => '952', field_numbers => [1] }
1360
                )
1361
            ],
1362
            [ '3010023917', 'BK', 'GEN', '2001-06-25' ],
1363
            "copy and replace all with regex: original first field still exists (same as copy)"
1364
        );
1365
        is_deeply(
1366
            [
1367
                read_field(
1368
                    { record => $record, field => '952', field_numbers => [2] }
1369
                )
1370
            ],
1371
            [ '3010023918', 'CD' ],
1372
            "copy and replace all with regex: original second field still exists (same as copy)"
1373
        );
1374
        is_deeply(
1375
            [
1376
                read_field(
1377
                    { record => $record, field => '953', field_numbers => [1] }
1378
                )
1379
            ],
1380
            [ '4242423917', 'BK', 'GEN', '2001-06-25' ],
1381
            "copy and replace all with regex: first original fields has been copied (same as copy)"
1382
        );
1383
        is_deeply(
1384
            [
1385
                read_field(
1386
                    { record => $record, field => '953', field_numbers => [2] }
1387
                )
1388
            ],
1389
            [ '4242423918', 'CD' ],
1390
            "copy and replace all with regex: second original fields has been copied (same as copy)"
1391
        );
1392
        copy_and_replace_field(
1393
            {
1394
                record     => $record,
1395
                from_field => '111',
1396
                to_field   => '999',
1397
            }
1398
        );
1399
        my @fields_9999 =
1400
          read_field( { record => $record, field => '999', subfield => '9' } );
1401
        is_deeply( \@fields_9999, [],
1402
            'copy and replace a nonexistent field does not create a new one (same as copy)' );
1403
1404
        $record = new_record;
1405
        copy_and_replace_field(
1406
            {
1407
                record        => $record,
1408
                from_field    => 245,
1409
                to_field      => 650,
1410
            }
1411
        );
1412
1413
        is_deeply(
1414
            [
1415
                read_field(
1416
                    { record => $record, field => '650', field_numbers => [1] }
1417
                )
1418
            ],
1419
            [ 'The art of computer programming', 'Donald E. Knuth.' ],
1420
            'Copy and replace to an existent field should erase the original field'
1421
        );
1422
        is_deeply(
1423
            [
1424
                read_field(
1425
                    { record => $record, field => '650', field_numbers => [2] }
1426
                )
1427
            ],
1428
            [],
1429
            'Copy and replace to an existent field should not create a new field'
1430
        );
1431
    };
1432
};
1433
860
# move_field - subfields
1434
# move_field - subfields
861
subtest 'move_field' => sub {
1435
subtest 'move_field' => sub {
862
    plan tests              => 2;
1436
    plan tests              => 2;
863
- 

Return to bug 14098