t/lib/KohaTest.pm

   1 package KohaTest;
   2 use base qw(Test::Class);
   3
   4 use Test::More;
   5 use Data::Dumper;
   6
   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.
  10
  11 use C4::Auth;
  12 use C4::Biblio;
  13 use C4::Bookfund;
  14 use C4::Bookseller;
  15 use C4::Context;
  16 use C4::Items;
  17 use C4::Members;
  18 use C4::Search;
  19 use C4::Installer;
  20 use C4::Languages;
  21 use File::Temp qw/ tempdir /;
  22
  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
  25 # things faster.
  26 __PACKAGE__->SKIP_CLASS( 1 );
  27
  28
  29 =head2 startup methods
  30
  31 these are run once, at the beginning of the whole test suite
  32
  33 =cut
  34
  35 sub startup_15_truncate_tables : Test( startup => 1 ) {
  36     my $self = shift;
  37
  38 #     my @truncate_tables = qw( accountlines
  39 #                               accountoffsets
  40 #                               action_logs
  41 #                               alert
  42 #                               aqbasket
  43 #                               aqbookfund
  44 #                               aqbooksellers
  45 #                               aqbudget
  46 #                               aqorderbreakdown
  47 #                               aqorderdelivery
  48 #                               aqorders
  49 #                               auth_header
  50 #                               auth_subfield_structure
  51 #                               auth_tag_structure
  52 #                               auth_types
  53 #                               authorised_values
  54 #                               biblio
  55 #                               biblio_framework
  56 #                               biblioitems
  57 #                               borrowers
  58 #                               branchcategories
  59 #                               branches
  60 #                               branchrelations
  61 #                               branchtransfers
  62 #                               browser
  63 #                               categories
  64 #                               cities
  65 #                               class_sort_rules
  66 #                               class_sources
  67 #                               currency
  68 #                               deletedbiblio
  69 #                               deletedbiblioitems
  70 #                               deletedborrowers
  71 #                               deleteditems
  72 #                               ethnicity
  73 #                               import_batches
  74 #                               import_biblios
  75 #                               import_items
  76 #                               import_record_matches
  77 #                               import_records
  78 #                               issues
  79 #                               issuingrules
  80 #                               items
  81 #                               itemtypes
  82 #                               labels
  83 #                               labels_conf
  84 #                               labels_profile
  85 #                               labels_templates
  86 #                               language_descriptions
  87 #                               language_rfc4646_to_iso639
  88 #                               language_script_bidi
  89 #                               language_script_mapping
  90 #                               language_subtag_registry
  91 #                               letter
  92 #                               marc_matchers
  93 #                               marc_subfield_structure
  94 #                               marc_tag_structure
  95 #                               matchchecks
  96 #                               matcher_matchpoints
  97 #                               matchpoint_component_norms
  98 #                               matchpoint_components
  99 #                               matchpoints
 100 #                               notifys
 101 #                               nozebra
 102 #                               old_issues
 103 #                               old_reserves
 104 #                               opac_news
 105 #                               overduerules
 106 #                               patroncards
 107 #                               patronimage
 108 #                               printers
 109 #                               printers_profile
 110 #                               repeatable_holidays
 111 #                               reports_dictionary
 112 #                               reserveconstraints
 113 #                               reserves
 114 #                               reviews
 115 #                               roadtype
 116 #                               saved_reports
 117 #                               saved_sql
 118 #                               serial
 119 #                               serialitems
 120 #                               services_throttle
 121 #                               sessions
 122 #                               special_holidays
 123 #                               statistics
 124 #                               stopwords
 125 #                               subscription
 126 #                               subscriptionhistory
 127 #                               subscriptionroutinglist
 128 #                               suggestions
 129 #                               systempreferences
 130 #                               tags
 131 #                               userflags
 132 #                               virtualshelfcontents
 133 #                               virtualshelves
 134 #                               z3950servers
 135 #                               zebraqueue
 136 #                         );
 137
 138     my @truncate_tables = qw( accountlines
 139                               accountoffsets
 140                               alert
 141                               aqbasket
 142                               aqbooksellers
 143                               aqorderbreakdown
 144                               aqorderdelivery
 145                               aqorders
 146                               auth_header
 147                               branchcategories
 148                               branchrelations
 149                               branchtransfers
 150                               browser
 151                               cities
 152                               deletedbiblio
 153                               deletedbiblioitems
 154                               deletedborrowers
 155                               deleteditems
 156                               ethnicity
 157                               issues
 158                               issuingrules
 159                               labels
 160                               labels_profile
 161                               matchchecks
 162                               notifys
 163                               nozebra
 164                               old_issues
 165                               old_reserves
 166                               overduerules
 167                               patroncards
 168                               patronimage
 169                               printers
 170                               printers_profile
 171                               reports_dictionary
 172                               reserveconstraints
 173                               reserves
 174                               reviews
 175                               roadtype
 176                               saved_reports
 177                               saved_sql
 178                               serial
 179                               serialitems
 180                               services_throttle
 181                               special_holidays
 182                               statistics
 183                               subscription
 184                               subscriptionhistory
 185                               subscriptionroutinglist
 186                               suggestions
 187                               tags
 188                               virtualshelfcontents
 189                         );
 190
 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;
 196     }
 197     is( $failed_to_truncate, 0, 'truncated tables' );
 198 }
 199
 200 =head2 startup_20_add_bookseller
 201
 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.
 204
 205 =cut
 206
 207 sub startup_20_add_bookseller : Test(startup => 1) {
 208     my $self = shift;
 209
 210     my $booksellerinfo = { name => 'bookseller ' . $self->random_string(),
 211                       };
 212
 213     my $id = AddBookseller( $booksellerinfo );
 214     ok( $id, "created bookseller: $id" );
 215     $self->{'booksellerid'} = $id;
 216
 217     return;
 218 }
 219
 220 =head2 startup_22_add_bookfund
 221
 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
 224 own.
 225
 226 =cut
 227
 228 sub startup_22_add_bookfund : Test(startup => 2) {
 229     my $self = shift;
 230
 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'" );
 236
 237     $self->{'bookfundid'} = $bookfundid;
 238     return;
 239 }
 240
 241 =head2 startup_24_add_member
 242
 243 Add a patron/member for the tests to use
 244
 245 =cut
 246
 247 sub startup_24_add_member : Test(startup => 1) {
 248     my $self = shift;
 249
 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',
 259                   };
 260
 261     my $borrowernumber = AddMember( %$memberinfo );
 262     ok( $borrowernumber, "created member: $borrowernumber" );
 263     $self->{'memberid'} = $borrowernumber;
 264
 265     return;
 266 }
 267
 268 =head2 startup_30_login
 269
 270 =cut
 271
 272 sub startup_30_login : Test( startup => 2 ) {
 273     my $self = shift;
 274
 275     $self->{'sessionid'} = '12345678'; # does this value matter?
 276     my $borrower_details = C4::Members::GetMemberDetails( $self->{'memberid'} );
 277     ok( $borrower_details->{'cardnumber'}, 'cardnumber' );
 278
 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 ) ] ) );
 288
 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 ) ] ) );
 292
 293     # my $session = C4::Auth::get_session( $sessionID );
 294     # diag( Data::Dumper->Dump( [ $session ], [ qw( session ) ] ) );
 295
 296
 297 }
 298
 299 =head2 setup methods
 300
 301 setup methods are run before every test method
 302
 303 =cut
 304
 305 =head2 teardown methods
 306
 307 teardown methods are many time, once at the end of each test method.
 308
 309 =cut
 310
 311 =head2 shutdown methods
 312
 313 shutdown methods are run once, at the end of the test suite
 314
 315 =cut
 316
 317 =head2 utility methods
 318
 319 These are not test methods, but they're handy
 320
 321 =cut
 322
 323 =head3 random_string
 324
 325 Nice for generating names and such. It's not actually random, more
 326 like arbitrary.
 327
 328 =cut
 329
 330 sub random_string {
 331     my $self = shift;
 332
 333     my $wordsize = 6;  # how many letters in your string?
 334
 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 );
 337
 338     my $randomstring;
 339     foreach ( 0..$wordsize ) {
 340         $randomstring .= $alphabet[ rand( scalar( @alphabet ) ) ];
 341     }
 342     return $randomstring;
 343
 344 }
 345
 346 =head3 add_biblios
 347
 348   $self->add_biblios( count     => 10,
 349                       add_items => 1, );
 350
 351   named parameters:
 352      count: number of biblios to add
 353      add_items: should you add items for each one?
 354
 355   returns:
 356     I don't know yet.
 357
 358   side effects:
 359     adds the biblionumbers to the $self->{'biblios'} listref
 360
 361   Notes:
 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.
 365
 366 =cut
 367
 368 sub add_biblios {
 369     my $self = shift;
 370     my %param = @_;
 371
 372     $param{'count'}     = 1 unless defined( $param{'count'} );
 373     $param{'add_items'} = 0 unless defined( $param{'add_items'} );
 374
 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',
 379                                                                                 a => 'Twain, Mark',
 380                                                                                 d => "1835-1910." ),
 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',
 387                                                                                 a => 'CPL',
 388                                                                                 b => 'CPL' ),
 389                                                          );
 390
 391         diag $MARC::Record::ERROR if ( $MARC::Record::ERROR );
 392         is( $appendedfieldscount, 4, 'added 4 fields' );
 393
 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]" );
 404         }
 405         push @{$self->{'biblios'}}, $biblionumber;
 406     }
 407
 408     my $query = 'Finn Test';
 409
 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
 412     # up. why?
 413     my $tries = 30;
 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" );
 419             last DELAY;
 420         }
 421         sleep( 3 );
 422     } continue {
 423         if ( $trial == $tries ) {
 424             fail( "we never found all $param{'count'} titles even after $tries tries." );
 425         }
 426     }
 427
 428
 429 }
 430
 431 =head3 reindex_marc
 432
 433 Do a fast reindexing of all of the bib and authority
 434 records and mark all zebraqueue entries done.
 435
 436 Useful for test routines that need to do a
 437 lot of indexing without having to wait for
 438 zebraqueue.
 439
 440 In NoZebra model, this only marks zebraqueue
 441 done - the records should already be indexed.
 442
 443 =cut
 444
 445 sub reindex_marc {
 446     my $self = shift;
 447
 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");
 451
 452     return if C4::Context->preference('NoZebra');
 453
 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");
 458         $sth->execute();
 459         open OUT, ">:utf8", "$directory/$record_type/records";
 460         while (my ($blob) = $sth->fetchrow_array) {
 461             print OUT $blob;
 462         }
 463         close OUT;
 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";
 471     }
 472
 473 }
 474
 475
 476 =head3 clear_test_database
 477
 478   removes all tables from test database so that install starts with a clean slate
 479
 480 =cut
 481
 482 sub clear_test_database {
 483
 484     diag "removing tables from test database";
 485
 486     my $dbh = C4::Context->dbh;
 487     my $schema = C4::Context->config("database");
 488
 489     my @tables = get_all_tables($dbh, $schema);
 490     foreach my $table (@tables) {
 491         drop_all_foreign_keys($dbh, $table);
 492     }
 493
 494     foreach my $table (@tables) {
 495         drop_table($dbh, $table);
 496     }
 497 }
 498
 499 sub get_all_tables {
 500   my ($dbh, $schema) = @_;
 501   my $sth = $dbh->prepare("SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ?");
 502   my @tables = ();
 503   $sth->execute($schema);
 504   while (my ($table) = $sth->fetchrow_array) {
 505     push @tables, $table;
 506   }
 507   $sth->finish;
 508   return @tables;
 509 }
 510
 511 sub drop_all_foreign_keys {
 512     my ($dbh, $table) = @_;
 513     # get the table description
 514     my $sth = $dbh->prepare("SHOW CREATE TABLE $table");
 515     $sth->execute;
 516     my $vsc_structure = $sth->fetchrow;
 517     # split on CONSTRAINT keyword
 518     my @fks = split /CONSTRAINT /,$vsc_structure;
 519     # parse each entry
 520     foreach (@fks) {
 521         # isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop
 522         $_ = /(.*) FOREIGN KEY.*/;
 523         my $id = $1;
 524         if ($id) {
 525             # we have found 1 foreign, drop it
 526             $dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id");
 527             $id="";
 528         }
 529     }
 530 }
 531
 532 sub drop_table {
 533     my ($dbh, $table) = @_;
 534     $dbh->do("DROP TABLE $table");
 535 }
 536
 537 =head3 create_test_database
 538
 539   sets up the test database.
 540
 541 =cut
 542
 543 sub create_test_database {
 544
 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,
 552                                                            mandatory => 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.'
 558 }
 559
 560
 561 =head3 start_zebrasrv
 562
 563   This method deletes and reinitializes the zebra database directory,
 564   and then spans off a zebra server.
 565
 566 =cut
 567
 568 sub start_zebrasrv {
 569
 570     stop_zebrasrv();
 571     diag 'cleaning zebrasrv...';
 572
 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 );
 581             }
 582
 583             $command = "zebraidx -c $zebra_config -d $zebra_db_name create $zebra_db_name";
 584             diag $command;
 585             $return = system( $command . ' > /dev/null 2>&1' );
 586             if ( $return != 0 ) {
 587                 diag( "command '$command' died with value: " . $? >> 8 );
 588             }
 589         }
 590     }
 591
 592     diag 'starting zebrasrv...';
 593
 594     my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
 595     my $command = sprintf( 'zebrasrv -f %s -D -l %s -p %s',
 596                            $ENV{'KOHA_CONF'},
 597                            File::Spec->catdir( C4::Context->config("logdir"), 'zebra.log' ),
 598                            $pidfile,
 599                       );
 600     diag $command;
 601     my $output = qx( $command );
 602     if ( $output ) {
 603         diag $output;
 604     }
 605     if ( -e $pidfile, 'pidfile exists' ) {
 606         diag 'zebrasrv started.';
 607     } else {
 608         die 'unable to start zebrasrv';
 609     }
 610     return $output;
 611 }
 612
 613 =head3 stop_zebrasrv
 614
 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.
 617
 618 =cut
 619
 620 sub stop_zebrasrv {
 621
 622     my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
 623     if ( -e $pidfile ) {
 624         open( my $pidh, '<', $pidfile )
 625           or return;
 626         if ( defined $pidh ) {
 627             my ( $pid ) = <$pidh> or return;
 628             close $pidh;
 629             my $killed = kill 15, $pid; # 15 is TERM
 630             if ( $killed != 1 ) {
 631                 warn "unable to kill zebrasrv with pid: $pid";
 632             }
 633         }
 634     }
 635 }
 636
 637
 638 =head3 start_zebraqueue_daemon
 639
 640   kick off a zebraqueue_daemon.pl process.
 641
 642 =cut
 643
 644 sub start_zebraqueue_daemon {
 645
 646     my $command = q(run/bin/koha-zebraqueue-ctl.sh start);
 647     diag $command;
 648     my $started = system( $command );
 649     diag "started: $started";
 650
 651 }
 652
 653 =head3 stop_zebraqueue_daemon
 654
 655
 656 =cut
 657
 658 sub stop_zebraqueue_daemon {
 659
 660     my $command = q(run/bin/koha-zebraqueue-ctl.sh stop);
 661     diag $command;
 662     my $started = system( $command );
 663     diag "started: $started";
 664
 665 }
 666
 667 1;