Attachment #96743 for bug #24267

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





=head2 ImportBreedingAuth

ImportBreedingAuth( $marcrecord, $filename, $encoding, $heading );

    ImportBreedingAuth imports MARC records in the reservoir (import_records table) or returns their id if they already exist.

=cut

sub ImportBreedingAuth {
    my ( $marcrecord, $filename, $encoding, $heading ) = @_;
    my $dbh = C4::Context->dbh;

    my $batch_id = GetZ3950BatchId($filename);
    my $searchbreeding = $dbh->prepare("select import_record_id from import_auths where control_number=? and authorized_heading=?");

    my $marcflavour = C4::Context->preference('marcflavour');
    my $marc_type = $marcflavour eq 'UNIMARC' ? 'UNIMARCAUTH' : $marcflavour;

    my $heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord });

    my $heading_authtype_code = GuessAuthTypeCode($marcrecord);

    my $controlnumber = $marcrecord->field('001')->data;
    my $breedingid;

    # Normalize the record so it doesn't have separated diacritics
    SetUTF8Flag($marcrecord);

    $searchbreeding->execute($controlnumber,$heading);
    my ($breedingid) = $searchbreeding->fetchrow;

    return $breedingid if $breedingid;
    $breedingid = AddAuthToBatch($batch_id, 0, $marcrecord, $encoding);

                            $heading_authtype_code = GuessAuthTypeCode($marcrecord);
                            $heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord });

                            my $breedingid = ImportBreedingAuth( $marcrecord, $serverhost[$k], $encoding[$k], $heading );
                            my %row_data;
                            $row_data{server}       = $servers[$k]->{'servername'};
                            $row_data{breedingid}   = $breedingid;




# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

# Main object of this unit test is the Breeding module and its subroutines
# A start has been made to define tests for subroutines of Z3950Search.
# These subroutines are actually internal, but these tests may pave the way for
# a more comprehensive test of Z3950Search itself.
#
# TODO We need additional tests for Z3950SearchAuth, BreedingSearch

use Modern::Perl;

use FindBin;


use C4::Context;
use C4::Breeding;
use Koha::Database;
use Koha::XSLT_Handler;

my $schema = Koha::Database->new->schema;
$schema->storage->txn_begin;
#These subroutines are actually internal, but these tests may pave the way for
#a more comprehensive test of Z3950Search itself.
#TODO
#Furthermore, we need additional tests for:
#Z3950SearchAuth, BreedingSearch, ImportBreedingAuth

#Group 1: testing _build_query and _translate_query (part of Z3950Search)
subtest '_build_query' => sub {

        MARC::Field->new('100', ' ', ' ', a => 'Jansson, Tove'),
    );

    my $breedingid = C4::Breeding::ImportBreedingAuth($record,"kidclamp","UTF-8",'Jansson, Tove' );
    ok( $breedingid, "We got a breeding id back");
    my $breedingid_1 = C4::Breeding::ImportBreedingAuth($record,"kidclamp","UTF-8",'Jansson, Tove' );
    is( $breedingid, $breedingid_1, "For the same record, we get the same id");
    $breedingid_1 = C4::Breeding::ImportBreedingAuth($record,"marcelr","UTF-8",'Jansson, Tove' );
    is( $breedingid, $breedingid_1, "For the same record in a different file, we get a new id");
    my $record_1 = MARC::Record->new();
    $record_1->append_fields(
        MARC::Field->new('001', '8675309'),
        MARC::Field->new('100', ' ', ' ', a => 'Cooper, Susan'),
    );
    my $breedingid_2 = C4::Breeding::ImportBreedingAuth($record_1,"kidclamp","UTF-8",'Cooper, Susan' );
    isnt( $breedingid, $breedingid_2, "For a new record, we get a new id");
};

$schema->storage->txn_rollback;

#-------------------------------------------------------------------------------

