Bug 24546: Fix intentions of build_sample_item in Club/Hold.t
[koha.git] / t / db_dependent / Breeding.t
blob2114f52771f785c84ce5bf7a74fa1ae82199dbb2
1 #!/usr/bin/perl
3 # Copyright 2014 Rijksmuseum
5 # This file is part of Koha.
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.
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.
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.
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.
25 # TODO We need additional tests for Z3950SearchAuth, BreedingSearch
27 use Modern::Perl;
29 use FindBin;
30 use Test::More tests => 5;
31 use Test::Warn;
32 use t::lib::Mocks qw( mock_preference );
34 use C4::Context;
35 use C4::Breeding;
36 use Koha::Database;
37 use Koha::XSLT_Handler;
39 my $schema = Koha::Database->new->schema;
40 $schema->storage->txn_begin;
42 #Group 1: testing _build_query and _translate_query (part of Z3950Search)
43 subtest '_build_query' => sub {
44 plan tests => 14;
45 test_build_translate_query();
47 #Group 2: testing _create_connection (part of Z3950Search)
48 subtest '_create_connection' => sub {
49 plan tests => 5;
50 test_create_connection();
52 #Group 3: testing _do_xslt_proc (part of Z3950Search)
53 subtest '_do_xslt_proc' => sub {
54 plan tests => 6;
55 test_do_xslt();
57 #Group 4: testing _add_rowdata (part of Z3950Search)
58 subtest '_add_rowdata' => sub {
59 plan tests => 5;
60 test_add_rowdata();
63 subtest ImportBreedingAuth => sub {
64 plan tests => 4;
66 my $record = MARC::Record->new();
67 $record->append_fields(
68 MARC::Field->new('001', '4815162342'),
69 MARC::Field->new('100', ' ', ' ', a => 'Jansson, Tove'),
72 my $breedingid = C4::Breeding::ImportBreedingAuth($record,"kidclamp","UTF-8",'Jansson, Tove' );
73 ok( $breedingid, "We got a breeding id back");
74 my $breedingid_1 = C4::Breeding::ImportBreedingAuth($record,"kidclamp","UTF-8",'Jansson, Tove' );
75 is( $breedingid, $breedingid_1, "For the same record, we get the same id");
76 $breedingid_1 = C4::Breeding::ImportBreedingAuth($record,"marcelr","UTF-8",'Jansson, Tove' );
77 is( $breedingid, $breedingid_1, "For the same record in a different file, we get a new id");
78 my $record_1 = MARC::Record->new();
79 $record_1->append_fields(
80 MARC::Field->new('001', '8675309'),
81 MARC::Field->new('100', ' ', ' ', a => 'Cooper, Susan'),
83 my $breedingid_2 = C4::Breeding::ImportBreedingAuth($record_1,"kidclamp","UTF-8",'Cooper, Susan' );
84 isnt( $breedingid, $breedingid_2, "For a new record, we get a new id");
87 $schema->storage->txn_rollback;
89 #-------------------------------------------------------------------------------
91 sub test_build_translate_query {
92 my $str;
93 #First pass no parameters
94 my @queries= C4::Breeding::_bib_build_query( {} );
95 is( defined $queries[0] && $queries[0] eq '' && defined $queries[1] &&
96 $queries[1] eq '', 1, '_bib_build_query gets no parameters');
98 #We now pass one parameter
99 my $pars1= { isbn => '234567' };
100 @queries= C4::Breeding::_bib_build_query( $pars1 );
101 #Passed only one par: zquery should start with @attr 1=\d+
102 is( $queries[0] =~ /^\@attr 1=\d+/, 1, 'Z39.50 query with one parameter');
103 $str=$pars1->{isbn};
104 #Find back ISBN?
105 is( $queries[0] =~ /$str/, 1, 'First Z39.50 query contains ISBN');
106 #SRU query should contain translation for ISBN
107 my $server= { sru_fields => 'isbn=ie-es-bee-en,srchany=overal' };
108 my $squery= C4::Breeding::_translate_query( $server, $queries[1] );
109 is( $squery =~ /ie-es-bee-en/, 1, 'SRU query has translated ISBN index');
110 #Another try with fallback to any
111 $server= { sru_fields => 'srchany=overal' };
112 $squery= C4::Breeding::_translate_query( $server, $queries[1] );
113 is( $squery =~ /overal/, 1, 'SRU query fallback to translated any');
114 #Another try even without any
115 $server= { sru_fields => 'this,is,bad,input' };
116 $squery= C4::Breeding::_translate_query( $server, $queries[1] );
117 is( $squery =~ /$str/ && $squery !~ /=/, 1, 'SRU query without indexes');
119 #We now pass two parameters
120 my $pars2= { isbn => '123456', title => 'You should read this.' };
121 @queries= C4::Breeding::_bib_build_query( $pars2 );
122 #The Z39.50 query should start with @and (we passed two pars)
123 is( $queries[0] =~ /^\@and/, 1, 'Second Z39.50 query starts with @and');
124 #We should also find two @attr 1=\d+
125 my @matches= $queries[0] =~ /\@attr 1=\d+/g;
126 is( @matches == 2, 1, 'Second Z39.50 query includes two @attr 1=');
127 #We should find text of both parameters in the query
128 $str= $pars2->{isbn};
129 is( $queries[0] =~ /\"$str\"/, 1,
130 'Second query contains ISBN enclosed by double quotes');
131 $str= $pars2->{title};
132 is( $queries[0] =~ /\"$str\"/, 1,
133 'Second query contains title enclosed by double quotes');
135 #SRU revisited
136 $server= { sru_fields => 'isbn=nb,title=dc.title,srchany=overal' };
137 $squery= C4::Breeding::_translate_query( $server, $queries[1] );
138 is ( $squery =~ /dc.title/ && $squery =~ / and / &&
139 $squery =~ /nb=/, 1, 'SRU query with two parameters');
141 #We now pass a third wrong parameter (should not make a difference)
142 my $pars3= { isbn => '123456', title => 'You should read this.', xyz => 1 };
143 my @queries2= C4::Breeding::_bib_build_query( $pars3 );
144 is( $queries[0] eq $queries2[0] && $queries[1] eq $queries2[1], 1,
145 'Third query makes no difference');
147 # Check that indexes with equal signs are ok
148 $server = { sru_fields => 'subjectsubdiv=aut.type=ram_pe and aut.accesspoint' };
149 my $pars4 = { subjectsubdiv => 'mysubjectsubdiv' };
150 @queries = C4::Breeding::_auth_build_query( $pars4 );
151 my $zquery = C4::Breeding::_translate_query( $server, $queries[1] );
152 is ( $zquery, 'aut.type=ram_pe and aut.accesspoint="mysubjectsubdiv"', 'SRU query with equal sign in index');
154 # Check that indexes with double-quotes are ok
155 $server = { sru_fields => 'subject=(aut.type any "geo ram_nc ram_ge ram_pe ram_co") and aut.accesspoint' };
156 my $pars5 = { subject => 'mysubject' };
157 @queries = C4::Breeding::_auth_build_query( $pars5 );
158 $zquery = C4::Breeding::_translate_query( $server, $queries[1] );
159 is ( $zquery, '(aut.type any "geo ram_nc ram_ge ram_pe ram_co") and aut.accesspoint="mysubject"', 'SRU query with double quotes in index');
162 sub test_create_connection {
163 #TODO This is just a *simple* start
165 my $str;
166 my $server= { servertype => 'zed', db => 'MyDatabase',
167 host => 'really-not-a-domain-i-hope.nl', port => 80,
169 my $obj= C4::Breeding::_create_connection( $server );
171 #We should get back an object, even if it did not connect
172 is( ref $obj eq 'ZOOM::Connection', 1, 'Got back a ZOOM connection');
174 #Remember: it is async
175 my $i= ZOOM::event( [ $obj ] );
176 if( $i == 1 ) {
177 #We could examine ZOOM::event_str( $obj->last_event )
178 #For now we are satisfied with an error message
179 #Probably: Connect failed
180 is( ($obj->errmsg//'') ne '', 1, 'Connection failed as expected');
182 } else {
183 ok( 1, 'No ZOOM event found: skipped errmsg' );
186 #Checking the databaseName for Z39.50 server
187 $str=$obj->option('databaseName')//'';
188 is( $str eq $server->{db}, 1, 'Check ZOOM option for database');
190 #Another test for SRU
191 $obj->destroy();
192 $server->{ servertype } = 'sru';
193 $server->{ sru_options } = 'just_testing=fun';
194 $obj= C4::Breeding::_create_connection( $server );
195 #In this case we expect no databaseName, but we expect just_testing
196 $str=$obj->option('databaseName');
197 is( $str, undef, 'No databaseName for SRU connection');
198 $str=$obj->option('just_testing')//'';
199 is( $str eq 'fun', 1, 'Additional ZOOM option for SRU found');
200 $obj->destroy();
203 sub test_do_xslt {
204 my $biblio = MARC::Record->new();
205 $biblio->append_fields(
206 MARC::Field->new('100', ' ', ' ', a => 'John Writer'),
207 MARC::Field->new('245', ' ', ' ', a => 'Just a title'),
209 my $file= $FindBin::Bin.'/XSLT_Handler/test01.xsl';
210 my $server= { add_xslt => $file };
211 my $engine=Koha::XSLT_Handler->new;
213 #ready for the main test
214 my @res = C4::Breeding::_do_xslt_proc( $biblio, $server, $engine );
215 is( $res[1], undef, 'No error returned' );
216 is( ref $res[0], 'MARC::Record', 'Got back MARC record');
217 is( $res[0]->subfield('990','a'), 'I saw you', 'Found 990a in the record');
219 #forcing an error on the xslt side
220 $server->{add_xslt} = 'notafile.xsl';
221 @res = C4::Breeding::_do_xslt_proc( $biblio, $server, $engine );
222 is( $res[1], Koha::XSLT_Handler::XSLTH_ERR_2, 'Error code found' );
223 #We still expect the original record back
224 is( ref $res[0], 'MARC::Record', 'Still got back MARC record' );
225 is ( $res[0]->subfield('245','a'), 'Just a title',
226 'At least the title is the same :)' );
229 sub test_add_rowdata {
230 t::lib::Mocks::mock_preference('AdditionalFieldsInZ3950ResultSearch','');
232 my $row = {
233 biblionumber => 0,
234 server => "testServer",
235 breedingid => 0
238 my $biblio = MARC::Record->new();
239 $biblio->append_fields(
240 MARC::Field->new('245', ' ', ' ', a => 'Just a title'), #title
243 my $returned_row = C4::Breeding::_add_rowdata($row, $biblio);
245 is($returned_row->{title}, "Just a title", "_add_rowdata returns the title of a biblio");
246 is($returned_row->{addnumberfields}[0], undef, "_add_rowdata returns undef if it has no additionnal field");
248 t::lib::Mocks::mock_preference('AdditionalFieldsInZ3950ResultSearch',"245\$a, 035\$a");
250 $row = {
251 biblionumber => 0,
252 server => "testServer",
253 breedingid => 0
255 $biblio = MARC::Record->new();
256 $biblio->append_fields(
257 MARC::Field->new('245', ' ', ' ', a => 'Just a title'), #title
258 MARC::Field->new('035', ' ', ' ', a => 'First 035'),
259 MARC::Field->new('035', ' ', ' ', a => 'Second 035')
261 $returned_row = C4::Breeding::_add_rowdata($row, $biblio);
263 is($returned_row->{title}, "Just a title", "_add_rowdata returns the title of a biblio");
264 is($returned_row->{addnumberfields}[0], "245\$a", "_add_rowdata returns the field number chosen in the AdditionalFieldsInZ3950ResultSearch preference");
266 # Test repeatble tags,the trailing whitespace is a normal side-effect of _add_custom_row_data
267 is_deeply(\$returned_row->{"035\$a"}, \["First 035 ", "Second 035 "],"_add_rowdata supports repeatable tags");