Attachment #60597 for bug #9988

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





use Modern::Perl;

use Carp;

use Koha::Database;
use C4::Context;
use MARC::Record;

use base qw(Koha::Object);

=head1 NAME




package Koha::Authority::MergeRequest;

# Copyright Rijksmuseum 2017
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use Modern::Perl;

use parent qw(Koha::Object);

use Koha::Authorities;
use Koha::Authority::MergeRequests;
use Koha::Authority::Types;

=head1 NAME

Koha::Authority::MergeRequest - Koha::Object class for single need_merge_authorities record

=head1 SYNOPSIS

use Koha::Authority::MergeRequest;

=head1 DESCRIPTION

Description

=head1 METHODS

=head2 INSTANCE METHODS

=head3 new

    $self->new({
        authid => $id,
        [ authid_new => $new, ]
        [ oldrecord => $marc, ]
    });

    authid refers to the old authority id,
    authid_new optionally refers to a new different authority id

    oldrecord is the MARC record belonging to the original authority record

    This method returns an object and initializes the reportxml property.

=cut

sub new {
    my ( $class, $params ) = @_;
    my $oldrecord = delete $params->{oldrecord};
    delete $params->{reportxml}; # just making sure it is empty
    my $self = $class->SUPER::new( $params );

    if( $self->authid && $oldrecord ) {
        my $auth = Koha::Authorities->find( $self->authid );
        my $type = $auth ? Koha::Authority::Types->find($auth->authtypecode) : undef;
        $self->reportxml( Koha::Authority::MergeRequests->reporting_tag_xml({ record => $oldrecord, tag => $type->auth_tag_to_report })) if $type;
    }
    return $self;
}

=head3 oldmarc

    my $record = $self->oldmarc;

    Convert reportxml back to MARC::Record.

=cut

sub oldmarc {
    my ( $self ) = @_;
    return if !$self->reportxml;
    return MARC::Record->new_from_xml( $self->reportxml, 'UTF-8' );
}

=head2 CLASS METHODS

=head3 _type

Returns name of corresponding DBIC resultset

=cut

sub _type {
    return 'NeedMergeAuthority';
}

=head1 AUTHOR

Marcel de Rooy (Rijksmuseum)

Koha Development Team

=cut

1;




package Koha::Authority::MergeRequests;

# Copyright Rijksmuseum 2017
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use Modern::Perl;
use MARC::File::XML;
use MARC::Record;

use C4::Context;
use Koha::Authority::MergeRequest;

use parent qw(Koha::Objects);

=head1 NAME

Koha::Authority::MergeRequests - Koha::Objects class for need_merge_authorities

=head1 SYNOPSIS

use Koha::Authority::MergeRequests;

=head1 DESCRIPTION

Description

=head1 METHODS

=head2 INSTANCE METHODS

=head2 CLASS METHODS

=head3 reporting_tag_xml

    my $xml = Koha::Authority::MergeRequests->reporting_tag_xml({
        record => $record, tag => $tag,
    });

=cut

sub reporting_tag_xml {
    my ( $class, $params ) = @_;
    return if !$params->{record} || !$params->{tag};

    my $newrecord = MARC::Record->new;
    $newrecord->encoding( 'UTF-8' );
    my $reportfield = $params->{record}->field( $params->{tag} );
    return if !$reportfield;

    $newrecord->append_fields( $reportfield );
    return $newrecord->as_xml(
        C4::Context->preference('marcflavour') eq 'UNIMARC' ?
        'UNIMARCAUTH' :
        'MARC21'
    );
}

=head3 _type

Returns name of corresponding DBIC resultset

=cut

sub _type {
    return 'NeedMergeAuthority';
}

=head3 object_class

Returns name of corresponding Koha object class

=cut

sub object_class {
    return 'Koha::Authority::MergeRequest';
}

=head1 AUTHOR

Marcel de Rooy (Rijksmuseum)

Koha Development Team

=cut

1;

Lines 19-28 Link Here

(-)a/t/db_dependent/Koha/Authorities.t (-3 / +60 lines)
19		19
20	use Modern::Perl;	20	use Modern::Perl;
21		21
22	use Test::More tests => 3;	22	use Test::More tests => 5;
		23	use MARC::Field;
		24	use MARC::File::XML;
		25	use MARC::Record;
		26	use Test::Deep;
23		27
24	use Koha::Authority;	28	use Koha::Authority;
25	use Koha::Authorities;	29	use Koha::Authorities;
		30	use Koha::Authority::MergeRequest;
		31	use Koha::Authority::MergeRequests;
