line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::QuickDB; |
2
|
9
|
|
|
9
|
|
231433
|
use strict; |
|
9
|
|
|
|
|
24
|
|
|
9
|
|
|
|
|
265
|
|
3
|
9
|
|
|
9
|
|
47
|
use warnings; |
|
9
|
|
|
|
|
17
|
|
|
9
|
|
|
|
|
322
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.000021'; |
6
|
|
|
|
|
|
|
|
7
|
9
|
|
|
9
|
|
43
|
use Carp; |
|
9
|
|
|
|
|
33
|
|
|
9
|
|
|
|
|
519
|
|
8
|
9
|
|
|
9
|
|
87
|
use List::Util qw/first/; |
|
9
|
|
|
|
|
17
|
|
|
9
|
|
|
|
|
577
|
|
9
|
9
|
|
|
9
|
|
5638
|
use File::Temp qw/tempdir/; |
|
9
|
|
|
|
|
140568
|
|
|
9
|
|
|
|
|
596
|
|
10
|
9
|
|
|
9
|
|
4656
|
use Module::Pluggable search_path => 'DBIx::QuickDB::Driver', max_depth => 4, require => 0; |
|
9
|
|
|
|
|
102483
|
|
|
9
|
|
|
|
|
68
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my %CACHE; |
13
|
|
|
|
|
|
|
|
14
|
9
|
|
|
9
|
|
8813
|
END { local $?; %CACHE = () } |
|
9
|
|
|
|
|
69
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub import { |
17
|
0
|
|
|
0
|
|
0
|
my $class = shift; |
18
|
0
|
|
|
|
|
0
|
my ($name, @args) = @_; |
19
|
|
|
|
|
|
|
|
20
|
0
|
0
|
|
|
|
0
|
return unless defined $name; |
21
|
|
|
|
|
|
|
|
22
|
0
|
0
|
|
|
|
0
|
my $spec = @args > 1 ? {@args} : $args[0]; |
23
|
|
|
|
|
|
|
|
24
|
0
|
|
|
|
|
0
|
my $db = $class->build_db($name, $spec); |
25
|
|
|
|
|
|
|
|
26
|
0
|
|
|
|
|
0
|
my $caller = caller; |
27
|
9
|
|
|
9
|
|
1616
|
no strict 'refs'; |
|
9
|
|
|
|
|
23
|
|
|
9
|
|
|
|
|
6203
|
|
28
|
0
|
|
|
0
|
|
0
|
*{"$caller\::$name"} = sub() { $db }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub build_db { |
32
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
33
|
0
|
0
|
|
|
|
0
|
my $name = ref($_[0]) ? undef : shift(@_); |
34
|
0
|
|
0
|
|
|
0
|
my $spec = shift(@_) || {}; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
return $CACHE{$name}->{inst} |
37
|
0
|
0
|
0
|
|
|
0
|
if $name && $CACHE{$name} && !$spec->{nocache}; |
|
|
|
0
|
|
|
|
|
38
|
|
|
|
|
|
|
|
39
|
0
|
0
|
|
|
|
0
|
unless ($spec->{dir}) { |
40
|
0
|
|
|
|
|
0
|
$spec->{dir} = tempdir('DB-QUICK-XXXXXXXX', CLEANUP => 0, TMPDIR => 1); |
41
|
0
|
0
|
|
|
|
0
|
$spec->{cleanup} = 1 unless defined $spec->{cleanup}; |
42
|
0
|
0
|
|
|
|
0
|
$spec->{bootstrap} = 1 unless defined $spec->{bootstrap}; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
0
|
0
|
|
|
|
0
|
$spec->{autostart} = 1 unless defined $spec->{autostart}; |
46
|
0
|
0
|
|
|
|
0
|
$spec->{autostop} = $spec->{autostart} unless defined $spec->{autostop}; |
47
|
|
|
|
|
|
|
|
48
|
0
|
|
|
|
|
0
|
my $driver; |
49
|
0
|
0
|
0
|
|
|
0
|
my $drivers = $spec->{driver} ? [$spec->{driver}] : delete $spec->{drivers} || [$class->plugins]; |
50
|
0
|
|
|
|
|
0
|
my %nope; |
51
|
0
|
|
|
|
|
0
|
for my $d (@$drivers) { |
52
|
0
|
|
|
|
|
0
|
my ($v, $fqn, $why) = $class->check_driver($d, $spec); |
53
|
0
|
0
|
|
|
|
0
|
if ($v) { |
54
|
0
|
|
|
|
|
0
|
$driver = $fqn; |
55
|
0
|
|
|
|
|
0
|
last; |
56
|
|
|
|
|
|
|
} |
57
|
0
|
|
|
|
|
0
|
$nope{$d} = $why; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
0
|
unless ($driver) { |
61
|
0
|
|
|
|
|
0
|
my @err = "== Could not find a viable driver from the following =="; |
62
|
0
|
|
|
|
|
0
|
for my $d (keys %nope) { |
63
|
0
|
|
|
|
|
0
|
push @err => "\n=== $d ===", $nope{$d}; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
|
|
0
|
confess join "\n" => @err, "", "====================", "", "Aborting"; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
0
|
|
|
|
|
0
|
my $inst = $driver->new(%$spec); |
70
|
|
|
|
|
|
|
|
71
|
0
|
0
|
0
|
|
|
0
|
$CACHE{$name} = {spec => $spec, inst => $inst} if $name && !$spec->{nocache}; |
72
|
|
|
|
|
|
|
|
73
|
0
|
0
|
|
|
|
0
|
$inst->bootstrap if $spec->{bootstrap}; |
74
|
0
|
0
|
|
|
|
0
|
$inst->start if $spec->{autostart}; |
75
|
|
|
|
|
|
|
|
76
|
0
|
0
|
|
|
|
0
|
if (my $sql = $spec->{load_sql}) { |
77
|
0
|
0
|
|
|
|
0
|
$sql = $sql->{$driver->name} if ref($sql) eq 'HASH'; |
78
|
0
|
0
|
|
|
|
0
|
$sql = [$sql] unless ref($sql) eq 'ARRAY'; |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
0
|
for (my $i = 0; $i < @$sql; $i += 2) { |
81
|
0
|
|
|
|
|
0
|
my ($db, $file) = @{$sql}[$i, $i + 1]; |
|
0
|
|
|
|
|
0
|
|
82
|
0
|
|
|
|
|
0
|
$inst->load_sql($db => $file); |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
0
|
|
|
|
|
0
|
return $inst; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub check_driver { |
90
|
24
|
|
|
24
|
1
|
52
|
my $class = shift; |
91
|
24
|
|
|
|
|
62
|
my ($d, $spec) = @_; |
92
|
|
|
|
|
|
|
|
93
|
24
|
100
|
66
|
|
|
204
|
$d = "DBIx::QuickDB::Driver::$d" unless $d =~ s/^\+// || $d =~ m/^DBIx::QuickDB::Driver::/; |
94
|
|
|
|
|
|
|
|
95
|
24
|
|
|
|
|
57
|
my $f = $d; |
96
|
24
|
|
|
|
|
118
|
$f =~ s{::}{/}g; |
97
|
24
|
|
|
|
|
54
|
$f .= ".pm"; |
98
|
|
|
|
|
|
|
|
99
|
24
|
|
|
|
|
46
|
my ($v, $why); |
100
|
24
|
100
|
|
|
|
45
|
if (eval { require $f }) { |
|
24
|
|
|
|
|
7628
|
|
101
|
20
|
|
|
|
|
125
|
($v, $why) = $d->viable($spec); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
else { |
104
|
4
|
|
|
|
|
22
|
($v, $why) = (0, "Could not load $d: $@"); |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
24
|
|
|
|
|
136
|
return ($v, $d, $why); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
1; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
__END__ |