File Coverage

blib/lib/DBIx/QuickDB.pm
Criterion Covered Total %
statement 35 80 43.7
branch 4 42 9.5
condition 2 16 12.5
subroutine 9 12 75.0
pod 2 2 100.0
total 52 152 34.2


line stmt bran cond sub pod time code
1             package DBIx::QuickDB;
2 20     20   1699994 use strict;
  20         32  
  20         644  
3 20     20   92 use warnings;
  20         34  
  20         1077  
4              
5             our $VERSION = '0.000040';
6              
7 20     20   103 use Carp;
  20         56  
  20         1300  
8 20     20   101 use List::Util qw/first/;
  20         30  
  20         1290  
9 20     20   10992 use File::Temp qw/tempdir/;
  20         253416  
  20         1739  
10 20     20   8767 use Module::Pluggable search_path => 'DBIx::QuickDB::Driver', max_depth => 4, require => 0;
  20         202304  
  20         140  
11              
12             my %CACHE;
13              
14 20     20   170960 END { local $?; %CACHE = () }
  20         131  
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 20     20   3800 no strict 'refs';
  20         41  
  20         15549  
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       0 $spec->{dir} = tempdir('DB-QUICK-XXXXXXXX', CLEANUP => 0, $ENV{QDB_TMPDIR} ? (DIR => $ENV{QDB_TMPDIR}) : (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 45     45 1 72 my $class = shift;
91 45         87 my ($d, $spec) = @_;
92              
93 45 100 66     284 $d = "DBIx::QuickDB::Driver::$d" unless $d =~ s/^\+// || $d =~ m/^DBIx::QuickDB::Driver::/;
94              
95 45         130 my $f = $d;
96 45         163 $f =~ s{::}{/}g;
97 45         73 $f .= ".pm";
98              
99 45         61 my ($v, $why);
100 45 100       64 if (eval { require $f }) {
  45         11062  
101 40         202 ($v, $why) = $d->viable($spec);
102             }
103             else {
104 5         20 ($v, $why) = (0, "Could not load $d: $@");
105             }
106              
107 45         180 return ($v, $d, $why);
108             }
109              
110             1;
111              
112             __END__