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
   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.
  11 #
  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.
  16 #
  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>.
  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
  26
  27 use Modern::Perl;
  28 use File::Temp qw/tempfile/;
  29 use Test::More tests => 6;
  30 use Test::Warn;
  31
  32 use t::lib::Mocks qw( mock_preference );
  33 use t::lib::TestBuilder;
  34
  35 use C4::Context;
  36 use C4::Breeding;
  37 use Koha::Database;
  38 use Koha::XSLT::Base;
  39
  40 my $schema = Koha::Database->new->schema;
  41 my $builder = t::lib::TestBuilder->new;
  42 $schema->storage->txn_begin;
  43
  44 #Group 1: testing _build_query and _translate_query (part of Z3950Search)
  45 subtest '_build_query' => sub {
  46     plan tests => 14;
  47     test_build_translate_query();
  48 };
  49 #Group 2: testing _create_connection (part of Z3950Search)
  50 subtest '_create_connection' => sub {
  51     plan tests => 5;
  52     test_create_connection();
  53 };
  54 #Group 3: testing _do_xslt_proc (part of Z3950Search)
  55 subtest '_do_xslt_proc' => sub {
  56     plan tests => 6;
  57     test_do_xslt();
  58 };
  59 #Group 4: testing _add_rowdata (part of Z3950Search)
  60 subtest '_add_rowdata' => sub {
  61     plan tests => 5;
  62     test_add_rowdata();
  63 };
  64
  65 subtest ImportBreedingAuth => sub {
  66     plan tests => 4;
  67
  68     my $record = MARC::Record->new();
  69     $record->append_fields(
  70         MARC::Field->new('001', '4815162342'),
  71         MARC::Field->new('100', ' ', ' ', a => 'Jansson, Tove'),
  72     );
  73
  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'),
  84     );
  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");
  87 };
  88
  89 subtest BreedingSearch => sub {
  90     plan tests => 5;
  91
  92     my $import_biblio_1 = $builder->build({ source => 'ImportBiblio', value => {
  93             title => 'Unique title the first adventure',
  94             author => 'Firstnamey Surnamey',
  95             isbn  => '1407239961'
  96         }
  97     });
  98     my $import_biblio_2 = $builder->build({ source => 'ImportBiblio', value => {
  99             title => 'Unique title the adventure continues',
 100             author => 'Firstnamey Surnamey',
 101             isbn  => '9798200834976'
 102         }
 103     });
 104
 105     my ($count, @results) = C4::Breeding::BreedingSearch("Firstnamey Surnamey");
 106     is( $count, 2, "Author search returns two results");
 107
 108     ($count, @results) = C4::Breeding::BreedingSearch("first adventure");
 109     is( $count, 1, "Title search returns one result");
 110
 111     ($count, @results) = C4::Breeding::BreedingSearch("adventure continues");
 112     is( $count, 1, "Title search returns one result");
 113
 114     ($count, @results) = C4::Breeding::BreedingSearch("9781407239965");
 115     is( $count, 1, "ISBN search matches normalized DB value");
 116
 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
 120 };
 121
 122 $schema->storage->txn_rollback;
 123
 124 #-------------------------------------------------------------------------------
 125
 126 sub test_build_translate_query {
 127     my $str;
 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');
 132
 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');
 138     $str=$pars1->{isbn};
 139     #Find back ISBN?
 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');
 153
 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');
 169
 170     #SRU revisited
 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');
 175
 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');
 181
 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');
 188
 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');
 195 }
 196
 197 sub test_create_connection {
 198     #TODO This is just a *simple* start
 199
 200     my $str;
 201     my $server= { servertype => 'zed', db => 'MyDatabase',
 202         host => 'really-not-a-domain-i-hope.nl', port => 80,
 203     };
 204     my $obj= C4::Breeding::_create_connection( $server );
 205
 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');
 208
 209     #Remember: it is async
 210     my $i= ZOOM::event( [ $obj ] );
 211     if( $i == 1 ) {
 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');
 216
 217     } else {
 218         ok( 1, 'No ZOOM event found: skipped errmsg' );
 219     }
 220
 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');
 224
 225     #Another test for SRU
 226     $obj->destroy();
 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');
 235     $obj->destroy();
 236 }
 237
 238 sub test_do_xslt {
 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'),
 243     );
 244     my $file= xsl_file();
 245     my $server= { add_xslt => $file };
 246     my $engine=Koha::XSLT::Base->new;
 247
 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');
 253
 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 :)' );
 262 }
 263
 264 sub test_add_rowdata {
 265     t::lib::Mocks::mock_preference('AdditionalFieldsInZ3950ResultSearch','');
 266
 267     my $row = {
 268        biblionumber => 0,
 269        server => "testServer",
 270        breedingid => 0
 271    };
 272
 273     my $biblio = MARC::Record->new();
 274     $biblio->append_fields(
 275         MARC::Field->new('245', ' ', ' ', a => 'Just a title'), #title
 276     );
 277
 278     my $returned_row = C4::Breeding::_add_rowdata($row, $biblio);
 279
 280     is($returned_row->{title}, "Just a title", "_add_rowdata returns the title of a biblio");
 281     is($returned_row->{addnumberfields}[0], undef, "_add_rowdata returns undef if it has no additionnal field");
 282
 283     t::lib::Mocks::mock_preference('AdditionalFieldsInZ3950ResultSearch',"245\$a, 035\$a");
 284
 285     $row = {
 286        biblionumber => 0,
 287        server => "testServer",
 288        breedingid => 0
 289    };
 290    $biblio = MARC::Record->new();
 291    $biblio->append_fields(
 292         MARC::Field->new('245', ' ', ' ', a => 'Just a title'), #title
 293         MARC::Field->new('035', ' ', ' ', a => 'First 035'),
 294         MARC::Field->new('035', ' ', ' ', a => 'Second 035')
 295    );
 296    $returned_row = C4::Breeding::_add_rowdata($row, $biblio);
 297
 298    is($returned_row->{title}, "Just a title", "_add_rowdata returns the title of a biblio");
 299    is($returned_row->{addnumberfields}[0], "245\$a", "_add_rowdata returns the field number chosen in the AdditionalFieldsInZ3950ResultSearch preference");
 300
 301    # Test repeatble tags,the trailing whitespace is a normal side-effect of _add_custom_row_data
 302    is_deeply(\$returned_row->{"035\$a"}, \["First 035 ", "Second 035 "],"_add_rowdata supports repeatable tags");
 303 }
 304
 305 sub xsl_file {
 306     return mytempfile( q{<xsl:stylesheet version="1.0"
 307     xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
 308     xmlns:marc="http://www.loc.gov/MARC21/slim"
 309 >
 310   <xsl:output method="xml" version="1.0" encoding="UTF-8" indent="yes"/>
 311
 312   <xsl:template match="record|marc:record">
 313       <record>
 314       <xsl:apply-templates/>
 315       <datafield tag="990" ind1='' ind2=''>
 316         <subfield code="a">
 317           <xsl:text>I saw you</xsl:text>
 318         </subfield>
 319       </datafield>
 320       </record>
 321   </xsl:template>
 322
 323   <xsl:template match="node()">
 324     <xsl:copy select=".">
 325       <xsl:copy-of select="@*"/>
 326       <xsl:apply-templates/>
 327     </xsl:copy>
 328   </xsl:template>
 329 </xsl:stylesheet>} );
 330 }
 331
 332 sub mytempfile {
 333     my ( $fh, $fn ) = tempfile( SUFFIX => '.xsl', UNLINK => 1 );
 334     print $fh $_[0]//'';
 335     close $fh;
 336     return $fn;
 337 }