t/common.pm

   1 package # Hide from PAUSE
   2     t::common;
   3
   4 use strict;
   5 use warnings FATAL => 'all';
   6
   7 use base 'Exporter';
   8 our @EXPORT_OK = qw(
   9     new_dbm
  10     new_fh
  11 );
  12
  13 use File::Spec ();
  14 use File::Temp qw( tempfile tempdir );
  15 use Fcntl qw( :flock );
  16
  17 my $parent = $ENV{WORK_DIR} || File::Spec->tmpdir;
  18 my $dir = tempdir( CLEANUP => 1, DIR => $parent );
  19
  20 sub new_fh {
  21     my ($fh, $filename) = tempfile( 'tmpXXXX', DIR => $dir, UNLINK => 1 );
  22
  23     # This is because tempfile() returns a flock'ed $fh on MacOSX.
  24     flock $fh, LOCK_UN;
  25
  26     return ($fh, $filename);
  27 }
  28
  29 sub new_dbm {
  30     my @args = @_;
  31     my ($fh, $filename) = new_fh();
  32     my @extra_args = (
  33         [ file => $filename ],
  34     );
  35
  36 #    eval { require DBD::SQLite; };
  37 #    unless ( $@ ) {
  38 #        push @extra_args, [
  39 #        ];
  40 #    }
  41
  42     if ( $ENV{TEST_MYSQL_DSN} ) {
  43         push @extra_args, [
  44             dbi => {
  45                 dsn      => "dbi:mysql:$ENV{TEST_MYSQL_DSN}",
  46                 user     => $ENV{TEST_MYSQL_USER},
  47                 password => $ENV{TEST_MYSQL_PASS},
  48             },
  49         ];
  50     }
  51
  52     return sub {
  53         return unless @extra_args;
  54         my @these_args = @{ shift @extra_args };
  55         return sub {
  56             DBM::Deep->new(
  57                 @these_args, @args, @_,
  58             );
  59         };
  60     };
  61 }
  62
  63 1;
  64 __END__