Attachment #42282 for bug #14098

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

Lines 123-128 sub _copy_field { Link Here

(-)a/Koha/SimpleMARC.pm (-19 / +48 lines)
123	to_field => $toFieldName,	123	to_field => $toFieldName,
124	regex => $regex,	124	regex => $regex,
125	field_numbers => $field_numbers,	125	field_numbers => $field_numbers,
		126	action => 'copy',
126	});	127	});
127	}	128	}
128		129
Lines 136-148 sub _copy_subfield { Link Here
136	my $regex = $params->{regex};	137	my $regex = $params->{regex};
137	my $field_numbers = $params->{field_numbers} // [];	138	my $field_numbers = $params->{field_numbers} // [];
138		139
139	my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });	140	_copy_move_subfield({
140	if ( @$field_numbers ) {	141	record => $record,
141	@values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;	142	from_field => $fromFieldName,
142	}	143	from_subfield => $fromSubfieldName,
143	_modify_values({ values => \@values, regex => $regex });	144	to_field => $toFieldName,
144		145	to_subfield => $toSubfieldName,
145	update_field({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values });	146	regex => $regex,
		147	field_numbers => $field_numbers,
		148	action => 'copy',
		149	});
146	}	150	}
147		151
148	sub update_field {	152	sub update_field {
Lines 463-482 sub _move_subfield { Link Here
463	my $regex = $params->{regex};	467	my $regex = $params->{regex};
464	my $field_numbers = $params->{field_numbers} // [];	468	my $field_numbers = $params->{field_numbers} // [];
465		469
466	# Copy	470	_copy_move_subfield({
467	my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
468	if ( @$field_numbers ) {
469	@values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
470	}
471	_modify_values({ values => \@values, regex => $regex });
472	_update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, dont_erase => 1, values => \@values });
473
474	# And delete
475	_delete_subfield({
476	record => $record,	471	record => $record,
477	field => $fromFieldName,	472	from_field => $fromFieldName,
478	subfield => $fromSubfieldName,	473	from_subfield => $fromSubfieldName,
		474	to_field => $toFieldName,
		475	to_subfield => $toSubfieldName,
		476	regex => $regex,
479	field_numbers => $field_numbers,	477	field_numbers => $field_numbers,
		478	action => 'move',
480	});	479	});
481	}	480	}
482		481
Lines 570-575 sub _copy_move_field { Link Here
570	}	569	}
571	}	570	}
572		571
		572	sub _copy_move_subfield {
		573	my ( $params ) = @_;
		574	my $record = $params->{record};
		575	my $fromFieldName = $params->{from_field};
		576	my $fromSubfieldName = $params->{from_subfield};
		577	my $toFieldName = $params->{to_field};
		578	my $toSubfieldName = $params->{to_subfield};
		579	my $regex = $params->{regex};
		580	my $field_numbers = $params->{field_numbers} // [];
		581	my $action = $params->{action} \|\| 'copy';
		582
		583	my @values = read_field({ record => $record, field => $fromFieldName, subfield => $fromSubfieldName });
		584	if ( @$field_numbers ) {
		585	@values = map { $_ <= @values ? $values[ $_ - 1 ] : () } @$field_numbers;
		586	}
		587	_modify_values({ values => \@values, regex => $regex });
		588	my $dont_erase = $action eq 'copy' ? 1 : 0;
		589	_update_subfield({ record => $record, field => $toFieldName, subfield => $toSubfieldName, values => \@values, dont_erase => $dont_erase });
		590
		591	# And delete if it's a move
		592	if ( $action eq 'move' ) {
		593	_delete_subfield({
		594	record => $record,
		595	field => $fromFieldName,
		596	subfield => $fromSubfieldName,
		597	field_numbers => $field_numbers,
		598	});
		599	}
		600	}
		601
