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(); |
350896ee |
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 | } |
d426259c |
42 | |
43 | # eval { require DBD::SQLite; }; |
44 | # unless ( $@ ) { |
45 | # push @extra_args, [ |
46 | # ]; |
47 | # } |
48 | |
49 | if ( $ENV{TEST_MYSQL_DSN} ) { |
350896ee |
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 | }; |
d426259c |
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 | |
2100f2ae |
76 | return sub { |
77 | return unless @extra_args; |
78 | my @these_args = @{ shift @extra_args }; |
350896ee |
79 | if ( my $reset = shift @reset_funcs ) { |
80 | $reset->(); |
81 | } |
2100f2ae |
82 | return sub { |
83 | DBM::Deep->new( |
0e3e3555 |
84 | @these_args, @args, @_, |
2100f2ae |
85 | ); |
86 | }; |
87 | }; |
88 | } |
89 | |
fde3db1a |
90 | 1; |
91 | __END__ |