t/db_dependent/TestBuilder.t

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright 2014 - Biblibre SARL
   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 use Modern::Perl;
  21
  22 use utf8;
  23
  24 use Test::More tests => 16;
  25 use Test::Warn;
  26 use Try::Tiny;
  27 use File::Basename qw(dirname);
  28
  29 use Koha::Database;
  30 use Koha::Patrons;
  31
  32 BEGIN {
  33     use_ok('t::lib::TestBuilder');
  34 }
  35
  36 our $schema = Koha::Database->new->schema;
  37 our $builder;
  38
  39 subtest 'Start with some trivial tests' => sub {
  40     plan tests => 7;
  41
  42     $schema->storage->txn_begin;
  43
  44     $builder = t::lib::TestBuilder->new;
  45     isnt( $builder, undef, 'We got a builder' );
  46
  47     my $data;
  48     warning_like { $data = $builder->build; } qr/.+/, 'Catch a warning';
  49     is( $data, undef, 'build without arguments returns undef' );
  50     is( ref( $builder->schema ), 'Koha::Schema', 'check schema' );
  51     is( ref( $builder->can('delete') ), 'CODE', 'found delete method' );
  52
  53     # invalid argument
  54     warning_like { $builder->build({
  55             source => 'Borrower',
  56             value  => { surname => { invalid_hash => 1 } },
  57         }) } qr/^Hash not allowed for surname/,
  58         'Build should not accept a hash for this column';
  59
  60     # return undef if a record exists
  61     my $branchcode = $builder->build({ source => 'Branch' })->{branchcode};
  62     my $param = { source => 'Branch', value => { branchcode => $branchcode } };
  63     warning_like { $builder->build( $param ) }
  64         qr/Violation of unique constraint/,
  65         'Catch warn on adding existing record';
  66
  67     $schema->storage->txn_rollback;
  68 };
  69
  70
  71 subtest 'Build all sources' => sub {
  72     plan tests => 1;
  73
  74     $schema->storage->txn_begin;
  75
  76     my @sources = $builder->schema->sources;
  77     my @source_in_failure;
  78     for my $source ( @sources ) {
  79         my $res;
  80         # Skip the source if it is a view
  81         next if $schema->source($source)->isa('DBIx::Class::ResultSource::View');
  82         eval { $res = $builder->build( { source => $source } ); };
  83         push @source_in_failure, $source if $@ || !defined( $res );
  84     }
  85     is( @source_in_failure, 0,
  86         'TestBuilder should be able to create an object for every source' );
  87     if ( @source_in_failure ) {
  88         diag( "The following sources have not been generated correctly: " .
  89         join ', ', @source_in_failure );
  90     }
  91
  92     $schema->storage->txn_rollback;
  93 };
  94
  95
  96 subtest 'Test length of some generated fields' => sub {
  97     plan tests => 3;
  98
  99     $schema->storage->txn_begin;
 100
 101     # Test the length of a returned character field
 102     my $bookseller = $builder->build({ source  => 'Aqbookseller' });
 103     my $max = $schema->source('Aqbookseller')->column_info('phone')->{size};
 104     is( length( $bookseller->{phone} ) > 0, 1,
 105         'The length for a generated string (phone) should not be zero' );
 106     is( length( $bookseller->{phone} ) <= $max, 1,
 107         'Check maximum length for a generated string (phone)' );
 108
 109     my $item = $builder->build({ source => 'Item' });
 110     is( $item->{replacementprice}, sprintf("%.2f", $item->{replacementprice}), "The number of decimals for floats should not be more than 2" );
 111
 112     $schema->storage->txn_rollback;
 113 };
 114
 115
 116 subtest 'Test FKs in overduerules_transport_type' => sub {
 117     plan tests => 5;
 118
 119     $schema->storage->txn_begin;
 120
 121     my $my_overduerules_transport_type = {
 122         message_transport_type => {
 123             message_transport_type => 'my msg_t_t',
 124         },
 125         overduerules_id => {
 126             branchcode   => 'codeB',
 127             categorycode => 'codeC',
 128         },
 129     };
 130
 131     my $overduerules_transport_type = $builder->build({
 132         source => 'OverduerulesTransportType',
 133         value  => $my_overduerules_transport_type,
 134     });
 135     is(
 136         $overduerules_transport_type->{message_transport_type},
 137         $my_overduerules_transport_type->{message_transport_type}->{message_transport_type},
 138         'build stores the message_transport_type correctly'
 139     );
 140     is(
 141         $schema->resultset('Overduerule')->find( $overduerules_transport_type->{overduerules_id} )->branchcode,
 142         $my_overduerules_transport_type->{overduerules_id}->{branchcode},
 143         'build stores the branchcode correctly'
 144     );
 145     is(
 146         $schema->resultset('Overduerule')->find( $overduerules_transport_type->{overduerules_id} )->categorycode,
 147         $my_overduerules_transport_type->{overduerules_id}->{categorycode},
 148         'build stores the categorycode correctly'
 149     );
 150     is(
 151         $schema->resultset('MessageTransportType')->find( $overduerules_transport_type->{message_transport_type} )->message_transport_type,
 152         $overduerules_transport_type->{message_transport_type},
 153         'build stores the foreign key message_transport_type correctly'
 154     );
 155     isnt(
 156         $schema->resultset('Overduerule')->find( $my_overduerules_transport_type->{overduerules_id} )->letter2,
 157         undef,
 158         'build generates values if they are not given'
 159     );
 160
 161     $schema->storage->txn_rollback;
 162 };
 163
 164
 165 subtest 'Tests with composite FK in userpermission' => sub {
 166     plan tests => 9;
 167
 168     $schema->storage->txn_begin;
 169
 170     my $my_user_permission = default_userpermission();
 171     my $user_permission = $builder->build({
 172         source => 'UserPermission',
 173         value  => $my_user_permission,
 174     });
 175
 176     # Checks on top level of userpermission
 177     isnt(
 178         $user_permission->{borrowernumber},
 179         undef,
 180         'build generates a borrowernumber correctly'
 181     );
 182     is(
 183         $user_permission->{code},
 184         $my_user_permission->{code}->{code},
 185         'build stores code correctly'
 186     );
 187
 188     # Checks one level deeper userpermission -> borrower
 189     my $patron = $schema->resultset('Borrower')->find({ borrowernumber => $user_permission->{borrowernumber} });
 190     is(
 191         $patron->surname,
 192         $my_user_permission->{borrowernumber}->{surname},
 193         'build stores surname correctly'
 194     );
 195     isnt(
 196         $patron->cardnumber,
 197         undef,
 198         'build generated cardnumber'
 199     );
 200
 201     # Checks two levels deeper userpermission -> borrower -> branch
 202     my $branch = $schema->resultset('Branch')->find({ branchcode => $patron->branchcode->branchcode });
 203     is(
 204         $branch->branchname,
 205         $my_user_permission->{borrowernumber}->{branchcode}->{branchname},
 206         'build stores branchname correctly'
 207     );
 208     isnt(
 209         $branch->branchaddress1,
 210         undef,
 211         'build generated branch address'
 212     );
 213
 214     # Checks with composite FK: userpermission -> permission
 215     my $perm = $schema->resultset('Permission')->find({ module_bit => $user_permission->{module_bit}, code => $my_user_permission->{code}->{code} });
 216     isnt( $perm, undef, 'build generated record for composite FK' );
 217     is(
 218         $perm->code,
 219         $my_user_permission->{code}->{code},
 220         'build stored code correctly'
 221     );
 222     is(
 223         $perm->description,
 224         $my_user_permission->{code}->{description},
 225         'build stored description correctly'
 226     );
 227
 228     $schema->storage->txn_rollback;
 229 };
 230
 231 sub default_userpermission {
 232     return {
 233         borrowernumber => {
 234             surname => 'my surname',
 235             address => 'my adress',
 236             city    => 'my city',
 237             branchcode => {
 238                 branchname => 'my branchname',
 239             },
 240             categorycode => {
 241                 hidelostitems   => 0,
 242                 category_type   => 'A',
 243                 default_privacy => 'default',
 244             },
 245             privacy => 1,
 246         },
 247         module_bit => {
 248             module_bit => {
 249                 flag        => 'my flag',
 250             },
 251         },
 252         code => {
 253             code        => 'my code',
 254             description => 'my desc',
 255         },
 256     };
 257 }
 258
 259
 260 subtest 'Test build with NULL values' => sub {
 261     plan tests => 3;
 262
 263     $schema->storage->txn_begin;
 264
 265     # PK should not be null
 266     my $params = { source => 'Branch', value => { branchcode => undef }};
 267     warning_like { $builder->build( $params ) }
 268         qr/Null value for branchcode/,
 269         'Catch warn on adding branch with a null branchcode';
 270     # Nullable column
 271     my $info = $schema->source( 'Item' )->column_info( 'barcode' );
 272     $params = { source => 'Item', value  => { barcode => undef }};
 273     my $item = $builder->build( $params );
 274     is( $info->{is_nullable} && $item && !defined( $item->{barcode} ), 1,
 275         'Barcode can be NULL' );
 276     # Nullable FK
 277     $params = { source => 'Reserve', value  => { itemnumber => undef }};
 278     my $reserve = $builder->build( $params );
 279     $info = $schema->source( 'Reserve' )->column_info( 'itemnumber' );
 280     is( $reserve && $info->{is_nullable} && $info->{is_foreign_key} &&
 281         !defined( $reserve->{itemnumber} ), 1, 'Nullable FK' );
 282
 283     $schema->storage->txn_rollback;
 284 };
 285
 286
 287 subtest 'Tests for delete method' => sub {
 288     plan tests => 12;
 289
 290     $schema->storage->txn_begin;
 291
 292     # Test delete with single and multiple records
 293     my $basket1 = $builder->build({ source => 'Aqbasket' });
 294     my $basket2 = $builder->build({ source => 'Aqbasket' });
 295     my $basket3 = $builder->build({ source => 'Aqbasket' });
 296     my ( $id1, $id2 ) = ( $basket1->{basketno}, $basket2->{basketno} );
 297     $builder->delete({ source => 'Aqbasket', records => $basket1 });
 298     isnt( exists $basket1->{basketno}, 1, 'Delete cleared PK hash value' );
 299
 300     is( $builder->schema->resultset('Aqbasket')->search({ basketno => $id1 })->count, 0, 'Basket1 is no longer found' );
 301     is( $builder->schema->resultset('Aqbasket')->search({ basketno => $id2 })->count, 1, 'Basket2 is still found' );
 302     is( $builder->delete({ source => 'Aqbasket', records => [ $basket2, $basket3 ] }), 2, "Returned two delete attempts" );
 303     is( $builder->schema->resultset('Aqbasket')->search({ basketno => $id2 })->count, 0, 'Basket2 is no longer found' );
 304
 305
 306     # Test delete in table without primary key (..)
 307     is( $schema->source('TmpHoldsqueue')->primary_columns, 0,
 308         'Table without primary key detected' );
 309     my $bibno = $builder->build_sample_biblio->biblionumber;
 310     my $cnt1 = $schema->resultset('TmpHoldsqueue')->count;
 311     # Insert a new record in TmpHoldsqueue with that biblionumber
 312     my $val = { biblionumber => $bibno };
 313     my $rec = $builder->build({ source => 'TmpHoldsqueue', value => $val });
 314     my $cnt2 = $schema->resultset('TmpHoldsqueue')->count;
 315     is( defined($rec) && $cnt2 == $cnt1 + 1 , 1, 'Created a record' );
 316     is( $builder->delete({ source => 'TmpHoldsqueue', records => $rec }),
 317         undef, 'delete returns undef' );
 318     is( $rec->{biblionumber}, $bibno, 'Hash value untouched' );
 319     is( $schema->resultset('TmpHoldsqueue')->count, $cnt2,
 320         "Method did not delete record in table without PK" );
 321
 322     # Test delete with NULL values
 323     $val = { branchcode => undef };
 324     is( $builder->delete({ source => 'Branch', records => $val }), 0,
 325         'delete returns zero for an undef search with one key' );
 326     $val = { module_bit => 1, #catalogue
 327              code       => undef };
 328     is( $builder->delete({ source => 'Permission', records => $val }), 0,
 329         'delete returns zero for an undef search with a composite PK' );
 330
 331     $schema->storage->txn_rollback;
 332 };
 333
 334 subtest 'Auto-increment values tests' => sub {
 335     plan tests => 3;
 336
 337     $schema->storage->txn_begin;
 338
 339     # Pick a table with AI PK
 340     my $source  = 'Biblio'; # table
 341     my $column  = 'biblionumber'; # ai column
 342
 343     my $col_info = $schema->source( $source )->column_info( $column );
 344     is( $col_info->{is_auto_increment}, 1, "biblio.biblionumber is detected as autoincrement");
 345
 346     # Create a biblio
 347     my $biblio_1 = $builder->build({ source => $source });
 348     # Get the AI value
 349     my $ai_value = $biblio_1->{ biblionumber };
 350     # Create a biblio
 351     my $biblio_2 = $builder->build({ source => $source });
 352     # Get the next AI value
 353     my $next_ai_value = $biblio_2->{ biblionumber };
 354     is( $ai_value + 1, $next_ai_value, "AI values are consecutive");
 355
 356     # respect autoincr column
 357     warning_like { $builder->build({
 358             source => $source,
 359             value  => { biblionumber => 123 },
 360         }) } qr/^Value not allowed for auto_incr/,
 361         'Build should not overwrite an auto_incr column';
 362
 363     $schema->storage->txn_rollback;
 364 };
 365
 366 subtest 'Date handling' => sub {
 367     plan tests => 2;
 368
 369     $schema->storage->txn_begin;
 370
 371     $builder = t::lib::TestBuilder->new;
 372
 373     my $patron = $builder->build( { source => 'Borrower' } );
 374     is( length( $patron->{updated_on} ),  19, 'A timestamp column value should be YYYY-MM-DD HH:MM:SS' );
 375     is( length( $patron->{dateofbirth} ), 10, 'A date column value should be YYYY-MM-DD' );
 376
 377     $schema->storage->txn_rollback;
 378 };
 379
 380 subtest 'Default values' => sub {
 381     plan tests => 3;
 382
 383     $schema->storage->txn_begin;
 384
 385     $builder = t::lib::TestBuilder->new;
 386     my $item = $builder->build( { source => 'Item' } );
 387     is( $item->{more_subfields_xml}, undef, 'This xml field should be undef' );
 388     $item = $builder->build( { source => 'Item', value => { more_subfields_xml => 'some xml' } } );
 389     is( $item->{more_subfields_xml}, 'some xml', 'Default should not overwrite assigned value' );
 390
 391     subtest 'generated dynamically (coderef)' => sub {
 392         plan tests => 2;
 393         my $patron = $builder->build_object({ class => 'Koha::Patrons' });
 394         like( $patron->category->category_type, qr{^(A|C|S|I|P|)$}, );
 395
 396         my $patron_category_X = $builder->build_object({ class => 'Koha::Patron::Categories', value => { category_type => 'X' } });
 397         $patron = $builder->build_object({ class => 'Koha::Patrons', value => {categorycode => $patron_category_X->categorycode} });
 398         is( $patron->category->category_type, 'X', );
 399     };
 400
 401     $schema->storage->txn_rollback;
 402 };
 403
 404 subtest 'build_object() tests' => sub {
 405
 406     plan tests => 5;
 407
 408     $schema->storage->txn_begin;
 409
 410     $builder = t::lib::TestBuilder->new();
 411
 412     my $branchcode = $builder->build( { source => 'Branch' } )->{branchcode};
 413     my $categorycode = $builder->build( { source => 'Category' } )->{categorycode};
 414     my $itemtype = $builder->build( { source => 'Itemtype' } )->{itemtype};
 415
 416     my $issuing_rule = $builder->build_object(
 417         {   class => 'Koha::CirculationRules',
 418             value => {
 419                 branchcode   => $branchcode,
 420                 categorycode => $categorycode,
 421                 itemtype     => $itemtype
 422             }
 423         }
 424     );
 425
 426     is( ref($issuing_rule), 'Koha::CirculationRule', 'Type is correct' );
 427     is( $issuing_rule->categorycode,
 428         $categorycode, 'Category code correctly set' );
 429     is( $issuing_rule->itemtype, $itemtype, 'Item type correctly set' );
 430
 431     subtest 'Test all classes' => sub {
 432         my $Koha_modules_dir = dirname(__FILE__) . '/../../Koha';
 433         my @koha_object_based_modules = `/bin/grep -rl -e '^sub object_class' $Koha_modules_dir`;
 434         my @source_in_failure;
 435         for my $module_filepath ( @koha_object_based_modules ) {
 436             chomp $module_filepath;
 437             next unless $module_filepath =~ m|\.pm$|;
 438             my $module = $module_filepath;
 439             $module =~ s|^.*/(Koha.*)\.pm$|$1|;
 440             $module =~ s|/|::|g;
 441             next if $module eq 'Koha::Objects';
 442             eval "require $module";
 443             my $object = $builder->build_object( { class => $module } );
 444             is( ref($object), $module->object_class, "Testing $module" );
 445             if ( ! grep {$module eq $_ } qw( Koha::Old::Patrons Koha::Statistics ) ) { # FIXME deletedborrowers and statistics do not have a PK
 446                 eval {$object->get_from_storage};
 447                 is( $@, '', "Module $module should have koha_object[s]_class method if needed" );
 448             }
 449
 450             # Testing koha_object_class and koha_objects_class
 451             my $object_class =  Koha::Object::_get_object_class($object->_result->result_class);
 452             eval "require $object_class";
 453             is( $@, '', "Module $object_class should be defined");
 454             my $objects_class = Koha::Objects::_get_objects_class($object->_result->result_class);
 455             eval "require $objects_class";
 456             is( $@, '', "Module $objects_class should be defined");
 457         }
 458     };
 459
 460     subtest 'test parameters' => sub {
 461         plan tests => 3;
 462
 463         warning_is { $issuing_rule = $builder->build_object( {} ); }
 464         { carped => 'Missing class param' },
 465             'The class parameter is mandatory, raises a warning if absent';
 466         is( $issuing_rule, undef,
 467             'If the class parameter is missing, undef is returned' );
 468
 469         warnings_like {
 470             $builder->build_object(
 471                 { class => 'Koha::Patrons', categorycode => 'foobar' } );
 472         } qr{Unknown parameter\(s\): categorycode}, "Unknown parameter detected";
 473     };
 474
 475     $schema->storage->txn_rollback;
 476 };
 477
 478 subtest '->build parameter' => sub {
 479     plan tests => 4;
 480
 481     $schema->storage->txn_begin;
 482
 483     # Test to make sure build() warns user of unknown parameters.
 484     warnings_are {
 485         $builder->build({
 486             source => 'Branch',
 487             value => {
 488                 branchcode => 'BRANCH_1'
 489             }
 490         })
 491     } [], "No warnings on correct use";
 492
 493     warnings_like {
 494         $builder->build({
 495             source     => 'Branch',
 496             branchcode => 'BRANCH_2' # This is wrong!
 497         })
 498     } qr/unknown param/i, "Carp unknown parameters";
 499
 500     warnings_like {
 501         $builder->build({
 502             zource     => 'Branch', # Intentional spelling error
 503         })
 504     } qr/Source parameter not specified/, "Catch warning on missing source";
 505
 506     warnings_like {
 507         $builder->build(
 508             { source => 'Borrower', categorycode => 'foobar' } );
 509     } qr{Unknown parameter\(s\): categorycode}, "Unkown parameter detected";
 510
 511     $schema->storage->txn_rollback;
 512 };
 513
 514 subtest 'build_sample_biblio() tests' => sub {
 515
 516     plan tests => 1;
 517
 518     $schema->storage->txn_begin;
 519
 520     warnings_are
 521         { $builder->build_sample_biblio({ title => 'hell❤️' }); }
 522         [],
 523         "No encoding warnings!";
 524
 525     $schema->storage->txn_rollback;
 526 };
 527
 528 subtest 'Existence of object is only checked using primary keys' => sub {
 529
 530     plan tests => 1;
 531
 532     $schema->storage->txn_begin;
 533
 534     my $biblio = $builder->build_sample_biblio();
 535     my $item1 = $builder->build_sample_item({ biblionumber => $biblio->biblionumber });
 536     my $item2 = $builder->build_sample_item({ biblionumber => $biblio->biblionumber });
 537     warnings_are {
 538       $builder->build_object({
 539         class => 'Koha::Holds',
 540         value  => {
 541             biblionumber => $biblio->biblionumber
 542         }
 543       });
 544     } [], "No warning about query returning more than one row";
 545
 546     $schema->storage->txn_rollback;
 547 };
 548
 549 subtest 'Test bad columns' => sub {
 550     plan tests => 3;
 551     $schema->storage->txn_begin;
 552
 553     try {
 554         my $patron = $builder->build_object({ class => 'Koha::Patrons', value => { wrong => 1 } });
 555         ok( 0, 'Unexpected pass with wrong column' );
 556     }
 557     catch {
 558         like( $_, qr/^Error: value hash contains unrecognized columns: wrong/, 'Column wrong is bad' );
 559     };
 560     try {
 561         my $patron = $builder->build_object({ class => 'Koha::Patrons', value => { surname => 'Pass', nested => { ignored => 1 }} });
 562         ok( 1, 'Nested hash ignored' );
 563     }
 564     catch {
 565         ok( 0, 'Unexpected trouble with nested hash' );
 566     };
 567     try {
 568         my $patron = $builder->build_object({
 569             class => 'Koha::Patrons',
 570              value => { surname => 'WontPass', categorycode => { description => 'bla', wrong_nested => 1 }},
 571         });
 572         ok( 0, 'Unexpected pass with wrong nested column' );
 573     }
 574     catch {
 575         like( $_, qr/^Error: value hash contains unrecognized columns: wrong_nested/, 'Column wrong_nested is bad' );
 576     };
 577
 578     $schema->storage->txn_rollback;
 579 };