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
  33     my @reset_funcs;
  34     my @extra_args;
  35
  36     unless ( $ENV{NO_TEST_FILE} ) {
  37         push @reset_funcs, undef;
  38         push @extra_args, (
  39             [ file => $filename ],
  40         );
  41     }
  42
  43 #    eval { require DBD::SQLite; };
  44 #    unless ( $@ ) {
  45 #        push @extra_args, [
  46 #        ];
  47 #    }
  48
  49     if ( $ENV{TEST_MYSQL_DSN} ) {
  50         push @reset_funcs, sub {
  51             my $dbh = DBI->connect(
  52                 "dbi:mysql:$ENV{TEST_MYSQL_DSN}",
  53                 $ENV{TEST_MYSQL_USER},
  54                 $ENV{TEST_MYSQL_PASS},
  55             );
  56             my $sql = do {
  57                 my $filename = 'etc/mysql_tables.sql';
  58                 open my $fh, '<', $filename
  59                     or die "Cannot open '$filename' for reading: $!\n";
  60                 local $/;
  61                 <$fh>
  62             };
  63             foreach my $line ( split ';', $sql ) {
  64                 $dbh->do( "$line" ) if $line =~ /\S/;
  65             }
  66         };
  67         push @extra_args, [
  68             dbi => {
  69                 dsn      => "dbi:mysql:$ENV{TEST_MYSQL_DSN}",
  70                 user     => $ENV{TEST_MYSQL_USER},
  71                 password => $ENV{TEST_MYSQL_PASS},
  72             },
  73         ];
  74     }
  75
  76     return sub {
  77         return unless @extra_args;
  78         my @these_args = @{ shift @extra_args };
  79         if ( my $reset = shift @reset_funcs ) {
  80             $reset->();
  81         }
  82         return sub {
  83             DBM::Deep->new(
  84                 @these_args, @args, @_,
  85             );
  86         };
  87     };
  88 }
  89
  90 1;
  91 __END__