573	sub _modify_values {	602	sub _modify_values {
574	my ( $params ) = @_;	603	my ( $params ) = @_;
575	my $values = $params->{values};	604	my $values = $params->{values};




subtest 'copy_field' => sub {
    plan tests              => 2;
    subtest 'copy subfield' => sub {
        plan tests => 20;
        my $record = new_record;
        $record->append_fields(
            MARC::Field->new(

                    { record => $record, field => '651', subfield => 'a' }
                )
            ],
            ['Computer programming.', 'Computer algorithms.'],
            'Copy second field 650$a'
        );
        delete_field( { record => $record, field => '651' } );

            [ 'The art of programming.', 'The art of algorithms.' ],
            'Copy field using regex'
        );
        delete_field( { record => $record, field => '651' } );

        copy_field(
            {

            'Copy field using regex'
        );

        $record = new_record;
        $record->append_fields(
            MARC::Field->new(
                952, ' ', ' ',

        );
        my @fields_952d =
          read_field( { record => $record, field => '952', subfield => 'd' } );
        # FIXME We need a new action "duplicate" if we don't want to modify the original field
        is_deeply(
            \@fields_952d,
            [ '2001-06-25', '2001-06-25', '2001-06-25' ],
            'copy 952$d into others 952 field'
        );


                    { record => $record, field => '245', subfield => 'a' }
                )
            ],
            ['The art of computer programming', 'BEGIN The art of computer programming'],
            'Update a subfield: add a string at the beginning'
        );


                    { record => $record, field => '245', subfield => 'a' }
                )
            ],
            ['The art of computer programming', 'The art of computer programming END'],
            'Update a subfield: add a string at the end'
        );

        $record = new_record;
        copy_field(
            {
                record        => $record,
                from_field    => 245,
                from_subfield => 'c',
                to_field      => 650,
                to_subfield   => 'c',
            }
        );

        is_deeply(
            [
                read_field(
                    { record => $record, field => '650' }
                )
            ],
            [ 'Computer programming.', '462', 'Donald E. Knuth.' ],
            'Copy a subfield to an existent field but inexistent subfield'
        );

        $record = new_record;
        copy_field(
            {
                record        => $record,
                from_field    => 245,
                from_subfield => 'c',
                to_field      => 650,
                to_subfield   => '9',
            }
        );

        is_deeply(
            [
                read_field(
                    { record => $record, field => '650' }
                )
            ],
            [ 'Computer programming.', '462', 'Donald E. Knuth.' ],
            'Copy a subfield to an existent field / subfield'
        );
    };

    subtest 'copy field' => sub {
        plan tests => 14;
        my $record = new_record;
        $record->append_fields(
            MARC::Field->new(

          read_field( { record => $record, field => '999', subfield => '9' } );
        is_deeply( \@fields_9999, [],
            'copy a nonexistent field does not create a new one' );

        $record = new_record;
        copy_field(
            {
                record        => $record,
                from_field    => 245,
                to_field      => 650,
            }
        );

        is_deeply(
            [
                read_field(
                    { record => $record, field => '650', field_numbers => [2] }
                )
            ],
            [ 'The art of computer programming', 'Donald E. Knuth.' ],
            'Copy a field to existent fields should create a new field'
        );
        is_deeply(
            [
                read_field(
                    { record => $record, field => '650', field_numbers => [1] }
                )
            ],
            [ 'Computer programming.', '462' ],
            'Copy a field to existent fields should create a new field, the original one should not have been updated'
        );
    };
};

- 

Return to bug 14098

Lines 287-293 subtest 'update_field' => sub { Link Here

(-)a/t/SimpleMARC.t (-7 / +78 lines)
287	subtest 'copy_field' => sub {	287	subtest 'copy_field' => sub {
288	plan tests => 2;	288	plan tests => 2;
289	subtest 'copy subfield' => sub {	289	subtest 'copy subfield' => sub {
290	plan tests => 18;	290	plan tests => 20;
291	my $record = new_record;	291	my $record = new_record;
292	$record->append_fields(	292	$record->append_fields(
293	MARC::Field->new(	293	MARC::Field->new(
Lines 387-393 subtest 'copy_field' => sub { Link Here
387	{ record => $record, field => '651', subfield => 'a' }	387	{ record => $record, field => '651', subfield => 'a' }
388	)	388	)
389	],	389	],
390	['Computer algorithms.'],	390	['Computer programming.', 'Computer algorithms.'],
391	'Copy second field 650$a'	391	'Copy second field 650$a'
392	);	392	);
393	delete_field( { record => $record, field => '651' } );	393	delete_field( { record => $record, field => '651' } );
Lines 409-414 subtest 'copy_field' => sub { Link Here
409	[ 'The art of programming.', 'The art of algorithms.' ],	409	[ 'The art of programming.', 'The art of algorithms.' ],
410	'Copy field using regex'	410	'Copy field using regex'
411	);	411	);
		412	delete_field( { record => $record, field => '651' } );
412		413
413	copy_field(	414	copy_field(
414	{	415	{
Lines 549-554 subtest 'copy_field' => sub { Link Here
549	'Copy field using regex'	550	'Copy field using regex'
550	);	551	);
551		552
		553	$record = new_record;
552	$record->append_fields(	554	$record->append_fields(
553	MARC::Field->new(	555	MARC::Field->new(
554	952, ' ', ' ',	556	952, ' ', ' ',
Lines 568-576 subtest 'copy_field' => sub { Link Here
568	);	570	);
569	my @fields_952d =	571	my @fields_952d =
570	read_field( { record => $record, field => '952', subfield => 'd' } );	572	read_field( { record => $record, field => '952', subfield => 'd' } );
		573	# FIXME We need a new action "duplicate" if we don't want to modify the original field
571	is_deeply(	574	is_deeply(
572	\@fields_952d,	575	\@fields_952d,
573	[ '2001-06-25', '2001-06-25' ],	576	[ '2001-06-25', '2001-06-25', '2001-06-25' ],
574	'copy 952$d into others 952 field'	577	'copy 952$d into others 952 field'
575	);	578	);
576		579
Lines 605-611 subtest 'copy_field' => sub { Link Here
605	{ record => $record, field => '245', subfield => 'a' }	608	{ record => $record, field => '245', subfield => 'a' }
606	)	609	)
607	],	610	],
608	['BEGIN The art of computer programming'],	611	['The art of computer programming', 'BEGIN The art of computer programming'],
609	'Update a subfield: add a string at the beginning'	612	'Update a subfield: add a string at the beginning'
610	);	613	);
611		614
Lines 626-639 subtest 'copy_field' => sub { Link Here
626	{ record => $record, field => '245', subfield => 'a' }	629	{ record => $record, field => '245', subfield => 'a' }
627	)	630	)
628	],	631	],
629	['The art of computer programming END'],	632	['The art of computer programming', 'The art of computer programming END'],
630	'Update a subfield: add a string at the end'	633	'Update a subfield: add a string at the end'
631	);	634	);
632		635
		636	$record = new_record;
		637	copy_field(
		638	{
		639	record => $record,
		640	from_field => 245,
		641	from_subfield => 'c',
		642	to_field => 650,
		643	to_subfield => 'c',
		644	}
		645	);
		646
		647	is_deeply(
		648	[
		649	read_field(
		650	{ record => $record, field => '650' }
		651	)
		652	],
		653	[ 'Computer programming.', '462', 'Donald E. Knuth.' ],
		654	'Copy a subfield to an existent field but inexistent subfield'
		655	);
		656
		657	$record = new_record;
		658	copy_field(
		659	{
		660	record => $record,
		661	from_field => 245,
		662	from_subfield => 'c',
		663	to_field => 650,
		664	to_subfield => '9',
		665	}
		666	);
		667
		668	is_deeply(
		669	[
		670	read_field(
		671	{ record => $record, field => '650' }
		672	)
		673	],
		674	[ 'Computer programming.', '462', 'Donald E. Knuth.' ],
		675	'Copy a subfield to an existent field / subfield'
		676	);
