|
Line 0
Link Here
|
|
|
1 |
#!/usr/bin/perl |
| 2 |
|
| 3 |
# Copyright 2014 Rijksmuseum |
| 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 FindBin; |
| 23 |
use Test::More tests => 3; |
| 24 |
|
| 25 |
use C4::Breeding; |
| 26 |
use Koha::XSLT_Handler; |
| 27 |
|
| 28 |
#Main object of this unit test is the Breeding module and its subroutines |
| 29 |
#A start has been made to define tests for subroutines of Z3950Search. |
| 30 |
#These subroutines are actually internal, but these tests may pave the way for |
| 31 |
#a more comprehensive test of Z3950Search itself. |
| 32 |
#TODO |
| 33 |
#Furthermore, we need additional tests for: |
| 34 |
#Z3950SearchAuth, BreedingSearch, ImportBreedingAuth |
| 35 |
|
| 36 |
#Group 1: testing _build_query and _translate_query (part of Z3950Search) |
| 37 |
subtest '_build_query' => sub { |
| 38 |
plan tests => 12; |
| 39 |
test_build_translate_query(); |
| 40 |
}; |
| 41 |
#Group 2: testing _create_connection (part of Z3950Search) |
| 42 |
subtest '_create_connection' => sub { |
| 43 |
plan tests => 5; |
| 44 |
test_create_connection(); |
| 45 |
}; |
| 46 |
#Group 3: testing _do_xslt_proc (part of Z3950Search) |
| 47 |
subtest '_do_xslt_proc' => sub { |
| 48 |
plan tests => 6; |
| 49 |
test_do_xslt(); |
| 50 |
}; |
| 51 |
|
| 52 |
#------------------------------------------------------------------------------- |
| 53 |
|
| 54 |
sub test_build_translate_query { |
| 55 |
my $str; |
| 56 |
#First pass no parameters |
| 57 |
my @queries= C4::Breeding::_build_query( {} ); |
| 58 |
is( defined $queries[0] && $queries[0] eq '' && defined $queries[1] && |
| 59 |
$queries[1] eq '', 1, '_build_query gets no parameters'); |
| 60 |
|
| 61 |
#We now pass one parameter |
| 62 |
my $pars1= { isbn => '234567' }; |
| 63 |
@queries= C4::Breeding::_build_query( $pars1 ); |
| 64 |
#Passed only one par: zquery should start with @attr 1=\d+ |
| 65 |
is( $queries[0] =~ /^\@attr 1=\d+/, 1, 'Z39.50 query with one parameter'); |
| 66 |
$str=$pars1->{isbn}; |
| 67 |
#Find back ISBN? |
| 68 |
is( $queries[0] =~ /$str/, 1, 'First Z39.50 query contains ISBN'); |
| 69 |
#SRU query should contain translation for ISBN |
| 70 |
my $server= { sru_fields => 'isbn=ie-es-bee-en,srchany=overal' }; |
| 71 |
my $squery= C4::Breeding::_translate_query( $server, $queries[1] ); |
| 72 |
is( $squery =~ /ie-es-bee-en/, 1, 'SRU query has translated ISBN index'); |
| 73 |
#Another try with fallback to any |
| 74 |
$server= { sru_fields => 'srchany=overal' }; |
| 75 |
$squery= C4::Breeding::_translate_query( $server, $queries[1] ); |
| 76 |
is( $squery =~ /overal/, 1, 'SRU query fallback to translated any'); |
| 77 |
#Another try even without any |
| 78 |
$server= { sru_fields => 'this,is,bad,input' }; |
| 79 |
$squery= C4::Breeding::_translate_query( $server, $queries[1] ); |
| 80 |
is( $squery =~ /$str/ && $squery !~ /=/, 1, 'SRU query without indexes'); |
| 81 |
|
| 82 |
#We now pass two parameters |
| 83 |
my $pars2= { isbn => '123456', title => 'You should read this.' }; |
| 84 |
@queries= C4::Breeding::_build_query( $pars2 ); |
| 85 |
#The Z39.50 query should start with @and (we passed two pars) |
| 86 |
is( $queries[0] =~ /^\@and/, 1, 'Second Z39.50 query starts with @and'); |
| 87 |
#We should also find two @attr 1=\d+ |
| 88 |
my @matches= $queries[0] =~ /\@attr 1=\d+/g; |
| 89 |
is( @matches == 2, 1, 'Second Z39.50 query includes two @attr 1='); |
| 90 |
#We should find text of both parameters in the query |
| 91 |
$str= $pars2->{isbn}; |
| 92 |
is( $queries[0] =~ /$str/, 1, 'Second query contains ISBN'); |
| 93 |
$str= $pars2->{title}; |
| 94 |
is( $queries[0] =~ /$str/, 1, 'Second query contains title'); |
| 95 |
#SRU revisited |
| 96 |
$server= { sru_fields => 'isbn=nb,title=dc.title,srchany=overal' }; |
| 97 |
$squery= C4::Breeding::_translate_query( $server, $queries[1] ); |
| 98 |
is ( $squery =~ /dc.title/ && $squery =~ / and / && |
| 99 |
$squery =~ /nb=/, 1, 'SRU query with two parameters'); |
| 100 |
|
| 101 |
#We now pass a third wrong parameter (should not make a difference) |
| 102 |
my $pars3= { isbn => '123456', title => 'You should read this.', xyz => 1 }; |
| 103 |
my @queries2= C4::Breeding::_build_query( $pars3 ); |
| 104 |
is( $queries[0] eq $queries2[0] && $queries[1] eq $queries2[1], 1, |
| 105 |
'Third query makes no difference'); |
| 106 |
} |
| 107 |
|
| 108 |
sub test_create_connection { |
| 109 |
#TODO This is just a *simple* start |
| 110 |
|
| 111 |
my $str; |
| 112 |
my $server= { servertype => 'zed', db => 'MyDatabase', |
| 113 |
host => 'really-not-a-domain-i-hope.nl', port => 80, |
| 114 |
}; |
| 115 |
my $obj= C4::Breeding::_create_connection( $server ); |
| 116 |
|
| 117 |
#We should get back an object, even if it did not connect |
| 118 |
is( ref $obj eq 'ZOOM::Connection', 1, 'Got back a ZOOM connection'); |
| 119 |
|
| 120 |
#Remember: it is async |
| 121 |
my $i= ZOOM::event( [ $obj ] ); |
| 122 |
if( $i == 1 ) { |
| 123 |
#We could examine ZOOM::event_str( $obj->last_event ) |
| 124 |
#For now we are satisfied with an error message |
| 125 |
#Probably: Connect failed |
| 126 |
is( ($obj->errmsg//'') ne '', 1, 'Connection failed as expected'); |
| 127 |
|
| 128 |
} else { |
| 129 |
ok( 1, 'No ZOOM event found: skipped errmsg' ); |
| 130 |
} |
| 131 |
|
| 132 |
#Checking the databaseName for Z39.50 server |
| 133 |
$str=$obj->option('databaseName')//''; |
| 134 |
is( $str eq $server->{db}, 1, 'Check ZOOM option for database'); |
| 135 |
|
| 136 |
#Another test for SRU |
| 137 |
$obj->destroy(); |
| 138 |
$server->{ servertype } = 'sru'; |
| 139 |
$server->{ sru_options } = 'just_testing=fun'; |
| 140 |
$obj= C4::Breeding::_create_connection( $server ); |
| 141 |
#In this case we expect no databaseName, but we expect just_testing |
| 142 |
$str=$obj->option('databaseName'); |
| 143 |
is( $str, undef, 'No databaseName for SRU connection'); |
| 144 |
$str=$obj->option('just_testing')//''; |
| 145 |
is( $str eq 'fun', 1, 'Additional ZOOM option for SRU found'); |
| 146 |
$obj->destroy(); |
| 147 |
} |
| 148 |
|
| 149 |
sub test_do_xslt { |
| 150 |
my $biblio = MARC::Record->new(); |
| 151 |
$biblio->append_fields( |
| 152 |
MARC::Field->new('100', ' ', ' ', a => 'John Writer'), |
| 153 |
MARC::Field->new('245', ' ', ' ', a => 'Just a title'), |
| 154 |
); |
| 155 |
my $file= $FindBin::Bin.'/XSLT_Handler/test01.xsl'; |
| 156 |
my $server= { add_xslt => $file }; |
| 157 |
my $engine=Koha::XSLT_Handler->new; |
| 158 |
|
| 159 |
#ready for the main test |
| 160 |
my @res = C4::Breeding::_do_xslt_proc( $biblio, $server, $engine ); |
| 161 |
is( $res[1] && $res[1] eq 'xslt_err', undef, |
| 162 |
'Check error code of _do_xslt_proc'); |
| 163 |
if( !$res[1] ) { |
| 164 |
is( ref $res[0] eq 'MARC::Record', 1, 'Got back MARC record'); |
| 165 |
my $sub = $res[0]->subfield('990','a')//''; |
| 166 |
is( $sub eq 'I saw you', 1, 'Found 990a in the record'); |
| 167 |
} else { |
| 168 |
ok( 1, 'Skipped one test'); |
| 169 |
ok( 1, 'Skipped another one'); |
| 170 |
} |
| 171 |
|
| 172 |
#forcing an error on the xslt side |
| 173 |
$server->{add_xslt} = 'notafile.xsl'; |
| 174 |
@res = C4::Breeding::_do_xslt_proc( $biblio, $server, $engine ); |
| 175 |
is( $res[1] && $res[1] eq 'xslt_err', 1, |
| 176 |
'Check error code again'); |
| 177 |
#We still expect the original record back |
| 178 |
is( ref $res[0] eq 'MARC::Record', 1, 'Still got back MARC record'); |
| 179 |
is ( $res[0]->subfield('245','a') eq 'Just a title', 1, |
| 180 |
'At least the title is the same :)' ); |
| 181 |
} |