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.
13 use C4::Bookseller qw( AddBookseller );
20 use File::Temp qw/ tempdir /;
24 # Since this is an abstract base class, this prevents these tests from
25 # being run directly unless we're testing a subclass. It just makes
27 __PACKAGE__->SKIP_CLASS( 1 );
30 if ($ENV{SINGLE_TEST}) {
31 # if we're running the tests in one
32 # or more test files specified via
34 # make test-single TEST_FILES=lib/KohaTest/Foo.pm
36 # use this INIT trick taken from the POD for
39 Test::Class->runtests;
44 use Attribute::Handlers;
46 =head2 Expensive test method attribute
48 If a test method is decorated with an Expensive
49 attribute, it is skipped unless the RUN_EXPENSIVE_TESTS
50 environment variable is defined.
52 To declare an entire test class and its subclasses expensive,
53 define a SKIP_CLASS with the Expensive attribute:
55 sub SKIP_CLASS : Expensive { }
59 sub Expensive : ATTR(CODE) {
60 my ($package, $symbol, $sub, $attr, $data, $phase) = @_;
61 my $name = *{$symbol}{NAME};
62 if ($name eq 'SKIP_CLASS') {
63 if ($ENV{'RUN_EXPENSIVE_TESTS'}) {
64 *{$symbol} = sub { 0; }
66 *{$symbol} = sub { "Skipping expensive test classes $package (and subclasses)"; }
69 unless ($ENV{'RUN_EXPENSIVE_TESTS'}) {
70 # a test method that runs no tests and just returns a scalar is viewed by Test::Class as a skip
71 *{$symbol} = sub { "Skipping expensive test $package\:\:$name"; }
76 =head2 startup methods
78 these are run once, at the beginning of the whole test suite
82 sub startup_15_truncate_tables : Test( startup => 1 ) {
85 # my @truncate_tables = qw( accountlines
96 # auth_subfield_structure
122 # import_record_matches
132 # language_descriptions
133 # language_rfc4646_to_iso639
134 # language_script_bidi
135 # language_script_mapping
136 # language_subtag_registry
139 # marc_subfield_structure
142 # matcher_matchpoints
143 # matchpoint_component_norms
144 # matchpoint_components
156 # repeatable_holidays
172 # subscriptionhistory
173 # subscriptionroutinglist
178 # virtualshelfcontents
184 my @truncate_tables = qw( accountlines
228 subscriptionroutinglist
234 my $failed_to_truncate = 0;
235 foreach my $table ( @truncate_tables ) {
236 my $dbh = C4::Context->dbh();
237 $dbh->do( "truncate $table" )
238 or $failed_to_truncate = 1;
240 is( $failed_to_truncate, 0, 'truncated tables' );
243 =head2 startup_20_add_bookseller
245 we need a bookseller for many of the tests, so let's insert one. Feel
246 free to use this one, or insert your own.
250 sub startup_20_add_bookseller : Test(startup => 1) {
253 my $booksellerinfo = { name => 'bookseller ' . $self->random_string(),
256 my $id = AddBookseller( $booksellerinfo );
257 ok( $id, "created bookseller: $id" );
258 $self->{'booksellerid'} = $id;
263 =head2 startup_22_add_bookfund
265 we need a bookfund for many of the tests. This currently uses one that
266 is in the skeleton database. free to use this one, or insert your
269 sub startup_22_add_bookfund : Test(startup => 2) {
272 my $bookfundid = 'GEN';
273 my $bookfund = GetBookFund( $bookfundid, undef );
274 # diag( Data::Dumper->Dump( [ $bookfund ], qw( bookfund ) ) );
275 is( $bookfund->{'bookfundid'}, $bookfundid, "found bookfund: '$bookfundid'" );
276 is( $bookfund->{'bookfundname'}, 'General Stacks', "found bookfund: '$bookfundid'" );
278 $self->{'bookfundid'} = $bookfundid;
284 =head2 startup_24_add_branch
288 sub startup_24_add_branch : Test(startup => 1) {
293 branchcode => $self->random_string(3),
294 branchname => $self->random_string(),
295 branchaddress1 => $self->random_string(),
296 branchaddress2 => $self->random_string(),
297 branchaddress3 => $self->random_string(),
298 branchphone => $self->random_phone(),
299 branchfax => $self->random_phone(),
300 brancemail => $self->random_email(),
301 branchip => $self->random_ip(),
302 branchprinter => $self->random_string(),
304 C4::Branch::ModBranch($branch_info);
305 $self->{'branchcode'} = $branch_info->{'branchcode'};
306 ok( $self->{'branchcode'}, "created branch: $self->{'branchcode'}" );
310 =head2 startup_24_add_member
312 Add a patron/member for the tests to use
316 sub startup_24_add_member : Test(startup => 1) {
319 my $memberinfo = { surname => 'surname ' . $self->random_string(),
320 firstname => 'firstname' . $self->random_string(),
321 address => 'address' . $self->random_string(),
322 city => 'city' . $self->random_string(),
323 cardnumber => 'card' . $self->random_string(),
324 branchcode => 'CPL', # CPL => Centerville
325 categorycode => 'PT', # PT => PaTron
326 dateexpiry => '2010-01-01',
327 password => 'testpassword',
328 dateofbirth => $self->random_date(),
331 my $borrowernumber = AddMember( %$memberinfo );
332 ok( $borrowernumber, "created member: $borrowernumber" );
333 $self->{'memberid'} = $borrowernumber;
338 =head2 startup_30_login
342 sub startup_30_login : Test( startup => 2 ) {
345 $self->{'sessionid'} = '12345678'; # does this value matter?
346 my $borrower_details = C4::Members::GetMemberDetails( $self->{'memberid'} );
347 ok( $borrower_details->{'cardnumber'}, 'cardnumber' );
349 # make a cookie and force it into $cgi.
350 # This would be a lot easier with Test::MockObject::Extends.
351 my $cgi = CGI->new( { userid => $borrower_details->{'cardnumber'},
352 password => 'testpassword' } );
353 my $setcookie = $cgi->cookie( -name => 'CGISESSID',
354 -value => $self->{'sessionid'} );
355 $cgi->{'.cookies'} = { CGISESSID => $setcookie };
356 is( $cgi->cookie('CGISESSID'), $self->{'sessionid'}, 'the CGISESSID cookie is set' );
357 # diag( Data::Dumper->Dump( [ $cgi->cookie('CGISESSID') ], [ qw( cookie ) ] ) );
359 # C4::Auth::checkauth sometimes emits a warning about unable to append to sessionlog. That's OK.
360 my ( $userid, $cookie, $sessionID ) = C4::Auth::checkauth( $cgi, 'noauth', {}, 'intranet' );
361 # diag( Data::Dumper->Dump( [ $userid, $cookie, $sessionID ], [ qw( userid cookie sessionID ) ] ) );
363 # my $session = C4::Auth::get_session( $sessionID );
364 # diag( Data::Dumper->Dump( [ $session ], [ qw( session ) ] ) );
371 setup methods are run before every test method
375 =head2 teardown methods
377 teardown methods are many time, once at the end of each test method.
381 =head2 shutdown methods
383 shutdown methods are run once, at the end of the test suite
387 =head2 utility methods
389 These are not test methods, but they're handy
395 Nice for generating names and such. It's not actually random, more
403 my $wordsize = shift || 6; # how many letters in your string?
405 # leave out these characters: "oOlL10". They're too confusing.
406 my @alphabet = ( 'a'..'k','m','n','p'..'z', 'A'..'K','M','N','P'..'Z', 2..9 );
409 foreach ( 0..$wordsize ) {
410 $randomstring .= $alphabet[ rand( scalar( @alphabet ) ) ];
412 return $randomstring;
418 generates a random phone number. Currently, it's not actually random. It's an unusable US phone number
425 return '212-555-5555';
431 generates a random email address. They're all in the unusable
432 'example.com' domain that is designed for this purpose.
439 return $self->random_string() . '@example.com';
445 returns an IP address suitable for testing purposes.
458 returns a somewhat random date in the iso (yyyy-mm-dd) format.
465 my $year = 1800 + int( rand(300) ); # 1800 - 2199
466 my $month = 1 + int( rand(12) ); # 1 - 12
467 my $day = 1 + int( rand(28) ); # 1 - 28
468 # stop at the 28th to keep us from generating February 31st and such.
470 return sprintf( '%04d-%02d-%02d', $year, $month, $day );
476 returns tomorrow's date as YYYY-MM-DD.
483 return $self->days_from_now( 1 );
489 returns yesterday's date as YYYY-MM-DD.
496 return $self->days_from_now( -1 );
502 returns an arbitrary date based on today in YYYY-MM-DD format.
508 my $days = shift or return;
510 my $seconds = time + $days * 60*60*24;
511 my $yyyymmdd = sprintf( '%04d-%02d-%02d',
512 localtime( $seconds )->year() + 1900,
513 localtime( $seconds )->mon() + 1,
514 localtime( $seconds )->mday() );
520 $self->add_biblios( count => 10,
524 count: number of biblios to add
525 add_items: should you add items for each one?
531 adds the biblionumbers to the $self->{'biblios'} listref
534 Should I allow you to pass in biblio information, like title?
535 Since this method is in the KohaTest class, all tests in it will be ignored, unless you call this from your own namespace.
536 This runs 10 tests, plus 4 for each "count", plus 3 more for each item added.
544 $param{'count'} = 1 unless defined( $param{'count'} );
545 $param{'add_items'} = 0 unless defined( $param{'add_items'} );
547 foreach my $counter ( 1..$param{'count'} ) {
548 my $marcrecord = MARC::Record->new();
549 isa_ok( $marcrecord, 'MARC::Record' );
550 my @marc_fields = ( MARC::Field->new( '100', '1', '0',
553 MARC::Field->new( '245', '1', '4',
554 a => sprintf( 'The Adventures of Huckleberry Finn Test %s', $counter ),
555 c => "Mark Twain ; illustrated by E.W. Kemble." ),
556 MARC::Field->new( '952', '0', '0',
557 p => '12345678' . $self->random_string() ), # barcode
558 MARC::Field->new( '952', '0', '0',
559 o => $self->random_string() ), # callnumber
560 MARC::Field->new( '952', '0', '0',
565 my $appendedfieldscount = $marcrecord->append_fields( @marc_fields );
567 diag $MARC::Record::ERROR if ( $MARC::Record::ERROR );
568 is( $appendedfieldscount, scalar @marc_fields, 'added correct number of MARC fields' );
570 my $frameworkcode = ''; # XXX I'd like to put something reasonable here.
571 my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $marcrecord, $frameworkcode );
572 ok( $biblionumber, "the biblionumber is $biblionumber" );
573 ok( $biblioitemnumber, "the biblioitemnumber is $biblioitemnumber" );
574 if ( $param{'add_items'} ) {
575 # my @iteminfo = AddItem( {}, $biblionumber );
576 my @iteminfo = AddItemFromMarc( $marcrecord, $biblionumber );
577 is( $iteminfo[0], $biblionumber, "biblionumber is $biblionumber" );
578 is( $iteminfo[1], $biblioitemnumber, "biblioitemnumber is $biblioitemnumber" );
579 ok( $iteminfo[2], "itemnumber is $iteminfo[2]" );
580 push @{ $self->{'items'} },
581 { biblionumber => $iteminfo[0],
582 biblioitemnumber => $iteminfo[1],
583 itemnumber => $iteminfo[2],
586 push @{$self->{'biblios'}}, $biblionumber;
589 $self->reindex_marc();
590 my $query = 'Finn Test';
591 my ( $error, $results, undef ) = SimpleSearch( $query );
592 if ( !defined $error && $param{'count'} <= @{$results} ) {
593 pass( "found all $param{'count'} titles" );
595 fail( "we never found all $param{'count'} titles" );
602 Do a fast reindexing of all of the bib and authority
603 records and mark all zebraqueue entries done.
605 Useful for test routines that need to do a
606 lot of indexing without having to wait for
609 In NoZebra model, this only marks zebraqueue
610 done - the records should already be indexed.
617 # mark zebraqueue done regardless of the indexing mode
618 my $dbh = C4::Context->dbh();
619 $dbh->do("UPDATE zebraqueue SET done = 1 WHERE done = 0");
621 return if C4::Context->preference('NoZebra');
623 my $directory = tempdir(CLEANUP => 1);
624 foreach my $record_type qw(biblio authority) {
625 mkdir "$directory/$record_type";
626 my $sth = $dbh->prepare($record_type eq "biblio" ? "SELECT marc FROM biblioitems" : "SELECT marc FROM auth_header");
628 open my $out, '>:encoding(UTF-8)', "$directory/$record_type/records";
629 while (my ($blob) = $sth->fetchrow_array) {
633 my $zebra_server = "${record_type}server";
634 my $zebra_config = C4::Context->zebraconfig($zebra_server)->{'config'};
635 my $zebra_db_dir = C4::Context->zebraconfig($zebra_server)->{'directory'};
636 my $zebra_db = $record_type eq 'biblio' ? 'biblios' : 'authorities';
637 system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 init > /dev/null 2>\&1";
638 system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 update $directory/${record_type} > /dev/null 2>\&1";
639 system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 commit > /dev/null 2>\&1";
645 =head3 clear_test_database
647 removes all tables from test database so that install starts with a clean slate
651 sub clear_test_database {
653 diag "removing tables from test database";
655 my $dbh = C4::Context->dbh;
656 my $schema = C4::Context->config("database");
658 my @tables = get_all_tables($dbh, $schema);
659 foreach my $table (@tables) {
660 drop_all_foreign_keys($dbh, $table);
663 foreach my $table (@tables) {
664 drop_table($dbh, $table);
669 my ($dbh, $schema) = @_;
670 my $sth = $dbh->prepare("SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ?");
672 $sth->execute($schema);
673 while (my ($table) = $sth->fetchrow_array) {
674 push @tables, $table;
680 sub drop_all_foreign_keys {
681 my ($dbh, $table) = @_;
682 # get the table description
683 my $sth = $dbh->prepare("SHOW CREATE TABLE $table");
685 my $vsc_structure = $sth->fetchrow;
686 # split on CONSTRAINT keyword
687 my @fks = split /CONSTRAINT /,$vsc_structure;
690 # isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop
691 $_ = /(.*) FOREIGN KEY.*/;
694 # we have found 1 foreign, drop it
695 $dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id");
697 diag "unable to DROP FOREIGN KEY '$id' on TABLE '$table' due to: " . $dbh->errstr();
705 my ($dbh, $table) = @_;
706 $dbh->do("DROP TABLE $table");
708 diag "unable to drop table: '$table' due to: " . $dbh->errstr();
712 =head3 create_test_database
714 sets up the test database.
718 sub create_test_database {
720 diag 'creating testing database...';
721 my $installer = C4::Installer->new() or die 'unable to create new installer';
722 # warn Data::Dumper->Dump( [ $installer ], [ 'installer' ] );
723 my $all_languages = getAllLanguages();
724 my $error = $installer->load_db_schema();
725 die "unable to load_db_schema: $error" if ( $error );
726 my $list = $installer->sql_file_list('en', 'marc21', { optional => 1,
728 my ($fwk_language, $installed_list) = $installer->load_sql_in_order($all_languages, @$list);
729 $installer->set_version_syspref();
730 $installer->set_marcflavour_syspref('MARC21');
731 $installer->set_indexing_engine(0);
732 diag 'database created.'
736 =head3 start_zebrasrv
738 This method deletes and reinitializes the zebra database directory,
739 and then spans off a zebra server.
746 diag 'cleaning zebrasrv...';
748 foreach my $zebra_server ( qw( biblioserver authorityserver ) ) {
749 my $zebra_config = C4::Context->zebraconfig($zebra_server)->{'config'};
750 my $zebra_db_dir = C4::Context->zebraconfig($zebra_server)->{'directory'};
751 foreach my $zebra_db_name ( qw( biblios authorities ) ) {
752 my $command = "zebraidx -c $zebra_config -d $zebra_db_name init";
753 my $return = system( $command . ' > /dev/null 2>&1' );
754 if ( $return != 0 ) {
755 diag( "command '$command' died with value: " . $? >> 8 );
758 $command = "zebraidx -c $zebra_config -d $zebra_db_name create $zebra_db_name";
760 $return = system( $command . ' > /dev/null 2>&1' );
761 if ( $return != 0 ) {
762 diag( "command '$command' died with value: " . $? >> 8 );
767 diag 'starting zebrasrv...';
769 my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
770 my $command = sprintf( 'zebrasrv -f %s -D -l %s -p %s',
772 File::Spec->catdir( C4::Context->config("logdir"), 'zebra.log' ),
776 my $output = qx( $command );
780 if ( -e $pidfile, 'pidfile exists' ) {
781 diag 'zebrasrv started.';
783 die 'unable to start zebrasrv';
790 using the PID file for the zebra server, send it a TERM signal with
791 "kill". We can't tell if the process actually dies or not.
797 my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
799 open( my $pidh, '<', $pidfile )
801 if ( defined $pidh ) {
802 my ( $pid ) = <$pidh> or return;
804 my $killed = kill 15, $pid; # 15 is TERM
805 if ( $killed != 1 ) {
806 warn "unable to kill zebrasrv with pid: $pid";
813 =head3 start_zebraqueue_daemon
815 kick off a zebraqueue_daemon.pl process.
819 sub start_zebraqueue_daemon {
821 my $command = q(run/bin/koha-index-daemon-ctl.sh start);
823 my $started = system( $command );
824 diag "started: $started";
828 =head3 stop_zebraqueue_daemon
833 sub stop_zebraqueue_daemon {
835 my $command = q(run/bin/koha-index-daemon-ctl.sh stop);
837 my $started = system( $command );
838 diag "started: $started";