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