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>.
22 use Test
::More tests
=> 13;
24 use File
::Basename
qw(dirname);
30 use_ok
('t::lib::TestBuilder');
33 our $schema = Koha
::Database
->new->schema;
34 $schema->storage->txn_begin;
37 $schema->resultset('DefaultCircRule')->delete; # Is a singleton table
39 subtest
'Start with some trivial tests' => sub {
42 $builder = t
::lib
::TestBuilder
->new;
43 isnt
( $builder, undef, 'We got a builder' );
46 warning_like
{ $data = $builder->build; } qr/.+/, 'Catch a warning';
47 is
( $data, undef, 'build without arguments returns undef' );
48 is
( ref( $builder->schema ), 'Koha::Schema', 'check schema' );
49 is
( ref( $builder->can('delete') ), 'CODE', 'found delete method' );
52 warning_like
{ $builder->build({
54 value
=> { surname
=> { invalid_hash
=> 1 } },
55 }) } qr/^Hash not allowed for surname/,
56 'Build should not accept a hash for this column';
58 # return undef if a record exists
59 my $branchcode = $builder->build({ source
=> 'Branch' })->{branchcode
};
60 my $param = { source
=> 'Branch', value
=> { branchcode
=> $branchcode } };
61 warning_like
{ $builder->build( $param ) }
62 qr/Violation of unique constraint/,
63 'Catch warn on adding existing record';
67 subtest
'Build all sources' => sub {
70 my @sources = $builder->schema->sources;
71 my @source_in_failure;
72 for my $source ( @sources ) {
74 # Skip the source if it is a view
75 next if $schema->source($source)->isa('DBIx::Class::ResultSource::View');
76 eval { $res = $builder->build( { source
=> $source } ); };
77 push @source_in_failure, $source if $@
|| !defined( $res );
79 is
( @source_in_failure, 0,
80 'TestBuilder should be able to create an object for every source' );
81 if ( @source_in_failure ) {
82 diag
( "The following sources have not been generated correctly: " .
83 join ', ', @source_in_failure );
88 subtest
'Test length of some generated fields' => sub {
91 # Test the length of a returned character field
92 my $bookseller = $builder->build({ source
=> 'Aqbookseller' });
93 my $max = $schema->source('Aqbookseller')->column_info('phone')->{size
};
94 is
( length( $bookseller->{phone
} ) > 0, 1,
95 'The length for a generated string (phone) should not be zero' );
96 is
( length( $bookseller->{phone
} ) <= $max, 1,
97 'Check maximum length for a generated string (phone)' );
99 my $item = $builder->build({ source
=> 'Item' });
100 is
( $item->{replacementprice
}, sprintf("%.2f", $item->{replacementprice
}), "The number of decimals for floats should not be more than 2" );
104 subtest
'Test FKs in overduerules_transport_type' => sub {
107 my $my_overduerules_transport_type = {
108 message_transport_type
=> {
109 message_transport_type
=> 'my msg_t_t',
112 branchcode
=> 'codeB',
113 categorycode
=> 'codeC',
117 my $overduerules_transport_type = $builder->build({
118 source
=> 'OverduerulesTransportType',
119 value
=> $my_overduerules_transport_type,
122 $overduerules_transport_type->{message_transport_type
},
123 $my_overduerules_transport_type->{message_transport_type
}->{message_transport_type
},
124 'build stores the message_transport_type correctly'
127 $schema->resultset('Overduerule')->find( $overduerules_transport_type->{overduerules_id
} )->branchcode,
128 $my_overduerules_transport_type->{overduerules_id
}->{branchcode
},
129 'build stores the branchcode correctly'
132 $schema->resultset('Overduerule')->find( $overduerules_transport_type->{overduerules_id
} )->categorycode,
133 $my_overduerules_transport_type->{overduerules_id
}->{categorycode
},
134 'build stores the categorycode correctly'
137 $schema->resultset('MessageTransportType')->find( $overduerules_transport_type->{message_transport_type
} )->message_transport_type,
138 $overduerules_transport_type->{message_transport_type
},
139 'build stores the foreign key message_transport_type correctly'
142 $schema->resultset('Overduerule')->find( $my_overduerules_transport_type->{overduerules_id
} )->letter2,
144 'build generates values if they are not given'
149 subtest
'Tests with composite FK in userpermission' => sub {
152 my $my_user_permission = default_userpermission
();
153 my $user_permission = $builder->build({
154 source
=> 'UserPermission',
155 value
=> $my_user_permission,
158 # Checks on top level of userpermission
160 $user_permission->{borrowernumber
},
162 'build generates a borrowernumber correctly'
165 $user_permission->{code
},
166 $my_user_permission->{code
}->{code
},
167 'build stores code correctly'
170 # Checks one level deeper userpermission -> borrower
171 my $patron = $schema->resultset('Borrower')->find({ borrowernumber
=> $user_permission->{borrowernumber
} });
174 $my_user_permission->{borrowernumber
}->{surname
},
175 'build stores surname correctly'
180 'build generated cardnumber'
183 # Checks two levels deeper userpermission -> borrower -> branch
184 my $branch = $schema->resultset('Branch')->find({ branchcode
=> $patron->branchcode->branchcode });
187 $my_user_permission->{borrowernumber
}->{branchcode
}->{branchname
},
188 'build stores branchname correctly'
191 $branch->branchaddress1,
193 'build generated branch address'
196 # Checks with composite FK: userpermission -> permission
197 my $perm = $schema->resultset('Permission')->find({ module_bit
=> $user_permission->{module_bit
}, code
=> $my_user_permission->{code
}->{code
} });
198 isnt
( $perm, undef, 'build generated record for composite FK' );
201 $my_user_permission->{code
}->{code
},
202 'build stored code correctly'
206 $my_user_permission->{code
}->{description
},
207 'build stored description correctly'
211 sub default_userpermission
{
214 surname
=> 'my surname',
215 address
=> 'my adress',
218 branchname
=> 'my branchname',
222 category_type
=> 'A',
223 default_privacy
=> 'default',
232 description
=> 'my desc',
238 subtest
'Test build with NULL values' => sub {
241 # PK should not be null
242 my $params = { source
=> 'Branch', value
=> { branchcode
=> undef }};
243 warning_like
{ $builder->build( $params ) }
244 qr/Null value for branchcode/,
245 'Catch warn on adding branch with a null branchcode';
247 my $info = $schema->source( 'Item' )->column_info( 'barcode' );
248 $params = { source
=> 'Item', value
=> { barcode
=> undef }};
249 my $item = $builder->build( $params );
250 is
( $info->{is_nullable
} && $item && !defined( $item->{barcode
} ), 1,
251 'Barcode can be NULL' );
253 $params = { source
=> 'Reserve', value
=> { itemnumber
=> undef }};
254 my $reserve = $builder->build( $params );
255 $info = $schema->source( 'Reserve' )->column_info( 'itemnumber' );
256 is
( $reserve && $info->{is_nullable
} && $info->{is_foreign_key
} &&
257 !defined( $reserve->{itemnumber
} ), 1, 'Nullable FK' );
261 subtest
'Tests for delete method' => sub {
264 # Test delete with single and multiple records
265 my $basket1 = $builder->build({ source
=> 'Aqbasket' });
266 my $basket2 = $builder->build({ source
=> 'Aqbasket' });
267 my $basket3 = $builder->build({ source
=> 'Aqbasket' });
268 my ( $id1, $id2 ) = ( $basket1->{basketno
}, $basket2->{basketno
} );
269 $builder->delete({ source
=> 'Aqbasket', records
=> $basket1 });
270 isnt
( exists $basket1->{basketno
}, 1, 'Delete cleared PK hash value' );
272 is
( $builder->schema->resultset('Aqbasket')->search({ basketno
=> $id1 })->count, 0, 'Basket1 is no longer found' );
273 is
( $builder->schema->resultset('Aqbasket')->search({ basketno
=> $id2 })->count, 1, 'Basket2 is still found' );
274 is
( $builder->delete({ source
=> 'Aqbasket', records
=> [ $basket2, $basket3 ] }), 2, "Returned two delete attempts" );
275 is
( $builder->schema->resultset('Aqbasket')->search({ basketno
=> $id2 })->count, 0, 'Basket2 is no longer found' );
278 # Test delete in table without primary key (..)
279 is
( $schema->source('TmpHoldsqueue')->primary_columns, 0,
280 'Table without primary key detected' );
281 my $bibno = 123; # just a number
282 my $cnt1 = $schema->resultset('TmpHoldsqueue')->count;
283 # Insert a new record in TmpHoldsqueue with that biblionumber
284 my $val = { biblionumber
=> $bibno };
285 my $rec = $builder->build({ source
=> 'TmpHoldsqueue', value
=> $val });
286 my $cnt2 = $schema->resultset('TmpHoldsqueue')->count;
287 is
( defined($rec) && $cnt2 == $cnt1 + 1 , 1, 'Created a record' );
288 is
( $builder->delete({ source
=> 'TmpHoldsqueue', records
=> $rec }),
289 undef, 'delete returns undef' );
290 is
( $rec->{biblionumber
}, $bibno, 'Hash value untouched' );
291 is
( $schema->resultset('TmpHoldsqueue')->count, $cnt2,
292 "Method did not delete record in table without PK" );
294 # Test delete with NULL values
295 $val = { branchcode
=> undef };
296 is
( $builder->delete({ source
=> 'Branch', records
=> $val }), 0,
297 'delete returns zero for an undef search with one key' );
298 $val = { module_bit
=> 1, #catalogue
300 is
( $builder->delete({ source
=> 'Permission', records
=> $val }), 0,
301 'delete returns zero for an undef search with a composite PK' );
305 subtest
'Auto-increment values tests' => sub {
308 # Pick a table with AI PK
309 my $source = 'Biblio'; # table
310 my $column = 'biblionumber'; # ai column
312 my $col_info = $schema->source( $source )->column_info( $column );
313 is
( $col_info->{is_auto_increment
}, 1, "biblio.biblionumber is detected as autoincrement");
316 my $biblio_1 = $builder->build({ source
=> $source });
318 my $ai_value = $biblio_1->{ biblionumber
};
320 my $biblio_2 = $builder->build({ source
=> $source });
321 # Get the next AI value
322 my $next_ai_value = $biblio_2->{ biblionumber
};
323 is
( $ai_value + 1, $next_ai_value, "AI values are consecutive");
325 # respect autoincr column
326 warning_like
{ $builder->build({
328 value
=> { biblionumber
=> 123 },
329 }) } qr/^Value not allowed for auto_incr/,
330 'Build should not overwrite an auto_incr column';
333 subtest
'Date handling' => sub {
336 $builder = t
::lib
::TestBuilder
->new;
338 my $patron = $builder->build( { source
=> 'Borrower' } );
339 is
( length( $patron->{updated_on
} ), 19, 'A timestamp column value should be YYYY-MM-DD HH:MM:SS' );
340 is
( length( $patron->{dateofbirth
} ), 10, 'A date column value should be YYYY-MM-DD' );
343 subtest
'Default values' => sub {
345 $builder = t
::lib
::TestBuilder
->new;
346 my $item = $builder->build( { source
=> 'Item' } );
347 is
( $item->{more_subfields_xml
}, undef, 'This xml field should be undef' );
348 $item = $builder->build( { source
=> 'Item', value
=> { more_subfields_xml
=> 'some xml' } } );
349 is
( $item->{more_subfields_xml
}, 'some xml', 'Default should not overwrite assigned value' );
352 subtest
'build_object() tests' => sub {
356 $builder = t
::lib
::TestBuilder
->new();
358 my $categorycode = $builder->build( { source
=> 'Category' } )->{categorycode
};
359 my $itemtype = $builder->build( { source
=> 'Itemtype' } )->{itemtype
};
361 my $issuing_rule = $builder->build_object(
362 { class => 'Koha::IssuingRules',
364 categorycode
=> $categorycode,
365 itemtype
=> $itemtype
370 is
( ref($issuing_rule), 'Koha::IssuingRule', 'Type is correct' );
371 is
( $issuing_rule->categorycode,
372 $categorycode, 'Category code correctly set' );
373 is
( $issuing_rule->itemtype, $itemtype, 'Item type correctly set' );
375 subtest
'Test all classes' => sub {
376 my $Koha_modules_dir = dirname
(__FILE__
) . '/../../Koha';
377 my @koha_object_based_modules = `/bin/grep -rl -e '^sub object_class' $Koha_modules_dir`;
378 my @source_in_failure;
379 for my $module_filepath ( @koha_object_based_modules ) {
380 chomp $module_filepath;
381 next unless $module_filepath =~ m
|\
.pm
$|;
382 my $module = $module_filepath;
383 $module =~ s
|^.*/(Koha
.*)\
.pm
$|$1|;
385 next if $module eq 'Koha::Objects';
386 eval "require $module";;
387 my $object = $builder->build_object( { class => $module } );
388 is
( ref($object), $module->object_class, "Testing $module" );
392 subtest
'test parameters' => sub {
395 warning_is
{ $issuing_rule = $builder->build_object( {} ); }
396 { carped
=> 'Missing class param' },
397 'The class parameter is mandatory, raises a warning if absent';
398 is
( $issuing_rule, undef,
399 'If the class parameter is missing, undef is returned' );
402 $builder->build_object(
403 { class => 'Koha::Patrons', categorycode
=> 'foobar' } );
404 } qr{Unknown parameter\(s\): categorycode}, "Unknown parameter detected";
408 subtest
'->build parameter' => sub {
411 # Test to make sure build() warns user of unknown parameters.
416 branchcode
=> 'BRANCH_1'
419 } [], "No warnings on correct use";
424 branchcode
=> 'BRANCH_2' # This is wrong!
426 } qr/unknown param/i, "Carp unknown parameters";
430 zource
=> 'Branch', # Intentional spelling error
432 } qr/Source parameter not specified/, "Catch warning on missing source";
436 { source
=> 'Borrower', categorycode
=> 'foobar' } );
437 } qr{Unknown parameter\(s\): categorycode}, "Unkown parameter detected";
440 $schema->storage->txn_rollback;