3 # Copyright 2014 Rijksmuseum
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
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
28 use File::Temp qw/tempfile/;
29 use Test::More tests => 6;
32 use t::lib::Mocks qw( mock_preference );
33 use t::lib::TestBuilder;
40 my $schema = Koha::Database->new->schema;
41 my $builder = t::lib::TestBuilder->new;
42 $schema->storage->txn_begin;
44 #Group 1: testing _build_query and _translate_query (part of Z3950Search)
45 subtest '_build_query' => sub {
47 test_build_translate_query();
49 #Group 2: testing _create_connection (part of Z3950Search)
50 subtest '_create_connection' => sub {
52 test_create_connection();
54 #Group 3: testing _do_xslt_proc (part of Z3950Search)
55 subtest '_do_xslt_proc' => sub {
59 #Group 4: testing _add_custom_field_rowdata (part of Z3950Search)
60 subtest '_add_custom_field_rowdata' => sub {
62 test_add_custom_field_rowdata();
65 subtest ImportBreedingAuth => sub {
68 my $record = MARC::Record->new();
69 $record->append_fields(
70 MARC::Field->new('001', '4815162342'),
71 MARC::Field->new('100', ' ', ' ', a => 'Jansson, Tove'),
74 my $breedingid = C4::Breeding::ImportBreedingAuth($record,"kidclamp","UTF-8",'Jansson, Tove' );
75 ok( $breedingid, "We got a breeding id back");
76 my $breedingid_1 = C4::Breeding::ImportBreedingAuth($record,"kidclamp","UTF-8",'Jansson, Tove' );
77 is( $breedingid, $breedingid_1, "For the same record, we get the same id");
78 $breedingid_1 = C4::Breeding::ImportBreedingAuth($record,"marcelr","UTF-8",'Jansson, Tove' );
79 is( $breedingid, $breedingid_1, "For the same record in a different file, we get a new id");
80 my $record_1 = MARC::Record->new();
81 $record_1->append_fields(
82 MARC::Field->new('001', '8675309'),
83 MARC::Field->new('100', ' ', ' ', a => 'Cooper, Susan'),
85 my $breedingid_2 = C4::Breeding::ImportBreedingAuth($record_1,"kidclamp","UTF-8",'Cooper, Susan' );
86 isnt( $breedingid, $breedingid_2, "For a new record, we get a new id");
89 subtest BreedingSearch => sub {
92 my $import_biblio_1 = $builder->build({ source => 'ImportBiblio', value => {
93 title => 'Unique title the first adventure',
94 author => 'Firstnamey Surnamey',
98 my $import_biblio_2 = $builder->build({ source => 'ImportBiblio', value => {
99 title => 'Unique title the adventure continues',
100 author => 'Firstnamey Surnamey',
101 isbn => '9798200834976'
105 my ($count, @results) = C4::Breeding::BreedingSearch("Firstnamey Surnamey");
106 is( $count, 2, "Author search returns two results");
108 ($count, @results) = C4::Breeding::BreedingSearch("first adventure");
109 is( $count, 1, "Title search returns one result");
111 ($count, @results) = C4::Breeding::BreedingSearch("adventure continues");
112 is( $count, 1, "Title search returns one result");
114 ($count, @results) = C4::Breeding::BreedingSearch("9781407239965");
115 is( $count, 1, "ISBN search matches normalized DB value");
117 ($count, @results) = C4::Breeding::BreedingSearch("9798200834976");
118 is( $count, 1, "ISBN search for 13 digit ISBN matches 13 digit ISBN in database");
119 # FIXME - Import doesn't currently store these, but this proves the search works
122 $schema->storage->txn_rollback;
124 #-------------------------------------------------------------------------------
126 sub test_build_translate_query {
128 #First pass no parameters
129 my @queries= C4::Breeding::_bib_build_query( {} );
130 is( defined $queries[0] && $queries[0] eq '' && defined $queries[1] &&
131 $queries[1] eq '', 1, '_bib_build_query gets no parameters');
133 #We now pass one parameter
134 my $pars1= { isbn => '234567' };
135 @queries= C4::Breeding::_bib_build_query( $pars1 );
136 #Passed only one par: zquery should start with @attr 1=\d+
137 is( $queries[0] =~ /^\@attr 1=\d+/, 1, 'Z39.50 query with one parameter');
140 is( $queries[0] =~ /$str/, 1, 'First Z39.50 query contains ISBN');
141 #SRU query should contain translation for ISBN
142 my $server= { sru_fields => 'isbn=ie-es-bee-en,srchany=overal' };
143 my $squery= C4::Breeding::_translate_query( $server, $queries[1] );
144 is( $squery =~ /ie-es-bee-en/, 1, 'SRU query has translated ISBN index');
145 #Another try with fallback to any
146 $server= { sru_fields => 'srchany=overal' };
147 $squery= C4::Breeding::_translate_query( $server, $queries[1] );
148 is( $squery =~ /overal/, 1, 'SRU query fallback to translated any');
149 #Another try even without any
150 $server= { sru_fields => 'this,is,bad,input' };
151 $squery= C4::Breeding::_translate_query( $server, $queries[1] );
152 is( $squery =~ /$str/ && $squery !~ /=/, 1, 'SRU query without indexes');
154 #We now pass two parameters
155 my $pars2= { isbn => '123456', title => 'You should read this.' };
156 @queries= C4::Breeding::_bib_build_query( $pars2 );
157 #The Z39.50 query should start with @and (we passed two pars)
158 is( $queries[0] =~ /^\@and/, 1, 'Second Z39.50 query starts with @and');
159 #We should also find two @attr 1=\d+
160 my @matches= $queries[0] =~ /\@attr 1=\d+/g;
161 is( @matches == 2, 1, 'Second Z39.50 query includes two @attr 1=');
162 #We should find text of both parameters in the query
163 $str= $pars2->{isbn};
164 is( $queries[0] =~ /\"$str\"/, 1,
165 'Second query contains ISBN enclosed by double quotes');
166 $str= $pars2->{title};
167 is( $queries[0] =~ /\"$str\"/, 1,
168 'Second query contains title enclosed by double quotes');
171 $server= { sru_fields => 'isbn=nb,title=dc.title,srchany=overal' };
172 $squery= C4::Breeding::_translate_query( $server, $queries[1] );
173 is ( $squery =~ /dc.title/ && $squery =~ / and / &&
174 $squery =~ /nb=/, 1, 'SRU query with two parameters');
176 #We now pass a third wrong parameter (should not make a difference)
177 my $pars3= { isbn => '123456', title => 'You should read this.', xyz => 1 };
178 my @queries2= C4::Breeding::_bib_build_query( $pars3 );
179 is( $queries[0] eq $queries2[0] && $queries[1] eq $queries2[1], 1,
180 'Third query makes no difference');
182 # Check that indexes with equal signs are ok
183 $server = { sru_fields => 'subjectsubdiv=aut.type=ram_pe and aut.accesspoint' };
184 my $pars4 = { subjectsubdiv => 'mysubjectsubdiv' };
185 @queries = C4::Breeding::_auth_build_query( $pars4 );
186 my $zquery = C4::Breeding::_translate_query( $server, $queries[1] );
187 is ( $zquery, 'aut.type=ram_pe and aut.accesspoint="mysubjectsubdiv"', 'SRU query with equal sign in index');
189 # Check that indexes with double-quotes are ok
190 $server = { sru_fields => 'subject=(aut.type any "geo ram_nc ram_ge ram_pe ram_co") and aut.accesspoint' };
191 my $pars5 = { subject => 'mysubject' };
192 @queries = C4::Breeding::_auth_build_query( $pars5 );
193 $zquery = C4::Breeding::_translate_query( $server, $queries[1] );
194 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');
197 sub test_create_connection {
198 #TODO This is just a *simple* start
201 my $server= { servertype => 'zed', db => 'MyDatabase',
202 host => 'really-not-a-domain-i-hope.nl', port => 80,
204 my $obj= C4::Breeding::_create_connection( $server );
206 #We should get back an object, even if it did not connect
207 is( ref $obj eq 'ZOOM::Connection', 1, 'Got back a ZOOM connection');
209 #Remember: it is async
210 my $i= ZOOM::event( [ $obj ] );
212 #We could examine ZOOM::event_str( $obj->last_event )
213 #For now we are satisfied with an error message
214 #Probably: Connect failed
215 is( ($obj->errmsg//'') ne '', 1, 'Connection failed as expected');
218 ok( 1, 'No ZOOM event found: skipped errmsg' );
221 #Checking the databaseName for Z39.50 server
222 $str=$obj->option('databaseName')//'';
223 is( $str eq $server->{db}, 1, 'Check ZOOM option for database');
225 #Another test for SRU
227 $server->{ servertype } = 'sru';
228 $server->{ sru_options } = 'just_testing=fun';
229 $obj= C4::Breeding::_create_connection( $server );
230 #In this case we expect no databaseName, but we expect just_testing
231 $str=$obj->option('databaseName');
232 is( $str, undef, 'No databaseName for SRU connection');
233 $str=$obj->option('just_testing')//'';
234 is( $str eq 'fun', 1, 'Additional ZOOM option for SRU found');
239 my $biblio = MARC::Record->new();
240 $biblio->append_fields(
241 MARC::Field->new('100', ' ', ' ', a => 'John Writer'),
242 MARC::Field->new('245', ' ', ' ', a => 'Just a title'),
244 my $file= xsl_file();
245 my $server= { add_xslt => $file };
246 my $engine=Koha::XSLT::Base->new;
248 #ready for the main test
249 my @res = C4::Breeding::_do_xslt_proc( $biblio, $server, $engine );
250 is( $res[1], undef, 'No error returned' );
251 is( ref $res[0], 'MARC::Record', 'Got back MARC record');
252 is( $res[0]->subfield('990','a'), 'I saw you', 'Found 990a in the record');
254 #forcing an error on the xslt side
255 $server->{add_xslt} = 'notafile.xsl';
256 @res = C4::Breeding::_do_xslt_proc( $biblio, $server, $engine );
257 is( $res[1], Koha::XSLT::Base::XSLTH_ERR_2, 'Error code found' );
258 #We still expect the original record back
259 is( ref $res[0], 'MARC::Record', 'Still got back MARC record' );
260 is ( $res[0]->subfield('245','a'), 'Just a title',
261 'At least the title is the same :)' );
264 sub test_add_custom_field_rowdata {
267 server => "testServer",
269 title => "Just a title"
272 my $biblio = MARC::Record->new();
273 $biblio->append_fields(
274 MARC::Field->new('245', ' ', ' ', a => 'Just a title'),
275 MARC::Field->new('035', ' ', ' ', a => 'First 035'),
276 MARC::Field->new('035', ' ', ' ', a => 'Second 035')
279 t::lib::Mocks::mock_preference('AdditionalFieldsInZ3950ResultSearch',"245\$a, 035\$a");
281 my $returned_row = C4::Breeding::_add_custom_field_rowdata($row, $biblio);
283 is($returned_row->{title}, "Just a title", "_add_rowdata returns the title of a biblio");
284 is($returned_row->{addnumberfields}[0], "245\$a", "_add_rowdata returns the field number chosen in the AdditionalFieldsInZ3950ResultSearch preference");
286 # Test repeatble tags,the trailing whitespace is a normal side-effect of _add_custom_field_row_data
287 is_deeply(\$returned_row->{"035\$a"}, \["First 035 ", "Second 035 "],"_add_rowdata supports repeatable tags");
291 return mytempfile( q{<xsl:stylesheet version="1.0"
292 xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
293 xmlns:marc="http://www.loc.gov/MARC21/slim"
295 <xsl:output method="xml" version="1.0" encoding="UTF-8" indent="yes"/>
297 <xsl:template match="record|marc:record">
299 <xsl:apply-templates/>
300 <datafield tag="990" ind1='' ind2=''>
302 <xsl:text>I saw you</xsl:text>
308 <xsl:template match="node()">
309 <xsl:copy select=".">
310 <xsl:copy-of select="@*"/>
311 <xsl:apply-templates/>
314 </xsl:stylesheet>} );
318 my ( $fh, $fn ) = tempfile( SUFFIX => '.xsl', UNLINK => 1 );