t/db_dependent/Breeding.t

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