t/test_fixture.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use DateTime;
   7 use LWP::Simple;
   8 use App::Prove;
   9 use Data::Dumper;
  10
  11 use Pod::Usage;
  12 use Getopt::Long;
  13 use File::Slurp;
  14 use Config::Any;
  15
  16 use File::Basename qw(dirname);
  17 use Cwd qw(abs_path);
  18
  19 use Catalyst::ScriptRunner;
  20
  21 use lib 'lib';
  22 use SGN::Devel::MyDevLibs;
  23
  24 my $verbose = 0;
  25 my $nocleanup;
  26 my $noserver;
  27 my $noparallel = 0;
  28 # relative to `sgn/ (or parent of wherever this script is located)
  29 my $fixture_path = 't/data/fixture/cxgn_fixture.sql';
  30
  31 GetOptions(
  32     "carpalways" => \( my $carpalways = 0 ),
  33     "verbose" => \$verbose ,
  34     "nocleanup" => \$nocleanup,
  35     "noserver" => \$noserver,
  36     "noparallel" => \$noparallel,
  37     "fixture_path" => \$fixture_path,
  38     );
  39
  40 require Carp::Always if $carpalways;
  41
  42 my @prove_args = @ARGV;
  43 if(@prove_args){
  44     @prove_args = map {abs_path($_)} @prove_args;
  45 }
  46
  47 #Change cwd to `sgn/` (or parent of wherever this script is located)
  48 my $sgn_dir = abs_path(dirname(abs_path($0))."/../");
  49 print STDERR "####### ".$sgn_dir." #######";
  50 chdir($sgn_dir);
  51 @prove_args = ( 't' ) unless @prove_args;
  52
  53 #my $parallel = (grep /^-j\d*$/, @ARGV) ? 1 : 0;
  54
  55 $ENV{SGN_CONFIG_LOCAL_SUFFIX} = 'fixture';
  56 #my $conf_file_base = 'sgn_local.conf'; # which conf file the sgn_fixture.conf should be based on
  57 # relative to `sgn/`
  58 my $conf_file_base = 'sgn_local.conf';
  59 my $template_file = 'sgn_fixture_template.conf';
  60 # get some defaults from sgn_local.conf
  61 #
  62 my $cfg = Config::Any->load_files({files=> [$conf_file_base, $template_file], use_ext=>1 });
  63
  64 my $config = $cfg->[0]->{$conf_file_base};
  65 my $template = $cfg->[1]->{$template_file};
  66
  67 #print STDERR Dumper($cfg);
  68 my $db_user_password = $config->{dbpass};
  69 my $dbhost = $config->{db_host} || 'localhost';
  70 my $db_postgres_password = $config->{DatabaseConnection}->{sgn_test}->{password};
  71 my $test_dsn = $config->{DatabaseConnection}->{sgn_test}->{dsn};
  72 my $catalyst_server_port = 3010;
  73
  74 # replace the keys in the sgn local file with what's in the template
  75 #
  76 foreach my $k (keys %{$template}) {
  77     #print STDERR "Replacing key $k : $config->{$k} with $template->{$k}\n";
  78     $config->{$k} = $template->{$k};
  79 }
  80
  81 # load the database fixture
  82 #
  83 my $now = DateTime->now();
  84 my $dbname = join "_", map { $now->$_ } (qw | year month day hour minute |);
  85 $dbname = 'test_db_'.$dbname;
  86 $dbname .= $$;
  87
  88 print STDERR "# Writing a .pgpass file... ";
  89 # format = hostname:port:database:username:password
  90 open(my $PGPASS, ">", "$ENV{HOME}/.pgpass") || die "Can't open .pgpass for writing.";
  91 print $PGPASS "$dbhost:5432:$dbname:web_usr:$db_user_password\n";
  92 print $PGPASS "$dbhost:5432:*:postgres:$db_postgres_password\n";
  93 close($PGPASS);
  94 system("chmod 0600 $ENV{HOME}/.pgpass");
  95 print STDERR "Done.\n";
  96
  97 my $database_fixture_dump = $ENV{DATABASE_FIXTURE_PATH} || $fixture_path;
  98 print STDERR "# Loading database fixture... $database_fixture_dump ... ";
  99 system("createdb -h $config->{dbhost} -U postgres -T template0 -E SQL_ASCII --no-password $dbname");
 100 system("cat $database_fixture_dump | psql -h $config->{dbhost} -U postgres $dbname > /dev/null");
 101
 102 print STDERR "Done.\n";
 103
 104 print STDERR "# Creating sgn_fixture.conf file... ";
 105 $config->{dbname} = $dbname;
 106 $test_dsn =~ s/dbname=(.*)$/dbname=$dbname/;
 107 $config->{DatabaseConnection}->{sgn_test}->{dsn} = $test_dsn;
 108
 109 #print STDERR Dumper($config);
 110
 111 my $new_conf = hash2config($config);
 112
 113 open(my $NEWCONF, ">", "sgn_fixture.conf") || die "Can't open sgn_fixture.conf for writing";
 114 print $NEWCONF $new_conf;
 115 close($NEWCONF);
 116
 117 # run the materialized views creation script
 118 #
 119 print STDERR "Running matview refresh with -H $dbhost -D $dbname -U postgres -P $db_postgres_password\n";
 120 system("perl bin/refresh_matviews.pl -H $dbhost -D $dbname -U postgres -P $db_postgres_password");
 121
 122
 123 print STDERR "Done.\n";
 124
 125 #run fixture and db patches.
 126 system("t/data/fixture/patches/run_fixture_and_db_patches.pl -u postgres -p postgres -h $config->{dbhost} -d $dbname -e janedoe");
 127
 128 # start the test web server
 129 #
 130 my $server_pid;
 131 my $logfile;
 132 if ($noserver) {
 133     print STDERR "# [ --noserver option: not starting web server]\n";
 134 }
 135 else {
 136     $server_pid = fork;
 137     $logfile  = "logfile.$$.txt";
 138
 139     unless( $server_pid ) {
 140
 141         # web server process
 142         #
 143         #$ENV{SGN_TEST_MODE} = 1;
 144         @ARGV = (
 145             -p => $catalyst_server_port,
 146             ( $noparallel ? () : ('--fork') ),
 147             );
 148
 149         if (!$verbose) {
 150             print STDERR "# [Server logfile at $logfile]\n";
 151             open (STDERR, ">$logfile") || die "can't open logfile.";
 152         }
 153         Catalyst::ScriptRunner->run('SGN', 'Server');
 154
 155         exit;
 156     }
 157     print STDERR  "# Starting web server (PID=$server_pid)... ";
 158 }
 159
 160
 161 # wait for the test server to start
 162 #
 163 {
 164     local $SIG{CHLD} = sub {
 165         waitpid $server_pid, 0;
 166         die "\nTest server failed to start.  Aborting.\n";
 167     };
 168     print STDERR "Done.\n";
 169
 170     if (!$noserver) {
 171         sleep 1 until !kill(0, $server_pid) || get "http://localhost:$catalyst_server_port";
 172     }
 173 }
 174
 175 my $prove_pid = fork;
 176 unless( $prove_pid ) {
 177
 178     # test harness process
 179     #
 180     print STDERR "# Starting tests... \n";
 181
 182     # set up env vars for prove and the tests
 183     #
 184     $ENV{SGN_TEST_SERVER} = "http://localhost:$catalyst_server_port";
 185     if(! $noparallel ) {
 186         $ENV{SGN_PARALLEL_TESTING} = 1;
 187         $ENV{SGN_SKIP_LEAK_TEST}   = 1;
 188     }
 189
 190     # now run the tests against it
 191     #
 192     my $app = App::Prove->new;
 193     $app->process_args(
 194         '-lr',
 195         ( map { -I => $_ } @INC ),
 196         @prove_args
 197         );
 198     exit( $app->run ? 0 : 1 );
 199 }
 200
 201 #$SIG{CHLD} = 'IGNORE';  # problematic
 202 $SIG{INT}  = sub { kill 15, $server_pid, $prove_pid };
 203 $SIG{KILL} = sub { kill 9, $server_pid, $prove_pid };
 204
 205 print STDERR "# Start prove (PID $prove_pid)... \n";
 206 waitpid $prove_pid, 0;
 207 print STDERR "# Prove finished, stopping web server PID $server_pid... ";
 208
 209 END { kill 15, $server_pid if $server_pid }
 210 waitpid $server_pid, 0;
 211 sleep(3);
 212 print STDERR "Done.\n";
 213
 214 if (!$nocleanup) {
 215     print STDERR "# Removing test database ($dbname)... ";
 216     system("dropdb -h $config->{dbhost} -U postgres --no-password $dbname");
 217     print STDERR "Done.\n";
 218
 219     if ($noserver) {
 220         print STDERR "# [ --noserver option: No logfile to remove]\n";
 221     }
 222     else {
 223         print STDERR "# Delete server logfile... ";
 224         close($logfile);
 225         unlink $logfile;
 226         print STDERR "Done.\n";
 227
 228         print STDERR "# Delete fixture conf file... ";
 229         unlink "sgn_fixture.conf";
 230         print STDERR "Done.\n";
 231     }
 232 }
 233 else {
 234     print STDERR "# --nocleanup option: not removing db or files.\n";
 235 }
 236 print STDERR "# Test run complete.\n\n";
 237
 238
 239
 240 sub hash2config {
 241     my $hash = shift;
 242
 243     my $s = "";
 244     foreach my $k (keys(%$hash)) {
 245         if (ref($hash->{$k}) eq "ARRAY") {
 246             foreach my $v (@{$hash->{$k}}) {
 247                 $s .= "$k $v\n";
 248             }
 249         }
 250         elsif (ref($hash->{$k}) eq "HASH") {
 251             foreach my $n (keys(%{$hash->{$k}})) {
 252                 if (ref($hash->{$k}->{$n}) eq "HASH") {
 253                     $s .= "<$k $n>\n";
 254                     $s .= hash2config($hash->{$k}->{$n});
 255                 }
 256                 else {
 257                     $s .= "<$k>\n";
 258                     $s .= hash2config($hash->{$k});
 259                 }
 260                 $s .= "</$k>\n";
 261             }
 262         }
 263         else {
 264             $s .= "$k $hash->{$k}\n";
 265         }
 266     }
 267
 268     # if nothing matched the replace keys, add them here
 269     #
 270
 271 #    if (exists($hash->{dbname})) {
 272 #       $s .= "dbname $dbname\n";
 273  #  }
 274
 275     return $s;
 276 }
 277
 278
 279
 280 __END__
 281
 282 =head1 NAME
 283
 284 test_fixture.pl - start a dev server and run tests against it
 285
 286 =head1 SYNOPSIS
 287
 288 t/test_fixture.pl --carpalways -- -v -j5 t/mytest.t  t/mydiroftests/
 289
 290 =head1 OPTIONS
 291
 292   -v             verbose - the output of the server is not re-directed to file,
 293                  but rather output to the screen.
 294
 295   --carpalways   Load Carp::Always in both the server and the test process
 296                  to force backtraces of all warnings and errors
 297
 298   --nocleanup    Do not clean up database and logfile
 299
 300   --noserver     Do not start webserver (if running unit_fixture tests only)
 301
 302   --noparallel   Do not run the server in parallel mode.
 303
 304   --fixture_path specify a path to the fixture different from the default
 305                  (t/data/fixture/cxgn_fixture.pl). Note: You can also set the env
 306                  variable DATABASE_FIXTURE_PATH, which will overrule this
 307                  option.
 308
 309   -- -v          options specified after two dashes will be passed to prove
 310                  directly, such -v will run prove in verbose mode.
 311
 312 =head1 AUTHORS
 313
 314     Robert Buels (initial script)
 315     Lukas Mueller <lam87@cornell.edu> (fixture implementation)
 316
 317 =cut