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