26	use Koha::Authority::Type;	32	use Koha::Authority::Type;
27	use Koha::Authority::Types;	33	use Koha::Authority::Types;
28	use Koha::Database;	34	use Koha::Database;
Lines 51-55 is( Koha::Authorities->search->count, $nb_of_authorities + 2, 'The 2 au Link Here
51	$new_authority_1->delete;	57	$new_authority_1->delete;
52	is( Koha::Authorities->search->count, $nb_of_authorities + 1, 'Delete should have deleted the authority' );	58	is( Koha::Authorities->search->count, $nb_of_authorities + 1, 'Delete should have deleted the authority' );
53		59
		60	subtest 'New merge request, method oldmarc' => sub {
		61	plan tests => 4;
		62
		63	my $marc = MARC::Record->new;
		64	$marc->append_fields(
		65	MARC::Field->new( '100', '', '', a => 'a', b => 'b_findme' ),
		66	MARC::Field->new( '200', '', '', a => 'aa' ),
		67	);
		68	my $req = Koha::Authority::MergeRequest->new({
		69	authid => $new_authority_2->authid,
		70	reportxml => 'Should be discarded',
		71	});
		72	is( $req->reportxml, undef, 'Reportxml is undef without oldrecord' );
		73
		74	$req = Koha::Authority::MergeRequest->new({
		75	authid => $new_authority_2->authid,
		76	oldrecord => $marc,
		77	});
		78	like( $req->reportxml, qr/b_findme/, 'Reportxml initialized' );
		79
		80	# Check if oldmarc is a MARC::Record and has one field
		81	is( ref( $req->oldmarc ), 'MARC::Record', 'Check oldmarc method' );
		82	is( scalar $req->oldmarc->fields, 1, 'Contains one field' );
		83	};
		84
		85	subtest 'Testing reporting_tag_xml in MergeRequests' => sub {
		86	plan tests => 2;
		87
		88	my $record = MARC::Record->new;
		89	$record->append_fields(
		90	MARC::Field->new( '024', '', '', a => 'aaa' ),
		91	MARC::Field->new( '100', '', '', a => 'Best author' ),
		92	MARC::Field->new( '234', '', '', a => 'Just a field' ),
		93	);
		94	my $xml = Koha::Authority::MergeRequests->reporting_tag_xml({
		95	record => $record, tag => '110',
		96	});
		97	is( $xml, undef, 'Expected no result for wrong tag' );
		98	$xml = Koha::Authority::MergeRequests->reporting_tag_xml({
		99	record => $record, tag => '100',
		100	});
		101	my $newrecord = MARC::Record->new_from_xml(
		102	$xml, 'UTF-8',
		103	C4::Context->preference('marcflavour') eq 'UNIMARC' ?
		104	'UNIMARCAUTH' :
		105	'MARC21',
		106	); # MARC format does not actually matter here
		107	cmp_deeply( $record->field('100')->subfields,
		108	$newrecord->field('100')->subfields,
		109	'Compare reporting tag in both records',
		110	);
		111	};
		112
54	$schema->storage->txn_rollback;	113	$schema->storage->txn_rollback;
55	1;
56	-

Return to bug 9988

Lines 19-30 package Koha::Authority; Link Here

(-)a/Koha/Authority.pm (-6 lines)
19		19
20	use Modern::Perl;	20	use Modern::Perl;
21		21
22	use Carp;
23
24	use Koha::Database;
25	use C4::Context;
26	use MARC::Record;
27
28	use base qw(Koha::Object);	22	use base qw(Koha::Object);
29		23
30	=head1 NAME	24	=head1 NAME

Line 0 Link Here

(-)a/Koha/Authority/MergeRequest.pm (+109 lines)
		1	package Koha::Authority::MergeRequest;
		2
		3	# Copyright Rijksmuseum 2017
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 3 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use Modern::Perl;
		21
		22	use parent qw(Koha::Object);
		23
		24	use Koha::Authorities;
		25	use Koha::Authority::MergeRequests;
		26	use Koha::Authority::Types;
		27
		28	=head1 NAME
		29
		30	Koha::Authority::MergeRequest - Koha::Object class for single need_merge_authorities record
		31
		32	=head1 SYNOPSIS
		33
		34	use Koha::Authority::MergeRequest;
		35
		36	=head1 DESCRIPTION
		37
		38	Description
		39
		40	=head1 METHODS
		41
		42	=head2 INSTANCE METHODS
		43
		44	=head3 new
		45
		46	$self->new({
		47	authid => $id,
		48	[ authid_new => $new, ]
		49	[ oldrecord => $marc, ]
		50	});
		51
		52	authid refers to the old authority id,
		53	authid_new optionally refers to a new different authority id
		54
		55	oldrecord is the MARC record belonging to the original authority record
		56
		57	This method returns an object and initializes the reportxml property.
		58
		59	=cut
		60
		61	sub new {
		62	my ( $class, $params ) = @_;
		63	my $oldrecord = delete $params->{oldrecord};
		64	delete $params->{reportxml}; # just making sure it is empty
65	my $self = $class->SUPER::new( $params );
66
67	if( $self->authid && $oldrecord ) {
68	my $auth = Koha::Authorities->find( $self->authid );
69	my $type = $auth ? Koha::Authority::Types->find($auth->authtypecode) : undef;
70	$self->reportxml( Koha::Authority::MergeRequests->reporting_tag_xml({ record => $oldrecord, tag => $type->auth_tag_to_report })) if $type;
71	}
72	return $self;
73	}
74
75	=head3 oldmarc
76
77	my $record = $self->oldmarc;
78
79	Convert reportxml back to MARC::Record.
80
81	=cut
82
83	sub oldmarc {
84	my ( $self ) = @_;
85	return if !$self->reportxml;
86	return MARC::Record->new_from_xml( $self->reportxml, 'UTF-8' );
87	}
88
89	=head2 CLASS METHODS
90
91	=head3 _type
92
93	Returns name of corresponding DBIC resultset
94
95	=cut
96
97	sub _type {
98	return 'NeedMergeAuthority';
99	}
100
101	=head1 AUTHOR
102
103	Marcel de Rooy (Rijksmuseum)
104
105	Koha Development Team
106
107	=cut
108
109	1;

Line 0 Link Here

(-)a/Koha/Authority/MergeRequests.pm (+100 lines)
		1	package Koha::Authority::MergeRequests;
		2
		3	# Copyright Rijksmuseum 2017
		4	#
		5	# This file is part of Koha.
		6	#
		7	# Koha is free software; you can redistribute it and/or modify it under the
		8	# terms of the GNU General Public License as published by the Free Software
		9	# Foundation; either version 3 of the License, or (at your option) any later
		10	# version.
		11	#
		12	# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
		13	# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
		14	# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
		15	#
		16	# You should have received a copy of the GNU General Public License along
		17	# with Koha; if not, write to the Free Software Foundation, Inc.,
		18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
		19
		20	use Modern::Perl;
		21	use MARC::File::XML;
		22	use MARC::Record;
		23
		24	use C4::Context;
		25	use Koha::Authority::MergeRequest;
		26
		27	use parent qw(Koha::Objects);
		28
		29	=head1 NAME
		30
		31	Koha::Authority::MergeRequests - Koha::Objects class for need_merge_authorities
		32
		33	=head1 SYNOPSIS
		34
		35	use Koha::Authority::MergeRequests;
		36
		37	=head1 DESCRIPTION
		38
		39	Description
		40
		41	=head1 METHODS
		42
		43	=head2 INSTANCE METHODS
		44
		45	=head2 CLASS METHODS
		46
		47	=head3 reporting_tag_xml
		48
		49	my $xml = Koha::Authority::MergeRequests->reporting_tag_xml({
		50	record => $record, tag => $tag,
		51	});
		52
		53	=cut
		54
		55	sub reporting_tag_xml {
		56	my ( $class, $params ) = @_;
		57	return if !$params->{record} \|\| !$params->{tag};
		58
		59	my $newrecord = MARC::Record->new;
		60	$newrecord->encoding( 'UTF-8' );
		61	my $reportfield = $params->{record}->field( $params->{tag} );
		62	return if !$reportfield;
		63
		64	$newrecord->append_fields( $reportfield );
65	return $newrecord->as_xml(
66	C4::Context->preference('marcflavour') eq 'UNIMARC' ?
67	'UNIMARCAUTH' :
68	'MARC21'
69	);
70	}
71
72	=head3 _type
73
74	Returns name of corresponding DBIC resultset
75
76	=cut
77
78	sub _type {
79	return 'NeedMergeAuthority';
80	}
81
82	=head3 object_class
83
84	Returns name of corresponding Koha object class
85
86	=cut
87
88	sub object_class {
89	return 'Koha::Authority::MergeRequest';
90	}
91
92	=head1 AUTHOR
93
94	Marcel de Rooy (Rijksmuseum)
95
96	Koha Development Team
97
98	=cut
99
100	1;