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
=> 12;
24 use File
::Basename
qw(dirname);
30 use_ok
('t::lib::TestBuilder');
33 our $schema = Koha
::Database
->new->schema;
34 $schema->storage->txn_begin;
38 subtest
'Start with some trivial tests' => sub {
41 $builder = t
::lib
::TestBuilder
->new;
42 isnt
( $builder, undef, 'We got a builder' );
44 is
( $builder->build, undef, 'build without arguments returns undef' );
45 is
( ref( $builder->schema ), 'Koha::Schema', 'check schema' );
46 is
( ref( $builder->can('delete') ), 'CODE', 'found delete method' );
49 warning_like
{ $builder->build({
51 value
=> { surname
=> { invalid_hash
=> 1 } },
52 }) } qr/^Hash not allowed for surname/,
53 'Build should not accept a hash for this column';
55 # return undef if a record exists
56 my $branchcode = $builder->build({ source
=> 'Branch' })->{branchcode
};
57 my $param = { source
=> 'Branch', value
=> { branchcode
=> $branchcode } };
58 warning_like
{ $builder->build( $param ) }
59 qr/Violation of unique constraint/,
60 'Catch warn on adding existing record';
64 subtest
'Build all sources' => sub {
67 my @sources = $builder->schema->sources;
68 my @source_in_failure;
69 for my $source ( @sources ) {
71 # Skip the source if it is a view
72 next if $schema->source($source)->isa('DBIx::Class::ResultSource::View');
73 eval { $res = $builder->build( { source
=> $source } ); };
74 push @source_in_failure, $source if $@
|| !defined( $res );
76 is
( @source_in_failure, 0,
77 'TestBuilder should be able to create an object for every source' );
78 if ( @source_in_failure ) {
79 diag
( "The following sources have not been generated correctly: " .
80 join ', ', @source_in_failure );
85 subtest
'Test length of some generated fields' => sub {
88 # Test the length of a returned character field
89 my $bookseller = $builder->build({ source
=> 'Aqbookseller' });
90 my $max = $schema->source('Aqbookseller')->column_info('phone')->{size
};
91 is
( length( $bookseller->{phone
} ) > 0, 1,
92 'The length for a generated string (phone) should not be zero' );
93 is
( length( $bookseller->{phone
} ) <= $max, 1,
94 'Check maximum length for a generated string (phone)' );
98 subtest
'Test FKs in overduerules_transport_type' => sub {
101 my $my_overduerules_transport_type = {
102 message_transport_type
=> {
103 message_transport_type
=> 'my msg_t_t',
106 branchcode
=> 'codeB',
107 categorycode
=> 'codeC',
111 my $overduerules_transport_type = $builder->build({
112 source
=> 'OverduerulesTransportType',
113 value
=> $my_overduerules_transport_type,
116 $overduerules_transport_type->{message_transport_type
},
117 $my_overduerules_transport_type->{message_transport_type
}->{message_transport_type
},
118 'build stores the message_transport_type correctly'
121 $schema->resultset('Overduerule')->find( $overduerules_transport_type->{overduerules_id
} )->branchcode,
122 $my_overduerules_transport_type->{overduerules_id
}->{branchcode
},
123 'build stores the branchcode correctly'
126 $schema->resultset('Overduerule')->find( $overduerules_transport_type->{overduerules_id
} )->categorycode,
127 $my_overduerules_transport_type->{overduerules_id
}->{categorycode
},
128 'build stores the categorycode correctly'
131 $schema->resultset('MessageTransportType')->find( $overduerules_transport_type->{message_transport_type
} )->message_transport_type,
132 $overduerules_transport_type->{message_transport_type
},
133 'build stores the foreign key message_transport_type correctly'
136 $schema->resultset('Overduerule')->find( $my_overduerules_transport_type->{overduerules_id
} )->letter2,
138 'build generates values if they are not given'
143 subtest
'Tests with composite FK in userpermission' => sub {
146 my $my_user_permission = default_userpermission
();
147 my $user_permission = $builder->build({
148 source
=> 'UserPermission',
149 value
=> $my_user_permission,
152 # Checks on top level of userpermission
154 $user_permission->{borrowernumber
},
156 'build generates a borrowernumber correctly'
159 $user_permission->{code
},
160 $my_user_permission->{code
}->{code
},
161 'build stores code correctly'
164 # Checks one level deeper userpermission -> borrower
165 my $patron = $schema->resultset('Borrower')->find({ borrowernumber
=> $user_permission->{borrowernumber
} });
168 $my_user_permission->{borrowernumber
}->{surname
},
169 'build stores surname correctly'
174 'build generated cardnumber'
177 # Checks two levels deeper userpermission -> borrower -> branch
178 my $branch = $schema->resultset('Branch')->find({ branchcode
=> $patron->branchcode->branchcode });
181 $my_user_permission->{borrowernumber
}->{branchcode
}->{branchname
},
182 'build stores branchname correctly'
185 $branch->branchaddress1,
187 'build generated branch address'
190 # Checks with composite FK: userpermission -> permission
191 my $perm = $schema->resultset('Permission')->find({ module_bit
=> $user_permission->{module_bit
}, code
=> $my_user_permission->{code
}->{code
} });
192 isnt
( $perm, undef, 'build generated record for composite FK' );
195 $my_user_permission->{code
}->{code
},
196 'build stored code correctly'
200 $my_user_permission->{code
}->{description
},
201 'build stored description correctly'
205 sub default_userpermission
{
208 surname
=> 'my surname',
209 address
=> 'my adress',
212 branchname
=> 'my branchname',
216 category_type
=> 'A',
217 default_privacy
=> 'default',
226 description
=> 'my desc',
232 subtest
'Test build with NULL values' => sub {
235 # PK should not be null
236 my $params = { source
=> 'Branch', value
=> { branchcode
=> undef }};
237 warning_like
{ $builder->build( $params ) }
238 qr/Null value for branchcode/,
239 'Catch warn on adding branch with a null branchcode';
241 my $info = $schema->source( 'Item' )->column_info( 'barcode' );
242 $params = { source
=> 'Item', value
=> { barcode
=> undef }};
243 my $item = $builder->build( $params );
244 is
( $info->{is_nullable
} && $item && !defined( $item->{barcode
} ), 1,
245 'Barcode can be NULL' );
247 $params = { source
=> 'Reserve', value
=> { itemnumber
=> undef }};
248 my $reserve = $builder->build( $params );
249 $info = $schema->source( 'Reserve' )->column_info( 'itemnumber' );
250 is
( $reserve && $info->{is_nullable
} && $info->{is_foreign_key
} &&
251 !defined( $reserve->{itemnumber
} ), 1, 'Nullable FK' );
255 subtest
'Tests for delete method' => sub {
258 # Test delete with single and multiple records
259 my $basket1 = $builder->build({ source
=> 'Aqbasket' });
260 my $basket2 = $builder->build({ source
=> 'Aqbasket' });
261 my $basket3 = $builder->build({ source
=> 'Aqbasket' });
262 my ( $id1, $id2 ) = ( $basket1->{basketno
}, $basket2->{basketno
} );
263 $builder->delete({ source
=> 'Aqbasket', records
=> $basket1 });
264 isnt
( exists $basket1->{basketno
}, 1, 'Delete cleared PK hash value' );
266 is
( $builder->schema->resultset('Aqbasket')->search({ basketno
=> $id1 })->count, 0, 'Basket1 is no longer found' );
267 is
( $builder->schema->resultset('Aqbasket')->search({ basketno
=> $id2 })->count, 1, 'Basket2 is still found' );
268 is
( $builder->delete({ source
=> 'Aqbasket', records
=> [ $basket2, $basket3 ] }), 2, "Returned two delete attempts" );
269 is
( $builder->schema->resultset('Aqbasket')->search({ basketno
=> $id2 })->count, 0, 'Basket2 is no longer found' );
272 # Test delete in table without primary key (..)
273 is
( $schema->source('TmpHoldsqueue')->primary_columns, 0,
274 'Table without primary key detected' );
275 my $bibno = 123; # just a number
276 my $cnt1 = $schema->resultset('TmpHoldsqueue')->count;
277 # Insert a new record in TmpHoldsqueue with that biblionumber
278 my $val = { biblionumber
=> $bibno };
279 my $rec = $builder->build({ source
=> 'TmpHoldsqueue', value
=> $val });
280 my $cnt2 = $schema->resultset('TmpHoldsqueue')->count;
281 is
( defined($rec) && $cnt2 == $cnt1 + 1 , 1, 'Created a record' );
282 is
( $builder->delete({ source
=> 'TmpHoldsqueue', records
=> $rec }),
283 undef, 'delete returns undef' );
284 is
( $rec->{biblionumber
}, $bibno, 'Hash value untouched' );
285 is
( $schema->resultset('TmpHoldsqueue')->count, $cnt2,
286 "Method did not delete record in table without PK" );
288 # Test delete with NULL values
289 $val = { branchcode
=> undef };
290 is
( $builder->delete({ source
=> 'Branch', records
=> $val }), 0,
291 'delete returns zero for an undef search with one key' );
292 $val = { module_bit
=> 1, #catalogue
294 is
( $builder->delete({ source
=> 'Permission', records
=> $val }), 0,
295 'delete returns zero for an undef search with a composite PK' );
299 subtest
'Auto-increment values tests' => sub {
302 # Pick a table with AI PK
303 my $source = 'Biblio'; # table
304 my $column = 'biblionumber'; # ai column
306 my $col_info = $schema->source( $source )->column_info( $column );
307 is
( $col_info->{is_auto_increment
}, 1, "biblio.biblionumber is detected as autoincrement");
310 my $biblio_1 = $builder->build({ source
=> $source });
312 my $ai_value = $biblio_1->{ biblionumber
};
314 my $biblio_2 = $builder->build({ source
=> $source });
315 # Get the next AI value
316 my $next_ai_value = $biblio_2->{ biblionumber
};
317 is
( $ai_value + 1, $next_ai_value, "AI values are consecutive");
319 # respect autoincr column
320 warning_like
{ $builder->build({
322 value
=> { biblionumber
=> 123 },
323 }) } qr/^Value not allowed for auto_incr/,
324 'Build should not overwrite an auto_incr column';
327 subtest
'Date handling' => sub {
330 $builder = t
::lib
::TestBuilder
->new;
332 my $patron = $builder->build( { source
=> 'Borrower' } );
333 is
( length( $patron->{updated_on
} ), 19, 'A timestamp column value should be YYYY-MM-DD HH:MM:SS' );
334 is
( length( $patron->{dateofbirth
} ), 10, 'A date column value should be YYYY-MM-DD' );
338 subtest
'Default values' => sub {
340 $builder = t
::lib
::TestBuilder
->new;
341 my $item = $builder->build( { source
=> 'Item' } );
342 is
( $item->{more_subfields_xml
}, undef, 'This xml field should be undef' );
343 $item = $builder->build( { source
=> 'Item', value
=> { more_subfields_xml
=> 'some xml' } } );
344 is
( $item->{more_subfields_xml
}, 'some xml', 'Default should not overwrite assigned value' );
347 subtest
'build_object() tests' => sub {
351 $builder = t
::lib
::TestBuilder
->new();
353 my $categorycode = $builder->build( { source
=> 'Category' } )->{categorycode
};
354 my $itemtype = $builder->build( { source
=> 'Itemtype' } )->{itemtype
};
356 my $issuing_rule = $builder->build_object(
357 { class => 'Koha::IssuingRules',
359 categorycode
=> $categorycode,
360 itemtype
=> $itemtype
365 is
( ref($issuing_rule), 'Koha::IssuingRule', 'Type is correct' );
366 is
( $issuing_rule->categorycode,
367 $categorycode, 'Category code correctly set' );
368 is
( $issuing_rule->itemtype, $itemtype, 'Item type correctly set' );
370 warning_is
{ $issuing_rule = $builder->build_object( {} ); }
371 { carped
=> 'Missing class param' },
372 'The class parameter is mandatory, raises a warning if absent';
373 is
( $issuing_rule, undef,
374 'If the class parameter is missing, undef is returned' );
376 subtest
'Test all classes' => sub {
377 my $Koha_modules_dir = dirname
(__FILE__
) . '/../../Koha';
378 my @koha_object_based_modules = `/bin/grep -rl 'sub object_class' $Koha_modules_dir`;
379 my @source_in_failure;
380 for my $module_filepath ( @koha_object_based_modules ) {
381 chomp $module_filepath;
382 next unless $module_filepath =~ m
|\
.pm
$|;
383 my $module = $module_filepath;
384 $module =~ s
|^.*/(Koha
.*)\
.pm
$|$1|;
386 next if $module eq 'Koha::Objects';
387 eval "require $module";;
388 my $object = $builder->build_object( { class => $module } );
389 is
( ref($object), $module->object_class, "Testing $module" );
394 $schema->storage->txn_rollback;