New test SQLite databases on the fly

SeKreT.pm

# I needed to sure I was operating on pristine test databases
# every time my code called $test->schema (DBIx::Class and Test::Class::Moose).
# This handles that for me
package TestsFor::SeKreT {
    use Test::Class::Moose;
    use Less::Boilerplate; # gives me a sane version of Perl
    use File::Copy qw(copy);
    use File::Spec::Functions qw(catfile);
    use SeKreT::Util::Data qw(
      make_slug
    );
    use SeKreT::Types qw(
      InstanceOf
    );

    BEGIN {
        # at the start of every test suite run, unlink all previous test dbs
        my %errors;
        while ( my $file = glob('test_dbs/*') ) {
            next if -d $file;
            unlink($file)
              or $errors{$file} = "$!";
        }
        if ( keys %errors ) {
            require Data::Dumper;
            diag Data::Dumper::Dumper( \%errors );
            die "Could not unlink all database files";
        }
    }

    sub schema ($self) {
        state $num_calls = {};

        my $callstack = 0;
        my $sub;
        FRAME:
        while (
            !defined $sub               # we must have a sub
            || $sub =~ /::__ANON__$/    # nope, skip anonymous subs
            || $sub eq '(eval)'         # and evals
            || $sub !~ /^TestsFor::/    # and make sure it's in our test suite
          )
        {
            $callstack++;
            ( undef, undef, undef, $sub ) = caller($callstack);
            if ( $callstack && !defined $sub ) {

                # this shouldn't happen, but in case our callstack gets
                # exhausted, make sure we don't hit an infinite loop
                diag "Warning: could not determine subname for db creation.";
                $sub = 'unknown';
                last FRAME;
            }
        }
        $sub =~ s/^TestsFor:://;
        $num_calls->{$sub}++;
        my $num = $num_calls->{$sub};
        $sub =~ s/::/-/g;
        my $source  = 'db/sekret_test.db';
        my $this_db = catfile( 'test_dbs', make_slug("$sub-$num") . '.db' );
        copy( $source, $this_db ) or croak "Could not copy $source to $this_db: $!";
        return SeKreT::Data::Schema->connect("dbi:SQLite:dbname=$this_db");
    }
    __PACKAGE__->meta->make_immutable;
}

__END__

=head1 NAME

TestsFor::SeKreT - SeKreT base class

=head1 DESCRIPTION

Gotta have a base class!

=head1 METHODS

=head2 C<schema>

    my $schema = $test->schema;
    my $twitter = $schema->resultset('Agent')->find( { name => 'Smith' } );

This method creates a new database instance and returns a
C<SeKreT::Data::Schema> connection to it. Thus, rather than clean up your
database, you can get a fresh one just by calling C<< ->schema >> again.

This will create the database in `test_dbs/` and it will have a name after the
class, the subroutine, and a number indicating which schema call was made.
Thus, if there is a problem after the test run, you can inspect the database
to see what's in there.

All test databases in this directory are deleted at the beginning of the test
suite run.

=cut