Commit | Line | Data |
5a70a6c0 |
1 | package # Hide from PAUSE |
2 | t::common; |
fde3db1a |
3 | |
fde3db1a |
4 | use strict; |
d426259c |
5 | use warnings FATAL => 'all'; |
fde3db1a |
6 | |
7 | use base 'Exporter'; |
8 | our @EXPORT_OK = qw( |
2100f2ae |
9 | new_dbm |
fde3db1a |
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 { |
45f047f8 |
21 | my ($fh, $filename) = tempfile( 'tmpXXXX', DIR => $dir, UNLINK => 1 ); |
fde3db1a |
22 | |
23 | # This is because tempfile() returns a flock'ed $fh on MacOSX. |
24 | flock $fh, LOCK_UN; |
25 | |
26 | return ($fh, $filename); |
27 | } |
e9b0b5f0 |
28 | |
2100f2ae |
29 | sub new_dbm { |
30 | my @args = @_; |
31 | my ($fh, $filename) = new_fh(); |
32 | my @extra_args = ( |
33 | [ file => $filename ], |
34 | ); |
d426259c |
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 | |
2100f2ae |
52 | return sub { |
53 | return unless @extra_args; |
54 | my @these_args = @{ shift @extra_args }; |
55 | return sub { |
56 | DBM::Deep->new( |
0e3e3555 |
57 | @these_args, @args, @_, |
2100f2ae |
58 | ); |
59 | }; |
60 | }; |
61 | } |
62 | |
fde3db1a |
63 | 1; |
64 | __END__ |