start/stop subclassing for setup/teardown?

[Tyler MacDonald]

My unit tests all need a database to operate. I was having each .t file
setup and teardown the test database before, but I want to move to having
this happen when apache is started and stopped, so that I can interact with
things manually on the server and run individual tests with prove a lot
quicker, since that's part of my regular coding flow.

So I tried to subclass the "start" and "stop" methods to set up / tear down
the database. I was suprised to find that my "stop" method gets called even
when I run "perl t/TEST -start"! :


$ perl t/TEST -start
[warning] setting ulimit to allow core files
ulimit -c unlimited; /usr/bin/perl /home/faraway/dev/Apache2-AUS/t/TEST
-start
running start! at /home/faraway/dev/Apache2-AUS/t/TEST line 33.
/usr/sbin/apache2  -d /home/faraway/dev/Apache2-AUS/t -f
/home/faraway/dev/Apache2-AUS/t/conf/httpd.conf -D APACHE2 -D
PERL_USEITHREADS
using Apache/2.0.55 (prefork MPM)

waiting 60 seconds for server to start: ...
waiting 60 seconds for server to start: ok (waited 1 secs)
server crackerjack:8529 started
running stop! at /home/faraway/dev/Apache2-AUS/t/TEST line 47.


I'm kind of confused here. Looking at TestRun.pm's "stop" method, it looks
like it's supposed to stop the test server. Yet it runs when I call
"-start". Yet apache doesn't stop. Yet apache does stop when I call "-stop".
How does this work? :)

        Thanks,
                Tyler


#!perl
  
use strict;
use warnings FATAL => 'all';
  
use lib qw(lib);
use base q(Apache::TestRunPerl);
use Apache::TestConfig ();
use lib 't/tlib';
use t::dbh;
use DBIx::Migration::Directories;

main::->new->run(@ARGV);

sub pre_configure {
      my $self = shift;
      # mod_bt doesn't like to be loaded if it isn't configured.
      Apache::TestConfig::autoconfig_skip_module_add('mod_bt.c')
}

sub start {
    my $self = shift;
    warn "running start!";
    if(my $dbh = dbh) {
        my $mh = DBIx::Migration::Directories->new(
            schema      =>  "Schema::RDBMS::AUS",
            dbh         =>  $dbh,
        );
        $mh->full_migrate;
        $dbh->disconnect;
    }
    return $self->SUPER::start(@_);
}

sub stop {
    my $self = shift;
    warn "running stop!";
    if(my $dbh = dbh) {
        my $mh = DBIx::Migration::Directories->new(
            schema      =>  "Schema::RDBMS::AUS",
            dbh         =>  $dbh,
        );
        $mh->full_delete_schema;
        $dbh->disconnect;
    }
    return $self->SUPER::stop(@_);
}