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