view release on metacpan or  search on metacpan

t/Utils.pm  view on Meta::CPAN

package t::Utils;
use strict;
use warnings;
use File::Temp ();
use DBI;
use Path::Class;
use lib Path::Class::Dir->new('t', 'lib')->stringify;

use IO::Socket::INET;
use Test::More;

sub import {
    my($class, %args) = @_;
    my $caller = caller;

    strict->import;
    warnings->import;

    for my $name (qw/ temp_filename run setup_schema teardown_schema /) {
        no strict 'refs';
        *{"$caller\::$name"} = \&{$name};
    }

    if ($args{config}) {
        $class->setup_test($caller, $args{config});
    }
}

my $RUN_CODE = sub {};
my $CLEANUP_CODE = sub {};
my $CACHE_CLASS;
sub _make_driver_instance {
    my $class = shift;
    my $driver = $class->new( @_ );

    if ($CACHE_CLASS) {
        my %options = ();
        if ($CACHE_CLASS =~ /::Memcached$/) {
            my $memcached_bin     = $ENV{TEST_MEMCACHED_BIN};

            eval "use Cache::Memcached::Fast";
            plan skip_all => "Cache::Memcached::Fast required for testing memcached driver" if $@;

            if ($memcached_bin && -x $memcached_bin) {

                eval "use Test::TCP";
                plan skip_all => "Test::TCP required for testing memcached driver" if $@;

                my $port = empty_port();
                $options{memcached} = Cache::Memcached::Fast->new({ servers => [ { address => "localhost:$port" }, ], });

                my $run = $RUN_CODE;
                $RUN_CODE = sub {
                    test_tcp(
                        client => sub {
                            $run->();
                        },
                        server => sub {
                            exec $memcached_bin, '-p', $port;
                        },
                        port => $port,
                    );
                };
            } else {
                plan skip_all => "Set TEST_MEMCACHED_BIN environment variable to run this test";
            }
        }
        $driver = $CACHE_CLASS->new(
            fallback => $driver,
            %options,
        );
    }
    $driver;
}

sub setup_test {