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 use Attribute::Handlers;
  29
  30 =head2 Expensive test method attribute
  31
  32 If a test method is decorated with an Expensive
  33 attribute, it is skipped unless the RUN_EXPENSIVE_TESTS
  34 environment variable is defined.
  35
  36 To declare an entire test class and its subclasses expensive,
  37 define a SKIP_CLASS with the Expensive attribute:
  38
  39     sub SKIP_CLASS : Expensive { }
  40
  41 =cut
  42
  43 sub Expensive : ATTR(CODE) {
  44     my ($package, $symbol, $sub, $attr, $data, $phase) = @_;
  45     my $name = *{$symbol}{NAME};
  46     if ($name eq 'SKIP_CLASS') {
  47         if ($ENV{'RUN_EXPENSIVE_TESTS'}) {
  48             *{$symbol} = sub { 0; }
  49         } else {
  50             *{$symbol} = sub { "Skipping expensive test classes $package (and subclasses)"; }
  51         }
  52     } else {
  53         unless ($ENV{'RUN_EXPENSIVE_TESTS'}) {
  54             # a test method that runs no tests and just returns a scalar is viewed by Test::Class as a skip
  55             *{$symbol} = sub { "Skipping expensive test $package\:\:$name"; }
  56         }
  57     }
  58 }
  59
  60 =head2 startup methods
  61
  62 these are run once, at the beginning of the whole test suite
  63
  64 =cut
  65
  66 sub startup_15_truncate_tables : Test( startup => 1 ) {
  67     my $self = shift;
  68
  69 #     my @truncate_tables = qw( accountlines
  70 #                               accountoffsets
  71 #                               action_logs
  72 #                               alert
  73 #                               aqbasket
  74 #                               aqbookfund
  75 #                               aqbooksellers
  76 #                               aqbudget
  77 #                               aqorderbreakdown
  78 #                               aqorderdelivery
  79 #                               aqorders
  80 #                               auth_header
  81 #                               auth_subfield_structure
  82 #                               auth_tag_structure
  83 #                               auth_types
  84 #                               authorised_values
  85 #                               biblio
  86 #                               biblio_framework
  87 #                               biblioitems
  88 #                               borrowers
  89 #                               branchcategories
  90 #                               branches
  91 #                               branchrelations
  92 #                               branchtransfers
  93 #                               browser
  94 #                               categories
  95 #                               cities
  96 #                               class_sort_rules
  97 #                               class_sources
  98 #                               currency
  99 #                               deletedbiblio
 100 #                               deletedbiblioitems
 101 #                               deletedborrowers
 102 #                               deleteditems
 103 #                               ethnicity
 104 #                               import_batches
 105 #                               import_biblios
 106 #                               import_items
 107 #                               import_record_matches
 108 #                               import_records
 109 #                               issues
 110 #                               issuingrules
 111 #                               items
 112 #                               itemtypes
 113 #                               labels
 114 #                               labels_conf
 115 #                               labels_profile
 116 #                               labels_templates
 117 #                               language_descriptions
 118 #                               language_rfc4646_to_iso639
 119 #                               language_script_bidi
 120 #                               language_script_mapping
 121 #                               language_subtag_registry
 122 #                               letter
 123 #                               marc_matchers
 124 #                               marc_subfield_structure
 125 #                               marc_tag_structure
 126 #                               matchchecks
 127 #                               matcher_matchpoints
 128 #                               matchpoint_component_norms
 129 #                               matchpoint_components
 130 #                               matchpoints
 131 #                               notifys
 132 #                               nozebra
 133 #                               old_issues
 134 #                               old_reserves
 135 #                               opac_news
 136 #                               overduerules
 137 #                               patroncards
 138 #                               patronimage
 139 #                               printers
 140 #                               printers_profile
 141 #                               repeatable_holidays
 142 #                               reports_dictionary
 143 #                               reserveconstraints
 144 #                               reserves
 145 #                               reviews
 146 #                               roadtype
 147 #                               saved_reports
 148 #                               saved_sql
 149 #                               serial
 150 #                               serialitems
 151 #                               services_throttle
 152 #                               sessions
 153 #                               special_holidays
 154 #                               statistics
 155 #                               stopwords
 156 #                               subscription
 157 #                               subscriptionhistory
 158 #                               subscriptionroutinglist
 159 #                               suggestions
 160 #                               systempreferences
 161 #                               tags
 162 #                               userflags
 163 #                               virtualshelfcontents
 164 #                               virtualshelves
 165 #                               z3950servers
 166 #                               zebraqueue
 167 #                         );
 168
 169     my @truncate_tables = qw( accountlines
 170                               accountoffsets
 171                               alert
 172                               aqbasket
 173                               aqbooksellers
 174                               aqorderbreakdown
 175                               aqorderdelivery
 176                               aqorders
 177                               auth_header
 178                               branchcategories
 179                               branchrelations
 180                               branchtransfers
 181                               browser
 182                               cities
 183                               deletedbiblio
 184                               deletedbiblioitems
 185                               deletedborrowers
 186                               deleteditems
 187                               ethnicity
 188                               issues
 189                               issuingrules
 190                               labels
 191                               labels_profile
 192                               matchchecks
 193                               notifys
 194                               nozebra
 195                               old_issues
 196                               old_reserves
 197                               overduerules
 198                               patroncards
 199                               patronimage
 200                               printers
 201                               printers_profile
 202                               reports_dictionary
 203                               reserveconstraints
 204                               reserves
 205                               reviews
 206                               roadtype
 207                               saved_reports
 208                               saved_sql
 209                               serial
 210                               serialitems
 211                               services_throttle
 212                               special_holidays
 213                               statistics
 214                               subscription
 215                               subscriptionhistory
 216                               subscriptionroutinglist
 217                               suggestions
 218                               tags
 219                               virtualshelfcontents
 220                         );
 221
 222     my $failed_to_truncate = 0;
 223     foreach my $table ( @truncate_tables ) {
 224         my $dbh = C4::Context->dbh();
 225         $dbh->do( "truncate $table" )
 226           or $failed_to_truncate = 1;
 227     }
 228     is( $failed_to_truncate, 0, 'truncated tables' );
 229 }
 230
 231 =head2 startup_20_add_bookseller
 232
 233 we need a bookseller for many of the tests, so let's insert one. Feel
 234 free to use this one, or insert your own.
 235
 236 =cut
 237
 238 sub startup_20_add_bookseller : Test(startup => 1) {
 239     my $self = shift;
 240
 241     my $booksellerinfo = { name => 'bookseller ' . $self->random_string(),
 242                       };
 243
 244     my $id = AddBookseller( $booksellerinfo );
 245     ok( $id, "created bookseller: $id" );
 246     $self->{'booksellerid'} = $id;
 247
 248     return;
 249 }
 250
 251 =head2 startup_22_add_bookfund
 252
 253 we need a bookfund for many of the tests. This currently uses one that
 254 is in the skeleton database.  free to use this one, or insert your
 255 own.
 256
 257 =cut
 258
 259 sub startup_22_add_bookfund : Test(startup => 2) {
 260     my $self = shift;
 261
 262     my $bookfundid = 'GEN';
 263     my $bookfund = GetBookFund( $bookfundid, undef );
 264     # diag( Data::Dumper->Dump( [ $bookfund ], qw( bookfund  ) ) );
 265     is( $bookfund->{'bookfundid'},   $bookfundid,      "found bookfund: '$bookfundid'" );
 266     is( $bookfund->{'bookfundname'}, 'General Stacks', "found bookfund: '$bookfundid'" );
 267
 268     $self->{'bookfundid'} = $bookfundid;
 269     return;
 270 }
 271
 272 =head2 startup_24_add_member
 273
 274 Add a patron/member for the tests to use
 275
 276 =cut
 277
 278 sub startup_24_add_member : Test(startup => 1) {
 279     my $self = shift;
 280
 281     my $memberinfo = { surname      => 'surname '  . $self->random_string(),
 282                        firstname    => 'firstname' . $self->random_string(),
 283                        address      => 'address'   . $self->random_string(),
 284                        city         => 'city'      . $self->random_string(),
 285                        cardnumber   => 'card'      . $self->random_string(),
 286                        branchcode   => 'CPL', # CPL => Centerville
 287                        categorycode => 'PT',  # PT  => PaTron
 288                        dateexpiry   => '2010-01-01',
 289                        password     => 'testpassword',
 290                   };
 291
 292     my $borrowernumber = AddMember( %$memberinfo );
 293     ok( $borrowernumber, "created member: $borrowernumber" );
 294     $self->{'memberid'} = $borrowernumber;
 295
 296     return;
 297 }
 298
 299 =head2 startup_30_login
 300
 301 =cut
 302
 303 sub startup_30_login : Test( startup => 2 ) {
 304     my $self = shift;
 305
 306     $self->{'sessionid'} = '12345678'; # does this value matter?
 307     my $borrower_details = C4::Members::GetMemberDetails( $self->{'memberid'} );
 308     ok( $borrower_details->{'cardnumber'}, 'cardnumber' );
 309
 310     # make a cookie and force it into $cgi.
 311     # This would be a lot easier with Test::MockObject::Extends.
 312     my $cgi = CGI->new( { userid   => $borrower_details->{'cardnumber'},
 313                           password => 'testpassword' } );
 314     my $setcookie = $cgi->cookie( -name  => 'CGISESSID',
 315                                   -value => $self->{'sessionid'} );
 316     $cgi->{'.cookies'} = { CGISESSID => $setcookie };
 317     is( $cgi->cookie('CGISESSID'), $self->{'sessionid'}, 'the CGISESSID cookie is set' );
 318     # diag( Data::Dumper->Dump( [ $cgi->cookie('CGISESSID') ], [ qw( cookie ) ] ) );
 319
 320     # C4::Auth::checkauth sometimes emits a warning about unable to append to sessionlog. That's OK.
 321     my ( $userid, $cookie, $sessionID ) = C4::Auth::checkauth( $cgi, 'noauth', {}, 'intranet' );
 322     # diag( Data::Dumper->Dump( [ $userid, $cookie, $sessionID ], [ qw( userid cookie sessionID ) ] ) );
 323
 324     # my $session = C4::Auth::get_session( $sessionID );
 325     # diag( Data::Dumper->Dump( [ $session ], [ qw( session ) ] ) );
 326
 327
 328 }
 329
 330 =head2 setup methods
 331
 332 setup methods are run before every test method
 333
 334 =cut
 335
 336 =head2 teardown methods
 337
 338 teardown methods are many time, once at the end of each test method.
 339
 340 =cut
 341
 342 =head2 shutdown methods
 343
 344 shutdown methods are run once, at the end of the test suite
 345
 346 =cut
 347
 348 =head2 utility methods
 349
 350 These are not test methods, but they're handy
 351
 352 =cut
 353
 354 =head3 random_string
 355
 356 Nice for generating names and such. It's not actually random, more
 357 like arbitrary.
 358
 359 =cut
 360
 361 sub random_string {
 362     my $self = shift;
 363
 364     my $wordsize = 6;  # how many letters in your string?
 365
 366     # leave out these characters: "oOlL10". They're too confusing.
 367     my @alphabet = ( 'a'..'k','m','n','p'..'z', 'A'..'K','M','N','P'..'Z', 2..9 );
 368
 369     my $randomstring;
 370     foreach ( 0..$wordsize ) {
 371         $randomstring .= $alphabet[ rand( scalar( @alphabet ) ) ];
 372     }
 373     return $randomstring;
 374
 375 }
 376
 377 =head3 add_biblios
 378
 379   $self->add_biblios( count     => 10,
 380                       add_items => 1, );
 381
 382   named parameters:
 383      count: number of biblios to add
 384      add_items: should you add items for each one?
 385
 386   returns:
 387     I don't know yet.
 388
 389   side effects:
 390     adds the biblionumbers to the $self->{'biblios'} listref
 391
 392   Notes:
 393     Should I allow you to pass in biblio information, like title?
 394     Since this method is in the KohaTest class, all tests in it will be ignored, unless you call this from your own namespace.
 395     This runs 10 tests, plus 4 for each "count", plus 3 more for each item added.
 396
 397 =cut
 398
 399 sub add_biblios {
 400     my $self = shift;
 401     my %param = @_;
 402
 403     $param{'count'}     = 1 unless defined( $param{'count'} );
 404     $param{'add_items'} = 0 unless defined( $param{'add_items'} );
 405
 406     foreach my $counter ( 1..$param{'count'} ) {
 407         my $marcrecord  = MARC::Record->new();
 408         isa_ok( $marcrecord, 'MARC::Record' );
 409         my $appendedfieldscount = $marcrecord->append_fields( MARC::Field->new( '100', '1', '0',
 410                                                                                 a => 'Twain, Mark',
 411                                                                                 d => "1835-1910." ),
 412                                                               MARC::Field->new( '245', '1', '4',
 413                                                                                 a => sprintf( 'The Adventures of Huckleberry Finn Test %s', $counter ),
 414                                                                                 c => "Mark Twain ; illustrated by E.W. Kemble." ),
 415                                                               MARC::Field->new( '952', '0', '0',
 416                                                                                 p => '12345678' . $self->random_string() ),   # barcode
 417                                                               MARC::Field->new( '952', '0', '0',
 418                                                                                 a => 'CPL',
 419                                                                                 b => 'CPL' ),
 420                                                          );
 421
 422         diag $MARC::Record::ERROR if ( $MARC::Record::ERROR );
 423         is( $appendedfieldscount, 4, 'added 4 fields' );
 424
 425         my $frameworkcode = ''; # XXX I'd like to put something reasonable here.
 426         my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $marcrecord, $frameworkcode );
 427         ok( $biblionumber, "the biblionumber is $biblionumber" );
 428         ok( $biblioitemnumber, "the biblioitemnumber is $biblioitemnumber" );
 429         if ( $param{'add_items'} ) {
 430             # my @iteminfo = AddItem( {}, $biblionumber );
 431             my @iteminfo = AddItemFromMarc( $marcrecord, $biblionumber );
 432             is( $iteminfo[0], $biblionumber,     "biblionumber is $biblionumber" );
 433             is( $iteminfo[1], $biblioitemnumber, "biblioitemnumber is $biblioitemnumber" );
 434             ok( $iteminfo[2], "itemnumber is $iteminfo[2]" );
 435         }
 436         push @{$self->{'biblios'}}, $biblionumber;
 437     }
 438
 439     $self->reindex_marc();
 440     my $query = 'Finn Test';
 441     my ( $error, $results ) = SimpleSearch( $query );
 442     if ( $param{'count'} <= scalar( @$results ) ) {
 443         pass( "found all $param{'count'} titles" );
 444     } else {
 445         fail( "we never found all $param{'count'} titles" );
 446     }
 447
 448 }
 449
 450 =head3 reindex_marc
 451
 452 Do a fast reindexing of all of the bib and authority
 453 records and mark all zebraqueue entries done.
 454
 455 Useful for test routines that need to do a
 456 lot of indexing without having to wait for
 457 zebraqueue.
 458
 459 In NoZebra model, this only marks zebraqueue
 460 done - the records should already be indexed.
 461
 462 =cut
 463
 464 sub reindex_marc {
 465     my $self = shift;
 466
 467     # mark zebraqueue done regardless of the indexing mode
 468     my $dbh = C4::Context->dbh();
 469     $dbh->do("UPDATE zebraqueue SET done = 1 WHERE done = 0");
 470
 471     return if C4::Context->preference('NoZebra');
 472
 473     my $directory = tempdir(CLEANUP => 1);
 474     foreach my $record_type qw(biblio authority) {
 475         mkdir "$directory/$record_type";
 476         my $sth = $dbh->prepare($record_type eq "biblio" ? "SELECT marc FROM biblioitems" : "SELECT marc FROM auth_header");
 477         $sth->execute();
 478         open OUT, ">:utf8", "$directory/$record_type/records";
 479         while (my ($blob) = $sth->fetchrow_array) {
 480             print OUT $blob;
 481         }
 482         close OUT;
 483         my $zebra_server = "${record_type}server";
 484         my $zebra_config  = C4::Context->zebraconfig($zebra_server)->{'config'};
 485         my $zebra_db_dir  = C4::Context->zebraconfig($zebra_server)->{'directory'};
 486         my $zebra_db = $record_type eq 'biblio' ? 'biblios' : 'authorities';
 487         system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 init > /dev/null 2>\&1";
 488         system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 update $directory/${record_type} > /dev/null 2>\&1";
 489         system "zebraidx -c $zebra_config -d $zebra_db -g iso2709 commit > /dev/null 2>\&1";
 490     }
 491
 492 }
 493
 494
 495 =head3 clear_test_database
 496
 497   removes all tables from test database so that install starts with a clean slate
 498
 499 =cut
 500
 501 sub clear_test_database {
 502
 503     diag "removing tables from test database";
 504
 505     my $dbh = C4::Context->dbh;
 506     my $schema = C4::Context->config("database");
 507
 508     my @tables = get_all_tables($dbh, $schema);
 509     foreach my $table (@tables) {
 510         drop_all_foreign_keys($dbh, $table);
 511     }
 512
 513     foreach my $table (@tables) {
 514         drop_table($dbh, $table);
 515     }
 516 }
 517
 518 sub get_all_tables {
 519   my ($dbh, $schema) = @_;
 520   my $sth = $dbh->prepare("SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ?");
 521   my @tables = ();
 522   $sth->execute($schema);
 523   while (my ($table) = $sth->fetchrow_array) {
 524     push @tables, $table;
 525   }
 526   $sth->finish;
 527   return @tables;
 528 }
 529
 530 sub drop_all_foreign_keys {
 531     my ($dbh, $table) = @_;
 532     # get the table description
 533     my $sth = $dbh->prepare("SHOW CREATE TABLE $table");
 534     $sth->execute;
 535     my $vsc_structure = $sth->fetchrow;
 536     # split on CONSTRAINT keyword
 537     my @fks = split /CONSTRAINT /,$vsc_structure;
 538     # parse each entry
 539     foreach (@fks) {
 540         # isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop
 541         $_ = /(.*) FOREIGN KEY.*/;
 542         my $id = $1;
 543         if ($id) {
 544             # we have found 1 foreign, drop it
 545             $dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id");
 546             $id="";
 547         }
 548     }
 549 }
 550
 551 sub drop_table {
 552     my ($dbh, $table) = @_;
 553     $dbh->do("DROP TABLE $table");
 554 }
 555
 556 =head3 create_test_database
 557
 558   sets up the test database.
 559
 560 =cut
 561
 562 sub create_test_database {
 563
 564     diag 'creating testing database...';
 565     my $installer = C4::Installer->new() or die 'unable to create new installer';
 566     # warn Data::Dumper->Dump( [ $installer ], [ 'installer' ] );
 567     my $all_languages = getAllLanguages();
 568     my $error = $installer->load_db_schema();
 569     die "unable to load_db_schema: $error" if ( $error );
 570     my $list = $installer->sql_file_list('en', 'marc21', { optional  => 1,
 571                                                            mandatory => 1 } );
 572     my ($fwk_language, $installed_list) = $installer->load_sql_in_order($all_languages, @$list);
 573     $installer->set_version_syspref();
 574     $installer->set_marcflavour_syspref('MARC21');
 575     $installer->set_indexing_engine(0);
 576     diag 'database created.'
 577 }
 578
 579
 580 =head3 start_zebrasrv
 581
 582   This method deletes and reinitializes the zebra database directory,
 583   and then spans off a zebra server.
 584
 585 =cut
 586
 587 sub start_zebrasrv {
 588
 589     stop_zebrasrv();
 590     diag 'cleaning zebrasrv...';
 591
 592     foreach my $zebra_server ( qw( biblioserver authorityserver ) ) {
 593         my $zebra_config  = C4::Context->zebraconfig($zebra_server)->{'config'};
 594         my $zebra_db_dir  = C4::Context->zebraconfig($zebra_server)->{'directory'};
 595         foreach my $zebra_db_name ( qw( biblios authorities ) ) {
 596             my $command = "zebraidx -c $zebra_config -d $zebra_db_name init";
 597             my $return = system( $command . ' > /dev/null 2>&1' );
 598             if ( $return != 0 ) {
 599                 diag( "command '$command' died with value: " . $? >> 8 );
 600             }
 601
 602             $command = "zebraidx -c $zebra_config -d $zebra_db_name create $zebra_db_name";
 603             diag $command;
 604             $return = system( $command . ' > /dev/null 2>&1' );
 605             if ( $return != 0 ) {
 606                 diag( "command '$command' died with value: " . $? >> 8 );
 607             }
 608         }
 609     }
 610
 611     diag 'starting zebrasrv...';
 612
 613     my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
 614     my $command = sprintf( 'zebrasrv -f %s -D -l %s -p %s',
 615                            $ENV{'KOHA_CONF'},
 616                            File::Spec->catdir( C4::Context->config("logdir"), 'zebra.log' ),
 617                            $pidfile,
 618                       );
 619     diag $command;
 620     my $output = qx( $command );
 621     if ( $output ) {
 622         diag $output;
 623     }
 624     if ( -e $pidfile, 'pidfile exists' ) {
 625         diag 'zebrasrv started.';
 626     } else {
 627         die 'unable to start zebrasrv';
 628     }
 629     return $output;
 630 }
 631
 632 =head3 stop_zebrasrv
 633
 634   using the PID file for the zebra server, send it a TERM signal with
 635   "kill". We can't tell if the process actually dies or not.
 636
 637 =cut
 638
 639 sub stop_zebrasrv {
 640
 641     my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
 642     if ( -e $pidfile ) {
 643         open( my $pidh, '<', $pidfile )
 644           or return;
 645         if ( defined $pidh ) {
 646             my ( $pid ) = <$pidh> or return;
 647             close $pidh;
 648             my $killed = kill 15, $pid; # 15 is TERM
 649             if ( $killed != 1 ) {
 650                 warn "unable to kill zebrasrv with pid: $pid";
 651             }
 652         }
 653     }
 654 }
 655
 656
 657 =head3 start_zebraqueue_daemon
 658
 659   kick off a zebraqueue_daemon.pl process.
 660
 661 =cut
 662
 663 sub start_zebraqueue_daemon {
 664
 665     my $command = q(run/bin/koha-zebraqueue-ctl.sh start);
 666     diag $command;
 667     my $started = system( $command );
 668     diag "started: $started";
 669
 670 }
 671
 672 =head3 stop_zebraqueue_daemon
 673
 674
 675 =cut
 676
 677 sub stop_zebraqueue_daemon {
 678
 679     my $command = q(run/bin/koha-zebraqueue-ctl.sh stop);
 680     diag $command;
 681     my $started = system( $command );
 682     diag "started: $started";
 683
 684 }
 685
 686 1;