File: dbixcsl_test_dir.pm

package info (click to toggle)
libdbix-class-schema-loader-perl 0.07025-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 1,372 kB
  • sloc: perl: 12,002; makefile: 4
file content (49 lines) | stat: -rw-r--r-- 932 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
package dbixcsl_test_dir;

use strict;
use warnings;
use File::Path 'rmtree';
use Scalar::Util 'weaken';
use namespace::clean;
use DBI ();

our $tdir = 't/var';

use base qw/Exporter/;
our @EXPORT_OK = '$tdir';

die "/t does not exist, this can't be right...\n"
  unless -d 't';

unless (-d $tdir) {
  mkdir $tdir or die "Unable to create $tdir: $!\n";
}

# We need to disconnect all active DBI handles before deleting the directory,
# otherwise the SQLite .db files cannot be deleted on Win32 (file in use) since
# END does not run in any sort of order.

no warnings 'redefine';

my $connect = \&DBI::connect;

my @handles;

*DBI::connect = sub {
    my $dbh = $connect->(@_);
    push @handles, $dbh;
    weaken $handles[-1];
    return $dbh;
};

END {
    if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
        foreach my $dbh (@handles) {
            $dbh->disconnect if $dbh;
        }

        rmtree($tdir, 1, 1)
    }
}

1;