3 # This file is part of Koha.
5 # Copyright 2014 - Biblibre SARL
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.
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.
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>.
24 use Test::More tests => 16;
27 use File::Basename qw(dirname);
33 use_ok('t::lib::TestBuilder');
36 our $schema = Koha::Database->new->schema;
39 subtest 'Start with some trivial tests' => sub {
42 $schema->storage->txn_begin;
44 $builder = t::lib::TestBuilder->new;
45 isnt( $builder, undef, 'We got a builder' );
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' );
54 warning_like { $builder->build({
56 value => { surname => { invalid_hash => 1 } },
57 }) } qr/^Hash not allowed for surname/,
58 'Build should not accept a hash for this column';
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';
67 $schema->storage->txn_rollback;
71 subtest 'Build all sources' => sub {
74 $schema->storage->txn_begin;
76 my @sources = $builder->schema->sources;
77 my @source_in_failure;
78 for my $source ( @sources ) {
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 );
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 );
92 $schema->storage->txn_rollback;
96 subtest 'Test length of some generated fields' => sub {
99 $schema->storage->txn_begin;
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)' );
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" );
112 $schema->storage->txn_rollback;
116 subtest 'Test FKs in overduerules_transport_type' => sub {
119 $schema->storage->txn_begin;
121 my $my_overduerules_transport_type = {
122 message_transport_type => {
123 message_transport_type => 'my msg_t_t',
126 branchcode => 'codeB',
127 categorycode => 'codeC',
131 my $overduerules_transport_type = $builder->build({
132 source => 'OverduerulesTransportType',
133 value => $my_overduerules_transport_type,
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'
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'
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'
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'
156 $schema->resultset('Overduerule')->find( $my_overduerules_transport_type->{overduerules_id} )->letter2,
158 'build generates values if they are not given'
161 $schema->storage->txn_rollback;
165 subtest 'Tests with composite FK in userpermission' => sub {
168 $schema->storage->txn_begin;
170 my $my_user_permission = default_userpermission();
171 my $user_permission = $builder->build({
172 source => 'UserPermission',
173 value => $my_user_permission,
176 # Checks on top level of userpermission
178 $user_permission->{borrowernumber},
180 'build generates a borrowernumber correctly'
183 $user_permission->{code},
184 $my_user_permission->{code}->{code},
185 'build stores code correctly'
188 # Checks one level deeper userpermission -> borrower
189 my $patron = $schema->resultset('Borrower')->find({ borrowernumber => $user_permission->{borrowernumber} });
192 $my_user_permission->{borrowernumber}->{surname},
193 'build stores surname correctly'
198 'build generated cardnumber'
201 # Checks two levels deeper userpermission -> borrower -> branch
202 my $branch = $schema->resultset('Branch')->find({ branchcode => $patron->branchcode->branchcode });
205 $my_user_permission->{borrowernumber}->{branchcode}->{branchname},
206 'build stores branchname correctly'
209 $branch->branchaddress1,
211 'build generated branch address'
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' );
219 $my_user_permission->{code}->{code},
220 'build stored code correctly'
224 $my_user_permission->{code}->{description},
225 'build stored description correctly'
228 $schema->storage->txn_rollback;
231 sub default_userpermission {
234 surname => 'my surname',
235 address => 'my adress',
238 branchname => 'my branchname',
242 category_type => 'A',
243 default_privacy => 'default',
254 description => 'my desc',
260 subtest 'Test build with NULL values' => sub {
263 $schema->storage->txn_begin;
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';
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' );
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' );
283 $schema->storage->txn_rollback;
287 subtest 'Tests for delete method' => sub {
290 $schema->storage->txn_begin;
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' );
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' );
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" );
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
328 is( $builder->delete({ source => 'Permission', records => $val }), 0,
329 'delete returns zero for an undef search with a composite PK' );
331 $schema->storage->txn_rollback;
334 subtest 'Auto-increment values tests' => sub {
337 $schema->storage->txn_begin;
339 # Pick a table with AI PK
340 my $source = 'Biblio'; # table
341 my $column = 'biblionumber'; # ai column
343 my $col_info = $schema->source( $source )->column_info( $column );
344 is( $col_info->{is_auto_increment}, 1, "biblio.biblionumber is detected as autoincrement");
347 my $biblio_1 = $builder->build({ source => $source });
349 my $ai_value = $biblio_1->{ biblionumber };
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");
356 # respect autoincr column
357 warning_like { $builder->build({
359 value => { biblionumber => 123 },
360 }) } qr/^Value not allowed for auto_incr/,
361 'Build should not overwrite an auto_incr column';
363 $schema->storage->txn_rollback;
366 subtest 'Date handling' => sub {
369 $schema->storage->txn_begin;
371 $builder = t::lib::TestBuilder->new;
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' );
377 $schema->storage->txn_rollback;
380 subtest 'Default values' => sub {
383 $schema->storage->txn_begin;
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' );
391 subtest 'generated dynamically (coderef)' => sub {
393 my $patron = $builder->build_object({ class => 'Koha::Patrons' });
394 like( $patron->category->category_type, qr{^(A|C|S|I|P|)$}, );
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', );
401 $schema->storage->txn_rollback;
404 subtest 'build_object() tests' => sub {
408 $schema->storage->txn_begin;
410 $builder = t::lib::TestBuilder->new();
412 my $branchcode = $builder->build( { source => 'Branch' } )->{branchcode};
413 my $categorycode = $builder->build( { source => 'Category' } )->{categorycode};
414 my $itemtype = $builder->build( { source => 'Itemtype' } )->{itemtype};
416 my $issuing_rule = $builder->build_object(
417 { class => 'Koha::CirculationRules',
419 branchcode => $branchcode,
420 categorycode => $categorycode,
421 itemtype => $itemtype
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' );
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|;
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" );
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");
460 subtest 'test parameters' => sub {
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' );
470 $builder->build_object(
471 { class => 'Koha::Patrons', categorycode => 'foobar' } );
472 } qr{Unknown parameter\(s\): categorycode}, "Unknown parameter detected";
475 $schema->storage->txn_rollback;
478 subtest '->build parameter' => sub {
481 $schema->storage->txn_begin;
483 # Test to make sure build() warns user of unknown parameters.
488 branchcode => 'BRANCH_1'
491 } [], "No warnings on correct use";
496 branchcode => 'BRANCH_2' # This is wrong!
498 } qr/unknown param/i, "Carp unknown parameters";
502 zource => 'Branch', # Intentional spelling error
504 } qr/Source parameter not specified/, "Catch warning on missing source";
508 { source => 'Borrower', categorycode => 'foobar' } );
509 } qr{Unknown parameter\(s\): categorycode}, "Unkown parameter detected";
511 $schema->storage->txn_rollback;
514 subtest 'build_sample_biblio() tests' => sub {
518 $schema->storage->txn_begin;
521 { $builder->build_sample_biblio({ title => 'hell❤️' }); }
523 "No encoding warnings!";
525 $schema->storage->txn_rollback;
528 subtest 'Existence of object is only checked using primary keys' => sub {
532 $schema->storage->txn_begin;
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 });
538 $builder->build_object({
539 class => 'Koha::Holds',
541 biblionumber => $biblio->biblionumber
544 } [], "No warning about query returning more than one row";
546 $schema->storage->txn_rollback;
549 subtest 'Test bad columns' => sub {
551 $schema->storage->txn_begin;
554 my $patron = $builder->build_object({ class => 'Koha::Patrons', value => { wrong => 1 } });
555 ok( 0, 'Unexpected pass with wrong column' );
558 like( $_, qr/^Error: value hash contains unrecognized columns: wrong/, 'Column wrong is bad' );
561 my $patron = $builder->build_object({ class => 'Koha::Patrons', value => { surname => 'Pass', nested => { ignored => 1 }} });
562 ok( 1, 'Nested hash ignored' );
565 ok( 0, 'Unexpected trouble with nested hash' );
568 my $patron = $builder->build_object({
569 class => 'Koha::Patrons',
570 value => { surname => 'WontPass', categorycode => { description => 'bla', wrong_nested => 1 }},
572 ok( 0, 'Unexpected pass with wrong nested column' );
575 like( $_, qr/^Error: value hash contains unrecognized columns: wrong_nested/, 'Column wrong_nested is bad' );
578 $schema->storage->txn_rollback;