Commit | Line | Data |
5a70a6c0 |
1 | package # Hide from PAUSE |
2 | t::common; |
fde3db1a |
3 | |
2120a181 |
4 | use 5.006_000; |
fde3db1a |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
9 | our $VERSION = '0.01'; |
10 | |
11 | use base 'Exporter'; |
12 | our @EXPORT_OK = qw( |
2100f2ae |
13 | new_dbm |
fde3db1a |
14 | new_fh |
15 | ); |
16 | |
17 | use File::Spec (); |
18 | use File::Temp qw( tempfile tempdir ); |
19 | use Fcntl qw( :flock ); |
20 | |
21 | my $parent = $ENV{WORK_DIR} || File::Spec->tmpdir; |
22 | my $dir = tempdir( CLEANUP => 1, DIR => $parent ); |
5a70a6c0 |
23 | #my $dir = tempdir( DIR => '.' ); |
fde3db1a |
24 | |
25 | sub new_fh { |
45f047f8 |
26 | my ($fh, $filename) = tempfile( 'tmpXXXX', DIR => $dir, UNLINK => 1 ); |
fde3db1a |
27 | |
28 | # This is because tempfile() returns a flock'ed $fh on MacOSX. |
29 | flock $fh, LOCK_UN; |
30 | |
31 | return ($fh, $filename); |
32 | } |
e9b0b5f0 |
33 | |
2100f2ae |
34 | sub new_dbm { |
35 | my @args = @_; |
36 | my ($fh, $filename) = new_fh(); |
37 | my @extra_args = ( |
38 | [ file => $filename ], |
39 | ); |
40 | return sub { |
41 | return unless @extra_args; |
42 | my @these_args = @{ shift @extra_args }; |
43 | return sub { |
44 | DBM::Deep->new( |
45 | @these_args, @args, |
46 | ); |
47 | }; |
48 | }; |
49 | } |
50 | |
fde3db1a |
51 | 1; |
52 | __END__ |