sub test_build_translate_query {
- 

Return to bug 24267

Lines 483-516 sub _translate_query { #SRU query adjusted per server cf. srufields column Link Here

(-)a/C4/Breeding.pm (-12 / +4 lines)
483		483
484	=head2 ImportBreedingAuth	484	=head2 ImportBreedingAuth
485		485
486	ImportBreedingAuth($marcrecords,$overwrite_auth,$filename,$encoding);	486	ImportBreedingAuth( $marcrecord, $filename, $encoding, $heading );
487		487
488	ImportBreedingAuth imports MARC records in the reservoir (import_records table) or returns their id if they already exist.	488	ImportBreedingAuth imports MARC records in the reservoir (import_records table) or returns their id if they already exist.
489		489
490	=cut	490	=cut
491		491
492	sub ImportBreedingAuth {	492	sub ImportBreedingAuth {
493	my ($marcrecord,$filename,$encoding) = @_;	493	my ( $marcrecord, $filename, $encoding, $heading ) = @_;
494	my $dbh = C4::Context->dbh;	494	my $dbh = C4::Context->dbh;
495		495
496	my $batch_id = GetZ3950BatchId($filename);	496	my $batch_id = GetZ3950BatchId($filename);
497	my $searchbreeding = $dbh->prepare("select import_record_id from import_auths where control_number=? and authorized_heading=?");	497	my $searchbreeding = $dbh->prepare("select import_record_id from import_auths where control_number=? and authorized_heading=?");
498		498
499	my $marcflavour = C4::Context->preference('marcflavour');
500	my $marc_type = $marcflavour eq 'UNIMARC' ? 'UNIMARCAUTH' : $marcflavour;
501
502	my $heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord });
503
504	my $heading_authtype_code = GuessAuthTypeCode($marcrecord);
505
506	my $controlnumber = $marcrecord->field('001')->data;	499	my $controlnumber = $marcrecord->field('001')->data;
507	my $breedingid;
508		500
509	# Normalize the record so it doesn't have separated diacritics	501	# Normalize the record so it doesn't have separated diacritics
510	SetUTF8Flag($marcrecord);	502	SetUTF8Flag($marcrecord);
511		503
512	$searchbreeding->execute($controlnumber,$heading);	504	$searchbreeding->execute($controlnumber,$heading);
513	($breedingid) = $searchbreeding->fetchrow;	505	my ($breedingid) = $searchbreeding->fetchrow;
514		506
515	return $breedingid if $breedingid;	507	return $breedingid if $breedingid;
516	$breedingid = AddAuthToBatch($batch_id, 0, $marcrecord, $encoding);	508	$breedingid = AddAuthToBatch($batch_id, 0, $marcrecord, $encoding);
Lines 614-620 sub Z3950SearchAuth { Link Here
614	$heading_authtype_code = GuessAuthTypeCode($marcrecord);	606	$heading_authtype_code = GuessAuthTypeCode($marcrecord);
615	$heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord });	607	$heading = C4::AuthoritiesMarc::GetAuthorizedHeading({ record => $marcrecord });
616		608
617	my $breedingid = ImportBreedingAuth( $marcrecord, $serverhost[$k], $encoding[$k]);	609	my $breedingid = ImportBreedingAuth( $marcrecord, $serverhost[$k], $encoding[$k], $heading );
618	my %row_data;	610	my %row_data;
619	$row_data{server} = $servers[$k]->{'servername'};	611	$row_data{server} = $servers[$k]->{'servername'};
620	$row_data{breedingid} = $breedingid;	612	$row_data{breedingid} = $breedingid;

Lines 17-22 Link Here

(-)a/t/db_dependent/Breeding.t (-12 / +16 lines)
17	# with Koha; if not, write to the Free Software Foundation, Inc.,	17	# with Koha; if not, write to the Free Software Foundation, Inc.,
18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.	18	# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19		19
		20	# Main object of this unit test is the Breeding module and its subroutines
		21	# A start has been made to define tests for subroutines of Z3950Search.
		22	# These subroutines are actually internal, but these tests may pave the way for
		23	# a more comprehensive test of Z3950Search itself.
		24	#
		25	# TODO We need additional tests for Z3950SearchAuth, BreedingSearch
		26
20	use Modern::Perl;	27	use Modern::Perl;
21		28
22	use FindBin;	29	use FindBin;
Lines 26-40 use t::lib::Mocks qw( mock_preference ); Link Here
26		33
27	use C4::Context;	34	use C4::Context;
28	use C4::Breeding;	35	use C4::Breeding;
		36	use Koha::Database;
29	use Koha::XSLT_Handler;	37	use Koha::XSLT_Handler;
30		38
31	#Main object of this unit test is the Breeding module and its subroutines	39	my $schema = Koha::Database->new->schema;
32	#A start has been made to define tests for subroutines of Z3950Search.	40	$schema->storage->txn_begin;
33	#These subroutines are actually internal, but these tests may pave the way for
34	#a more comprehensive test of Z3950Search itself.
35	#TODO
36	#Furthermore, we need additional tests for:
37	#Z3950SearchAuth, BreedingSearch, ImportBreedingAuth
38		41
39	#Group 1: testing _build_query and _translate_query (part of Z3950Search)	42	#Group 1: testing _build_query and _translate_query (part of Z3950Search)
40	subtest '_build_query' => sub {	43	subtest '_build_query' => sub {
Lines 66-86 subtest ImportBreedingAuth => sub { Link Here
66	MARC::Field->new('100', ' ', ' ', a => 'Jansson, Tove'),	69	MARC::Field->new('100', ' ', ' ', a => 'Jansson, Tove'),
67	);	70	);
68		71
69	my $breedingid = C4::Breeding::ImportBreedingAuth($record,"kidclamp","UTF8");	72	my $breedingid = C4::Breeding::ImportBreedingAuth($record,"kidclamp","UTF-8",'Jansson, Tove' );
70	ok( $breedingid, "We got a breeding id back");	73	ok( $breedingid, "We got a breeding id back");
71	my $breedingid_1 = C4::Breeding::ImportBreedingAuth($record,"kidclamp","UTF8");	74	my $breedingid_1 = C4::Breeding::ImportBreedingAuth($record,"kidclamp","UTF-8",'Jansson, Tove' );
72	is( $breedingid, $breedingid_1, "For the same record, we get the same id");	75	is( $breedingid, $breedingid_1, "For the same record, we get the same id");
73	$breedingid_1 = C4::Breeding::ImportBreedingAuth($record,"marcelr","UTF8");	76	$breedingid_1 = C4::Breeding::ImportBreedingAuth($record,"marcelr","UTF-8",'Jansson, Tove' );
74	is( $breedingid, $breedingid_1, "For the same record in a different file, we get a new id");	77	is( $breedingid, $breedingid_1, "For the same record in a different file, we get a new id");
75	my $record_1 = MARC::Record->new();	78	my $record_1 = MARC::Record->new();
76	$record_1->append_fields(	79	$record_1->append_fields(
77	MARC::Field->new('001', '8675309'),	80	MARC::Field->new('001', '8675309'),
78	MARC::Field->new('100', ' ', ' ', a => 'Cooper, Susan'),	81	MARC::Field->new('100', ' ', ' ', a => 'Cooper, Susan'),
79	);	82	);
80	my $breedingid_2 = C4::Breeding::ImportBreedingAuth($record_1,"kidclamp","UTF8");	83	my $breedingid_2 = C4::Breeding::ImportBreedingAuth($record_1,"kidclamp","UTF-8",'Cooper, Susan' );
81	isnt( $breedingid, $breedingid_2, "For a new record, we get a new id");	84	isnt( $breedingid, $breedingid_2, "For a new record, we get a new id");
82	};	85	};
83		86
		87	$schema->storage->txn_rollback;
		88
84	#-------------------------------------------------------------------------------	89	#-------------------------------------------------------------------------------
85		90
86	sub test_build_translate_query {	91	sub test_build_translate_query {
87	-