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 Test::More tests => 13;
  23 use Test::Warn;
  24 use File::Basename qw(dirname);
  25
  26 use Koha::Database;
  27 use Koha::Patrons;
  28
  29 BEGIN {
  30     use_ok('t::lib::TestBuilder');
  31 }
  32
  33 our $schema = Koha::Database->new->schema;
  34 $schema->storage->txn_begin;
  35 our $builder;
  36
  37
  38 subtest 'Start with some trivial tests' => sub {
  39     plan tests => 7;
  40
  41     $builder = t::lib::TestBuilder->new;
  42     isnt( $builder, undef, 'We got a builder' );
  43
  44     my $data;
  45     warning_like { $data = $builder->build; } qr/.+/, 'Catch a warning';
  46     is( $data, undef, 'build without arguments returns undef' );
  47     is( ref( $builder->schema ), 'Koha::Schema', 'check schema' );
  48     is( ref( $builder->can('delete') ), 'CODE', 'found delete method' );
  49
  50     # invalid argument
  51     warning_like { $builder->build({
  52             source => 'Borrower',
  53             value  => { surname => { invalid_hash => 1 } },
  54         }) } qr/^Hash not allowed for surname/,
  55         'Build should not accept a hash for this column';
  56
  57     # return undef if a record exists
  58     my $branchcode = $builder->build({ source => 'Branch' })->{branchcode};
  59     my $param = { source => 'Branch', value => { branchcode => $branchcode } };
  60     warning_like { $builder->build( $param ) }
  61         qr/Violation of unique constraint/,
  62         'Catch warn on adding existing record';
  63 };
  64
  65
  66 subtest 'Build all sources' => sub {
  67     plan tests => 1;
  68
  69     my @sources = $builder->schema->sources;
  70     my @source_in_failure;
  71     for my $source ( @sources ) {
  72         my $res;
  73         # Skip the source if it is a view
  74         next if $schema->source($source)->isa('DBIx::Class::ResultSource::View');
  75         eval { $res = $builder->build( { source => $source } ); };
  76         push @source_in_failure, $source if $@ || !defined( $res );
  77     }
  78     is( @source_in_failure, 0,
  79         'TestBuilder should be able to create an object for every source' );
  80     if ( @source_in_failure ) {
  81         diag( "The following sources have not been generated correctly: " .
  82         join ', ', @source_in_failure );
  83     }
  84 };
  85
  86
  87 subtest 'Test length of some generated fields' => sub {
  88     plan tests => 2;
  89
  90     # Test the length of a returned character field
  91     my $bookseller = $builder->build({ source  => 'Aqbookseller' });
  92     my $max = $schema->source('Aqbookseller')->column_info('phone')->{size};
  93     is( length( $bookseller->{phone} ) > 0, 1,
  94         'The length for a generated string (phone) should not be zero' );
  95     is( length( $bookseller->{phone} ) <= $max, 1,
  96         'Check maximum length for a generated string (phone)' );
  97 };
  98
  99
 100 subtest 'Test FKs in overduerules_transport_type' => sub {
 101     plan tests => 5;
 102
 103     my $my_overduerules_transport_type = {
 104         message_transport_type => {
 105             message_transport_type => 'my msg_t_t',
 106         },
 107         overduerules_id => {
 108             branchcode   => 'codeB',
 109             categorycode => 'codeC',
 110         },
 111     };
 112
 113     my $overduerules_transport_type = $builder->build({
 114         source => 'OverduerulesTransportType',
 115         value  => $my_overduerules_transport_type,
 116     });
 117     is(
 118         $overduerules_transport_type->{message_transport_type},
 119         $my_overduerules_transport_type->{message_transport_type}->{message_transport_type},
 120         'build stores the message_transport_type correctly'
 121     );
 122     is(
 123         $schema->resultset('Overduerule')->find( $overduerules_transport_type->{overduerules_id} )->branchcode,
 124         $my_overduerules_transport_type->{overduerules_id}->{branchcode},
 125         'build stores the branchcode correctly'
 126     );
 127     is(
 128         $schema->resultset('Overduerule')->find( $overduerules_transport_type->{overduerules_id} )->categorycode,
 129         $my_overduerules_transport_type->{overduerules_id}->{categorycode},
 130         'build stores the categorycode correctly'
 131     );
 132     is(
 133         $schema->resultset('MessageTransportType')->find( $overduerules_transport_type->{message_transport_type} )->message_transport_type,
 134         $overduerules_transport_type->{message_transport_type},
 135         'build stores the foreign key message_transport_type correctly'
 136     );
 137     isnt(
 138         $schema->resultset('Overduerule')->find( $my_overduerules_transport_type->{overduerules_id} )->letter2,
 139         undef,
 140         'build generates values if they are not given'
 141     );
 142 };
 143
 144
 145 subtest 'Tests with composite FK in userpermission' => sub {
 146     plan tests => 9;
 147
 148     my $my_user_permission = default_userpermission();
 149     my $user_permission = $builder->build({
 150         source => 'UserPermission',
 151         value  => $my_user_permission,
 152     });
 153
 154     # Checks on top level of userpermission
 155     isnt(
 156         $user_permission->{borrowernumber},
 157         undef,
 158         'build generates a borrowernumber correctly'
 159     );
 160     is(
 161         $user_permission->{code},
 162         $my_user_permission->{code}->{code},
 163         'build stores code correctly'
 164     );
 165
 166     # Checks one level deeper userpermission -> borrower
 167     my $patron = $schema->resultset('Borrower')->find({ borrowernumber => $user_permission->{borrowernumber} });
 168     is(
 169         $patron->surname,
 170         $my_user_permission->{borrowernumber}->{surname},
 171         'build stores surname correctly'
 172     );
 173     isnt(
 174         $patron->cardnumber,
 175         undef,
 176         'build generated cardnumber'
 177     );
 178
 179     # Checks two levels deeper userpermission -> borrower -> branch
 180     my $branch = $schema->resultset('Branch')->find({ branchcode => $patron->branchcode->branchcode });
 181     is(
 182         $branch->branchname,
 183         $my_user_permission->{borrowernumber}->{branchcode}->{branchname},
 184         'build stores branchname correctly'
 185     );
 186     isnt(
 187         $branch->branchaddress1,
 188         undef,
 189         'build generated branch address'
 190     );
 191
 192     # Checks with composite FK: userpermission -> permission
 193     my $perm = $schema->resultset('Permission')->find({ module_bit => $user_permission->{module_bit}, code => $my_user_permission->{code}->{code} });
 194     isnt( $perm, undef, 'build generated record for composite FK' );
 195     is(
 196         $perm->code,
 197         $my_user_permission->{code}->{code},
 198         'build stored code correctly'
 199     );
 200     is(
 201         $perm->description,
 202         $my_user_permission->{code}->{description},
 203         'build stored description correctly'
 204     );
 205 };
 206
 207 sub default_userpermission {
 208     return {
 209         borrowernumber => {
 210             surname => 'my surname',
 211             address => 'my adress',
 212             city    => 'my city',
 213             branchcode => {
 214                 branchname => 'my branchname',
 215             },
 216             categorycode => {
 217                 hidelostitems   => 0,
 218                 category_type   => 'A',
 219                 default_privacy => 'default',
 220             },
 221             privacy => 1,
 222         },
 223         module_bit => {
 224             flag        => 'my flag',
 225         },
 226         code => {
 227             code        => 'my code',
 228             description => 'my desc',
 229         },
 230     };
 231 }
 232
 233
 234 subtest 'Test build with NULL values' => sub {
 235     plan tests => 3;
 236
 237     # PK should not be null
 238     my $params = { source => 'Branch', value => { branchcode => undef }};
 239     warning_like { $builder->build( $params ) }
 240         qr/Null value for branchcode/,
 241         'Catch warn on adding branch with a null branchcode';
 242     # Nullable column
 243     my $info = $schema->source( 'Item' )->column_info( 'barcode' );
 244     $params = { source => 'Item', value  => { barcode => undef }};
 245     my $item = $builder->build( $params );
 246     is( $info->{is_nullable} && $item && !defined( $item->{barcode} ), 1,
 247         'Barcode can be NULL' );
 248     # Nullable FK
 249     $params = { source => 'Reserve', value  => { itemnumber => undef }};
 250     my $reserve = $builder->build( $params );
 251     $info = $schema->source( 'Reserve' )->column_info( 'itemnumber' );
 252     is( $reserve && $info->{is_nullable} && $info->{is_foreign_key} &&
 253         !defined( $reserve->{itemnumber} ), 1, 'Nullable FK' );
 254 };
 255
 256
 257 subtest 'Tests for delete method' => sub {
 258     plan tests => 12;
 259
 260     # Test delete with single and multiple records
 261     my $basket1 = $builder->build({ source => 'Aqbasket' });
 262     my $basket2 = $builder->build({ source => 'Aqbasket' });
 263     my $basket3 = $builder->build({ source => 'Aqbasket' });
 264     my ( $id1, $id2 ) = ( $basket1->{basketno}, $basket2->{basketno} );
 265     $builder->delete({ source => 'Aqbasket', records => $basket1 });
 266     isnt( exists $basket1->{basketno}, 1, 'Delete cleared PK hash value' );
 267
 268     is( $builder->schema->resultset('Aqbasket')->search({ basketno => $id1 })->count, 0, 'Basket1 is no longer found' );
 269     is( $builder->schema->resultset('Aqbasket')->search({ basketno => $id2 })->count, 1, 'Basket2 is still found' );
 270     is( $builder->delete({ source => 'Aqbasket', records => [ $basket2, $basket3 ] }), 2, "Returned two delete attempts" );
 271     is( $builder->schema->resultset('Aqbasket')->search({ basketno => $id2 })->count, 0, 'Basket2 is no longer found' );
 272
 273
 274     # Test delete in table without primary key (..)
 275     is( $schema->source('TmpHoldsqueue')->primary_columns, 0,
 276         'Table without primary key detected' );
 277     my $bibno = 123; # just a number
 278     my $cnt1 = $schema->resultset('TmpHoldsqueue')->count;
 279     # Insert a new record in TmpHoldsqueue with that biblionumber
 280     my $val = { biblionumber => $bibno };
 281     my $rec = $builder->build({ source => 'TmpHoldsqueue', value => $val });
 282     my $cnt2 = $schema->resultset('TmpHoldsqueue')->count;
 283     is( defined($rec) && $cnt2 == $cnt1 + 1 , 1, 'Created a record' );
 284     is( $builder->delete({ source => 'TmpHoldsqueue', records => $rec }),
 285         undef, 'delete returns undef' );
 286     is( $rec->{biblionumber}, $bibno, 'Hash value untouched' );
 287     is( $schema->resultset('TmpHoldsqueue')->count, $cnt2,
 288         "Method did not delete record in table without PK" );
 289
 290     # Test delete with NULL values
 291     $val = { branchcode => undef };
 292     is( $builder->delete({ source => 'Branch', records => $val }), 0,
 293         'delete returns zero for an undef search with one key' );
 294     $val = { module_bit => 1, #catalogue
 295              code       => undef };
 296     is( $builder->delete({ source => 'Permission', records => $val }), 0,
 297         'delete returns zero for an undef search with a composite PK' );
 298 };
 299
 300
 301 subtest 'Auto-increment values tests' => sub {
 302     plan tests => 3;
 303
 304     # Pick a table with AI PK
 305     my $source  = 'Biblio'; # table
 306     my $column  = 'biblionumber'; # ai column
 307
 308     my $col_info = $schema->source( $source )->column_info( $column );
 309     is( $col_info->{is_auto_increment}, 1, "biblio.biblionumber is detected as autoincrement");
 310
 311     # Create a biblio
 312     my $biblio_1 = $builder->build({ source => $source });
 313     # Get the AI value
 314     my $ai_value = $biblio_1->{ biblionumber };
 315     # Create a biblio
 316     my $biblio_2 = $builder->build({ source => $source });
 317     # Get the next AI value
 318     my $next_ai_value = $biblio_2->{ biblionumber };
 319     is( $ai_value + 1, $next_ai_value, "AI values are consecutive");
 320
 321     # respect autoincr column
 322     warning_like { $builder->build({
 323             source => $source,
 324             value  => { biblionumber => 123 },
 325         }) } qr/^Value not allowed for auto_incr/,
 326         'Build should not overwrite an auto_incr column';
 327 };
 328
 329 subtest 'Date handling' => sub {
 330     plan tests => 2;
 331
 332     $builder = t::lib::TestBuilder->new;
 333
 334     my $patron = $builder->build( { source => 'Borrower' } );
 335     is( length( $patron->{updated_on} ),  19, 'A timestamp column value should be YYYY-MM-DD HH:MM:SS' );
 336     is( length( $patron->{dateofbirth} ), 10, 'A date column value should be YYYY-MM-DD' );
 337 };
 338
 339 subtest 'Default values' => sub {
 340     plan tests => 2;
 341     $builder = t::lib::TestBuilder->new;
 342     my $item = $builder->build( { source => 'Item' } );
 343     is( $item->{more_subfields_xml}, undef, 'This xml field should be undef' );
 344     $item = $builder->build( { source => 'Item', value => { more_subfields_xml => 'some xml' } } );
 345     is( $item->{more_subfields_xml}, 'some xml', 'Default should not overwrite assigned value' );
 346 };
 347
 348 subtest 'build_object() tests' => sub {
 349
 350     plan tests => 6;
 351
 352     $builder = t::lib::TestBuilder->new();
 353
 354     my $categorycode = $builder->build( { source => 'Category' } )->{categorycode};
 355     my $itemtype = $builder->build( { source => 'Itemtype' } )->{itemtype};
 356
 357     my $issuing_rule = $builder->build_object(
 358         {   class => 'Koha::IssuingRules',
 359             value => {
 360                 categorycode => $categorycode,
 361                 itemtype     => $itemtype
 362             }
 363         }
 364     );
 365
 366     is( ref($issuing_rule), 'Koha::IssuingRule', 'Type is correct' );
 367     is( $issuing_rule->categorycode,
 368         $categorycode, 'Category code correctly set' );
 369     is( $issuing_rule->itemtype, $itemtype, 'Item type correctly set' );
 370
 371     warning_is { $issuing_rule = $builder->build_object( {} ); }
 372     { carped => 'Missing class param' },
 373         'The class parameter is mandatory, raises a warning if absent';
 374     is( $issuing_rule, undef,
 375         'If the class parameter is missing, undef is returned' );
 376
 377     subtest 'Test all classes' => sub {
 378         my $Koha_modules_dir = dirname(__FILE__) . '/../../Koha';
 379         my @koha_object_based_modules = `/bin/grep -rl 'sub object_class' $Koha_modules_dir`;
 380         my @source_in_failure;
 381         for my $module_filepath ( @koha_object_based_modules ) {
 382             chomp $module_filepath;
 383             next unless $module_filepath =~ m|\.pm$|;
 384             my $module = $module_filepath;
 385             $module =~ s|^.*/(Koha.*)\.pm$|$1|;
 386             $module =~ s|/|::|g;
 387             next if $module eq 'Koha::Objects';
 388             eval "require $module";;
 389             my $object = $builder->build_object( { class => $module } );
 390             is( ref($object), $module->object_class, "Testing $module" );
 391         }
 392     };
 393 };
 394
 395 subtest '->build parameter' => sub {
 396     plan tests => 3;
 397
 398     # Test to make sure build() warns user of unknown parameters.
 399     warnings_are {
 400         $builder->build({
 401             source => 'Branch',
 402             value => {
 403                 branchcode => 'BRANCH_1'
 404             }
 405         })
 406     } [], "No warnings on correct use";
 407
 408     warnings_like {
 409         $builder->build({
 410             source     => 'Branch',
 411             branchcode => 'BRANCH_2' # This is wrong!
 412         })
 413     } qr/unknown param/i, "Carp unknown parameters";
 414
 415     warnings_like {
 416         $builder->build({
 417             zource     => 'Branch', # Intentional spelling error
 418         })
 419     } qr/Source parameter not specified/, "Catch warning on missing source";
 420 };
 421
 422 $schema->storage->txn_rollback;