File Coverage

blib/lib/App/Prove/Plugin/MySQLPool.pm

Criterion	Covered	Total	%
statement	21	62	33.8
branch	0	20	0.0
condition	0	2	0.0
subroutine	7	13	53.8
pod	0	2	0.0
total	28	99	28.2

package App::Prove::Plugin::MySQLPool;
use strict;
use warnings;
use File::Temp;
use POSIX::AtFork;
use Test::mysqld::Pool;

our $VERSION = '0.10';

sub load {
    my ($class, $prove) = @_;
    my @args     = @{ $prove->{args} };
    my $preparer = $args[ 0 ];
    my $jobs     = $prove->{ app_prove }->jobs || 1;
    my $lib      = $prove->{ app_prove }->lib;
    my $blib     = $prove->{ app_prove }->blib;
    my $includes = $prove->{ app_prove }->includes;

    my $share_file = File::Temp->new(); # deleted when DESTROYed
    my $pool       = Test::mysqld::Pool->new(
        jobs       => $jobs,
        share_file => $share_file->filename,
        ($preparer ? do {
            my @libs;
            push( @libs, 'lib' ) if $lib;
            push( @libs, 'blib/lib', 'blib/arch' ) if $blib;
            push( @libs, @$includes ) if @$includes;
            @libs = map { File::Spec->rel2abs($_) } @libs;
            push( @INC, @libs );
            eval "require $preparer" ## no critic
                or die "$@";
            (
                preparer => sub {
                    my ($mysqld) = @_;
                    $preparer->prepare( $mysqld );
                },
                $preparer->can('my_cnf') ? ( my_cnf => $preparer->my_cnf ) : (),
            )
        } : ()),
    );
    $pool->prepare;

    $prove->{ app_prove }{ __PACKAGE__ } = [ $pool, $share_file ]; # ref++
    $prove->{ app_prove }->formatter('TAP::Formatter::MySQLPool');

    $ENV{ PERL_APP_PROVE_PLUGIN_MYSQLPOOL_SHARE_FILE } = $share_file->filename;

    POSIX::AtFork->add_to_child(create_child_hook($$));

    1;
}

sub create_child_hook {
    my ($ppid) = @_;
    return sub {
        my ($call) = @_;

        # we're in the test process

        # prove uses 'fork' to create child processes
        # our own 'ps -o pid ...' uses 'backtick'
        # only hook 'fork'
        ($call eq 'fork')
            or return;

        # restrict only direct child of prove
        (getppid() == $ppid)
            or return;

        my $share_file = $ENV{ PERL_APP_PROVE_PLUGIN_MYSQLPOOL_SHARE_FILE }
            or return;

        my $dsn = Test::mysqld::Pool->new( share_file => $share_file )->alloc;

        # use this in tests
        $ENV{ PERL_TEST_MYSQLPOOL_DSN } = $dsn;
    };
}

{
    package TAP::Formatter::MySQLPool::Session;
    use parent 'TAP::Formatter::Console::Session';

    sub close_test {
        my $self = shift;

        my $share_file = $ENV{ PERL_APP_PROVE_PLUGIN_MYSQLPOOL_SHARE_FILE }
            or return;
        Test::mysqld::Pool->new( share_file => $share_file )->dealloc_unused;

        $self->SUPER::close_test(@_);
    }
}

{
    package TAP::Formatter::MySQLPool;
    use parent 'TAP::Formatter::Console';

    sub open_test {
        my $self = shift;

        bless $self->SUPER::open_test(@_), 'TAP::Formatter::MySQLPool::Session';
    }
}

1;
__END__