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