633	};	677	};
634		678
635	subtest 'copy field' => sub {	679	subtest 'copy field' => sub {
636	plan tests => 12;	680	plan tests => 14;
637	my $record = new_record;	681	my $record = new_record;
638	$record->append_fields(	682	$record->append_fields(
639	MARC::Field->new(	683	MARC::Field->new(
Lines 782-787 subtest 'copy_field' => sub { Link Here
782	read_field( { record => $record, field => '999', subfield => '9' } );	826	read_field( { record => $record, field => '999', subfield => '9' } );
783	is_deeply( \@fields_9999, [],	827	is_deeply( \@fields_9999, [],
784	'copy a nonexistent field does not create a new one' );	828	'copy a nonexistent field does not create a new one' );
		829
		830	$record = new_record;
		831	copy_field(
		832	{
		833	record => $record,
		834	from_field => 245,
		835	to_field => 650,
		836	}
		837	);
		838
		839	is_deeply(
		840	[
		841	read_field(
		842	{ record => $record, field => '650', field_numbers => [2] }
		843	)
		844	],
		845	[ 'The art of computer programming', 'Donald E. Knuth.' ],
		846	'Copy a field to existent fields should create a new field'
		847	);
		848	is_deeply(
		849	[
		850	read_field(
		851	{ record => $record, field => '650', field_numbers => [1] }
		852	)
		853	],
		854	[ 'Computer programming.', '462' ],
		855	'Copy a field to existent fields should create a new field, the original one should not have been updated'
		856	);
785	};	857	};
786	};	858	};
787		859
788	-