2 use base qw(Test::Class);
7 eval "use Test::Class";
8 plan skip_all => "Test::Class required for performing database tests" if $@;
9 # Or, maybe I should just die there.
21 use File::Temp qw/ tempdir /;
23 # Since this is an abstract base class, this prevents these tests from
24 # being run directly unless we're testing a subclass. It just makes
26 __PACKAGE__->SKIP_CLASS( 1 );
29 =head2 startup methods
31 these are run once, at the beginning of the whole test suite
35 sub startup_15_truncate_tables : Test( startup => 1 ) {
38 # my @truncate_tables = qw( accountlines
50 # auth_subfield_structure
76 # import_record_matches
86 # language_descriptions
87 # language_rfc4646_to_iso639
88 # language_script_bidi
89 # language_script_mapping
90 # language_subtag_registry
93 # marc_subfield_structure
97 # matchpoint_component_norms
98 # matchpoint_components
110 # repeatable_holidays
126 # subscriptionhistory
127 # subscriptionroutinglist
132 # virtualshelfcontents
138 my @truncate_tables = qw( accountlines
185 subscriptionroutinglist
191 my $failed_to_truncate = 0;
192 foreach my $table ( @truncate_tables ) {
193 my $dbh = C4::Context->dbh();
194 $dbh->do( "truncate $table" )
195 or $failed_to_truncate = 1;
197 is( $failed_to_truncate, 0, 'truncated tables' );
200 =head2 startup_20_add_bookseller
202 we need a bookseller for many of the tests, so let's insert one. Feel
203 free to use this one, or insert your own.
207 sub startup_20_add_bookseller : Test(startup => 1) {
210 my $booksellerinfo = { name => 'bookseller ' . $self->random_string(),
213 my $id = AddBookseller( $booksellerinfo );
214 ok( $id, "created bookseller: $id" );
215 $self->{'booksellerid'} = $id;
220 =head2 startup_22_add_bookfund
222 we need a bookfund for many of the tests. This currently uses one that
223 is in the skeleton database. free to use this one, or insert your
228 sub startup_22_add_bookfund : Test(startup => 2) {
231 my $bookfundid = 'GEN';
232 my $bookfund = GetBookFund( $bookfundid, undef );
233 # diag( Data::Dumper->Dump( [ $bookfund ], qw( bookfund ) ) );
234 is( $bookfund->{'bookfundid'}, $bookfundid, "found bookfund: '$bookfundid'" );
235 is( $bookfund->{'bookfundname'}, 'General Stacks', "found bookfund: '$bookfundid'" );
237 $self->{'bookfundid'} = $bookfundid;
241 =head2 startup_24_add_member
243 Add a patron/member for the tests to use
247 sub startup_24_add_member : Test(startup => 1) {
250 my $memberinfo = { surname => 'surname ' . $self->random_string(),
251 firstname => 'firstname' . $self->random_string(),
252 address => 'address' . $self->random_string(),
253 city => 'city' . $self->random_string(),
254 cardnumber => 'card' . $self->random_string(),
255 branchcode => 'CPL', # CPL => Centerville
256 categorycode => 'PT', # PT => PaTron
257 dateexpiry => '2010-01-01',
258 password => 'testpassword',
261 my $borrowernumber = AddMember( %$memberinfo );
262 ok( $borrowernumber, "created member: $borrowernumber" );
263 $self->{'memberid'} = $borrowernumber;
268 =head2 startup_30_login
272 sub startup_30_login : Test( startup => 2 ) {
275 $self->{'sessionid'} = '12345678'; # does this value matter?
276 my $borrower_details = C4::Members::GetMemberDetails( $self->{'memberid'} );
277 ok( $borrower_details->{'cardnumber'}, 'cardnumber' );
279 # make a cookie and force it into $cgi.
280 # This would be a lot easier with Test::MockObject::Extends.
281 my $cgi = CGI->new( { userid => $borrower_details->{'cardnumber'},
282 password => 'testpassword' } );
283 my $setcookie = $cgi->cookie( -name => 'CGISESSID',
284 -value => $self->{'sessionid'} );
285 $cgi->{'.cookies'} = { CGISESSID => $setcookie };
286 is( $cgi->cookie('CGISESSID'), $self->{'sessionid'}, 'the CGISESSID cookie is set' );
287 # diag( Data::Dumper->Dump( [ $cgi->cookie('CGISESSID') ], [ qw( cookie ) ] ) );
289 # C4::Auth::checkauth sometimes emits a warning about unable to append to sessionlog. That's OK.
290 my ( $userid, $cookie, $sessionID ) = C4::Auth::checkauth( $cgi, 'noauth', {}, 'intranet' );
291 # diag( Data::Dumper->Dump( [ $userid, $cookie, $sessionID ], [ qw( userid cookie sessionID ) ] ) );
293 # my $session = C4::Auth::get_session( $sessionID );
294 # diag( Data::Dumper->Dump( [ $session ], [ qw( session ) ] ) );
301 setup methods are run before every test method
305 =head2 teardown methods
307 teardown methods are many time, once at the end of each test method.
311 =head2 shutdown methods
313 shutdown methods are run once, at the end of the test suite
317 =head2 utility methods
319 These are not test methods, but they're handy
325 Nice for generating names and such. It's not actually random, more
333 my $wordsize = 6; # how many letters in your string?
335 # leave out these characters: "oOlL10". They're too confusing.
336 my @alphabet = ( 'a'..'k','m','n','p'..'z', 'A'..'K','M','N','P'..'Z', 2..9 );
339 foreach ( 0..$wordsize ) {
340 $randomstring .= $alphabet[ rand( scalar( @alphabet ) ) ];
342 return $randomstring;
348 $self->add_biblios( count => 10,
352 count: number of biblios to add
353 add_items: should you add items for each one?
359 adds the biblionumbers to the $self->{'biblios'} listref
362 Should I allow you to pass in biblio information, like title?
363 Since this method is in the KohaTest class, all tests in it will be ignored, unless you call this from your own namespace.
364 This runs 10 tests, plus 4 for each "count", plus 3 more for each item added.
372 $param{'count'} = 1 unless defined( $param{'count'} );
373 $param{'add_items'} = 0 unless defined( $param{'add_items'} );
375 foreach my $counter ( 1..$param{'count'} ) {
376 my $marcrecord = MARC::Record->new();
377 isa_ok( $marcrecord, 'MARC::Record' );
378 my $appendedfieldscount = $marcrecord->append_fields( MARC::Field->new( '100', '1', '0',
381 MARC::Field->new( '245', '1', '4',
382 a => sprintf( 'The Adventures of Huckleberry Finn Test %s', $counter ),
383 c => "Mark Twain ; illustrated by E.W. Kemble." ),
384 MARC::Field->new( '952', '0', '0',
385 p => '12345678' . $self->random_string() ), # barcode
386 MARC::Field->new( '952', '0', '0',
391 diag $MARC::Record::ERROR if ( $MARC::Record::ERROR );
392 is( $appendedfieldscount, 4, 'added 4 fields' );
394 my $frameworkcode = ''; # XXX I'd like to put something reasonable here.
395 my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $marcrecord, $frameworkcode );
396 ok( $biblionumber, "the biblionumber is $biblionumber" );
397 ok( $biblioitemnumber, "the biblioitemnumber is $biblioitemnumber" );
398 if ( $param{'add_items'} ) {
399 # my @iteminfo = AddItem( {}, $biblionumber );
400 my @iteminfo = AddItemFromMarc( $marcrecord, $biblionumber );
401 is( $iteminfo[0], $biblionumber, "biblionumber is $biblionumber" );
402 is( $iteminfo[1], $biblioitemnumber, "biblioitemnumber is $biblioitemnumber" );
403 ok( $iteminfo[2], "itemnumber is $iteminfo[2]" );
405 push @{$self->{'biblios'}}, $biblionumber;
408 my $query = 'Finn Test';
410 # XXX we're going to repeatedly try to fetch the marc records that
411 # we inserted above. It may take a while before they all show
414 DELAY: foreach my $trial ( 1..$tries ) {
415 diag "waiting for zebra indexing. Trial: $trial of $tries";
416 my ( $error, $results ) = SimpleSearch( $query );
417 if ( $param{'count'} <= scalar( @$results ) ) {
418 ok( $tries, "found all $param{'count'} titles after $trial tries" );
423 if ( $trial == $tries ) {
424 fail( "we never found all $param{'count'} titles even after $tries tries." );
433 Do a fast reindexing of all of the bib and authority
434 records and mark all zebraqueue entries done.
436 Useful for test routines that need to do a
437 lot of indexing without having to wait for
440 In NoZebra model, this only marks zebraqueue
441 done - the records should already be indexed.
448 # mark zebraqueue done regardless of the indexing mode
449 my $dbh = C4::Context->dbh();
450 $dbh->do("UPDATE zebraqueue SET done = 1 WHERE done = 0");
452 return if C4::Context->preference('NoZebra');
454 my $directory = tempdir(CLEANUP => 1);
455 foreach my $record_type qw(biblio authority) {
456 mkdir "$directory/$record_type";
457 my $sth = $dbh->prepare($record_type eq "biblio" ? "SELECT marc FROM biblioitems" : "SELECT marc FROM auth_header");
459 open OUT, ">:utf8", "$directory/$record_type/records";
460 while (my ($blob) = $sth->fetchrow_array) {
464 my $zebra_server = "${record_type}server";
465 my $zebra_config = C4::Context->zebraconfig($zebra_server)->{'config'};
466 my $zebra_db_dir = C4::Context->zebraconfig($zebra_server)->{'directory'};
467 my $zebra_db = $record_type eq 'biblio' ? 'biblios' : 'authorities';
468 system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 init > /dev/null 2>\&1";
469 system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 update $directory/${record_type} > /dev/null 2>\&1";
470 system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 commit > /dev/null 2>\&1";
476 =head3 clear_test_database
478 removes all tables from test database so that install starts with a clean slate
482 sub clear_test_database {
484 diag "removing tables from test database";
486 my $dbh = C4::Context->dbh;
487 my $schema = C4::Context->config("database");
489 my @tables = get_all_tables($dbh, $schema);
490 foreach my $table (@tables) {
491 drop_all_foreign_keys($dbh, $table);
494 foreach my $table (@tables) {
495 drop_table($dbh, $table);
500 my ($dbh, $schema) = @_;
501 my $sth = $dbh->prepare("SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ?");
503 $sth->execute($schema);
504 while (my ($table) = $sth->fetchrow_array) {
505 push @tables, $table;
511 sub drop_all_foreign_keys {
512 my ($dbh, $table) = @_;
513 # get the table description
514 my $sth = $dbh->prepare("SHOW CREATE TABLE $table");
516 my $vsc_structure = $sth->fetchrow;
517 # split on CONSTRAINT keyword
518 my @fks = split /CONSTRAINT /,$vsc_structure;
521 # isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop
522 $_ = /(.*) FOREIGN KEY.*/;
525 # we have found 1 foreign, drop it
526 $dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id");
533 my ($dbh, $table) = @_;
534 $dbh->do("DROP TABLE $table");
537 =head3 create_test_database
539 sets up the test database.
543 sub create_test_database {
545 diag 'creating testing database...';
546 my $installer = C4::Installer->new() or die 'unable to create new installer';
547 # warn Data::Dumper->Dump( [ $installer ], [ 'installer' ] );
548 my $all_languages = getAllLanguages();
549 my $error = $installer->load_db_schema();
550 die "unable to load_db_schema: $error" if ( $error );
551 my $list = $installer->sql_file_list('en', 'marc21', { optional => 1,
553 my ($fwk_language, $installed_list) = $installer->load_sql_in_order($all_languages, @$list);
554 $installer->set_version_syspref();
555 $installer->set_marcflavour_syspref('MARC21');
556 $installer->set_indexing_engine(0);
557 diag 'database created.'
561 =head3 start_zebrasrv
563 This method deletes and reinitializes the zebra database directory,
564 and then spans off a zebra server.
571 diag 'cleaning zebrasrv...';
573 foreach my $zebra_server ( qw( biblioserver authorityserver ) ) {
574 my $zebra_config = C4::Context->zebraconfig($zebra_server)->{'config'};
575 my $zebra_db_dir = C4::Context->zebraconfig($zebra_server)->{'directory'};
576 foreach my $zebra_db_name ( qw( biblios authorities ) ) {
577 my $command = "zebraidx -c $zebra_config -d $zebra_db_name init";
578 my $return = system( $command . ' > /dev/null 2>&1' );
579 if ( $return != 0 ) {
580 diag( "command '$command' died with value: " . $? >> 8 );
583 $command = "zebraidx -c $zebra_config -d $zebra_db_name create $zebra_db_name";
585 $return = system( $command . ' > /dev/null 2>&1' );
586 if ( $return != 0 ) {
587 diag( "command '$command' died with value: " . $? >> 8 );
592 diag 'starting zebrasrv...';
594 my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
595 my $command = sprintf( 'zebrasrv -f %s -D -l %s -p %s',
597 File::Spec->catdir( C4::Context->config("logdir"), 'zebra.log' ),
601 my $output = qx( $command );
605 if ( -e $pidfile, 'pidfile exists' ) {
606 diag 'zebrasrv started.';
608 die 'unable to start zebrasrv';
615 using the PID file for the zebra server, send it a TERM signal with
616 "kill". We can't tell if the process actually dies or not.
622 my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
624 open( my $pidh, '<', $pidfile )
626 if ( defined $pidh ) {
627 my ( $pid ) = <$pidh> or return;
629 my $killed = kill 15, $pid; # 15 is TERM
630 if ( $killed != 1 ) {
631 warn "unable to kill zebrasrv with pid: $pid";
638 =head3 start_zebraqueue_daemon
640 kick off a zebraqueue_daemon.pl process.
644 sub start_zebraqueue_daemon {
646 my $command = q(run/bin/koha-zebraqueue-ctl.sh start);
648 my $started = system( $command );
649 diag "started: $started";
653 =head3 stop_zebraqueue_daemon
658 sub stop_zebraqueue_daemon {
660 my $command = q(run/bin/koha-zebraqueue-ctl.sh stop);
662 my $started = system( $command );
663 diag "started: $started";