t/database_dependent.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 =head2
   7
   8
   9
  10 =cut
  11
  12 use C4::Context;
  13 use C4::Installer;
  14 use C4::Languages;
  15 use Data::Dumper;
  16 use Test::More;
  17
  18 use Test::Class::Load qw ( . ); # run from the t directory
  19
  20 clear_test_database();
  21 create_test_database();
  22
  23 start_zebrasrv();
  24 start_zebraqueue_daemon();
  25
  26 if ($ENV{'TEST_CLASS'}) {
  27     # assume only one test class is specified;
  28     # should extend to allow multiples, but that will
  29     # mean changing how test classes are loaded.
  30     eval "KohaTest::$ENV{'TEST_CLASS'}->runtests";
  31 } else {
  32     Test::Class->runtests;
  33 }
  34
  35 stop_zebraqueue_daemon();
  36 stop_zebrasrv();
  37
  38 # stop_zebrasrv();
  39
  40 =head3 clear_test_database
  41
  42   removes all tables from test database so that install starts with a clean slate
  43
  44 =cut
  45
  46 sub clear_test_database {
  47
  48     diag "removing tables from test database";
  49
  50     my $dbh = C4::Context->dbh;
  51     my $schema = C4::Context->config("database");
  52
  53     my @tables = get_all_tables($dbh, $schema);
  54     foreach my $table (@tables) {
  55         drop_all_foreign_keys($dbh, $table);
  56     }
  57
  58     foreach my $table (@tables) {
  59         drop_table($dbh, $table);
  60     }
  61 }
  62
  63 sub get_all_tables {
  64   my ($dbh, $schema) = @_;
  65   my $sth = $dbh->prepare("SELECT TABLE_NAME FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = ?");
  66   my @tables = ();
  67   $sth->execute($schema);
  68   while (my ($table) = $sth->fetchrow_array) {
  69     push @tables, $table;
  70   }
  71   $sth->finish;
  72   return @tables;
  73 }
  74
  75 sub drop_all_foreign_keys {
  76     my ($dbh, $table) = @_;
  77     # get the table description
  78     my $sth = $dbh->prepare("SHOW CREATE TABLE $table");
  79     $sth->execute;
  80     my $vsc_structure = $sth->fetchrow;
  81     # split on CONSTRAINT keyword
  82     my @fks = split /CONSTRAINT /,$vsc_structure;
  83     # parse each entry
  84     foreach (@fks) {
  85         # isolate what is before FOREIGN KEY, if there is something, it's a foreign key to drop
  86         $_ = /(.*) FOREIGN KEY.*/;
  87         my $id = $1;
  88         if ($id) {
  89             # we have found 1 foreign, drop it
  90             $dbh->do("ALTER TABLE $table DROP FOREIGN KEY $id");
  91             $id="";
  92         }
  93     }
  94 }
  95
  96 sub drop_table {
  97     my ($dbh, $table) = @_;
  98     $dbh->do("DROP TABLE $table");
  99 }
 100
 101 =head3 create_test_database
 102
 103   sets up the test database.
 104
 105 =cut
 106
 107 sub create_test_database {
 108
 109     diag 'creating testing database...';
 110     my $installer = C4::Installer->new() or die 'unable to create new installer';
 111     # warn Data::Dumper->Dump( [ $installer ], [ 'installer' ] );
 112     my $all_languages = getAllLanguages();
 113     my $error = $installer->load_db_schema();
 114     die "unable to load_db_schema: $error" if ( $error );
 115     my $list = $installer->sql_file_list('en', 'marc21', { optional  => 1,
 116                                                            mandatory => 1 } );
 117     my ($fwk_language, $installed_list) = $installer->load_sql_in_order($all_languages, @$list);
 118     $installer->set_version_syspref();
 119     $installer->set_marcflavour_syspref('MARC21');
 120     $installer->set_indexing_engine(0);
 121     diag 'database created.'
 122 }
 123
 124
 125 =head3 start_zebrasrv
 126
 127   This method deletes and reinitializes the zebra database directory,
 128   and then spans off a zebra server.
 129
 130 =cut
 131
 132 sub start_zebrasrv {
 133
 134     stop_zebrasrv();
 135     diag 'cleaning zebrasrv...';
 136
 137     foreach my $zebra_server ( qw( biblioserver authorityserver ) ) {
 138         my $zebra_config  = C4::Context->zebraconfig($zebra_server)->{'config'};
 139         my $zebra_db_dir  = C4::Context->zebraconfig($zebra_server)->{'directory'};
 140         foreach my $zebra_db_name ( qw( biblios authorities ) ) {
 141             my $command = "zebraidx -c $zebra_config -d $zebra_db_name init";
 142             my $return = system( $command . ' > /dev/null 2>&1' );
 143             if ( $return != 0 ) {
 144                 diag( "command '$command' died with value: " . $? >> 8 );
 145             }
 146
 147             $command = "zebraidx -c $zebra_config -d $zebra_db_name create $zebra_db_name";
 148             diag $command;
 149             $return = system( $command . ' > /dev/null 2>&1' );
 150             if ( $return != 0 ) {
 151                 diag( "command '$command' died with value: " . $? >> 8 );
 152             }
 153         }
 154     }
 155
 156     diag 'starting zebrasrv...';
 157
 158     my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
 159     my $command = sprintf( 'zebrasrv -f %s -D -l %s -p %s',
 160                            $ENV{'KOHA_CONF'},
 161                            File::Spec->catdir( C4::Context->config("logdir"), 'zebra.log' ),
 162                            $pidfile,
 163                       );
 164     diag $command;
 165     my $output = qx( $command );
 166     if ( $output ) {
 167         diag $output;
 168     }
 169     if ( -e $pidfile, 'pidfile exists' ) {
 170         diag 'zebrasrv started.';
 171     } else {
 172         die 'unable to start zebrasrv';
 173     }
 174     return $output;
 175 }
 176
 177 =head3 stop_zebrasrv
 178
 179   using the PID file for the zebra server, send it a TERM signal with
 180   "kill". We can't tell if the process actually dies or not.
 181
 182 =cut
 183
 184 sub stop_zebrasrv {
 185
 186     my $pidfile = File::Spec->catdir( C4::Context->config("logdir"), 'zebra.pid' );
 187     if ( -e $pidfile ) {
 188         open( my $pidh, '<', $pidfile )
 189           or return;
 190         if ( defined $pidh ) {
 191             my ( $pid ) = <$pidh> or return;
 192             close $pidh;
 193             my $killed = kill 15, $pid; # 15 is TERM
 194             if ( $killed != 1 ) {
 195                 warn "unable to kill zebrasrv with pid: $pid";
 196             }
 197         }
 198     }
 199 }
 200
 201
 202 =head3 start_zebraqueue_daemon
 203
 204   kick off a zebraqueue_daemon.pl process.
 205
 206 =cut
 207
 208 sub start_zebraqueue_daemon {
 209
 210     my $command = q(run/bin/koha-zebraqueue-ctl.sh start);
 211     diag $command;
 212     my $started = system( $command );
 213     diag "started: $started";
 214
 215 #     my $command = sprintf( 'KOHA_CONF=%s ../misc/bin/zebraqueue_daemon.pl > %s 2>&1 &',
 216 #                            $ENV{'KOHA_CONF'},
 217 #                            'zebra.log',
 218 #                       );
 219 #     diag $command;
 220 #     my $queue = system( $command );
 221 #     diag "queue: $queue";
 222
 223 }
 224
 225 =head3 stop_zebraqueue_daemon
 226
 227
 228 =cut
 229
 230 sub stop_zebraqueue_daemon {
 231
 232     my $command = q(run/bin/koha-zebraqueue-ctl.sh stop);
 233     diag $command;
 234     my $started = system( $command );
 235     diag "started: $started";
 236
 237 }