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