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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;
use Test::Fatal;
use DBIx::Introspector;
use DBI;
my $d = DBIx::Introspector->new(
drivers => [ map DBIx::Introspector::Driver->new($_),
{
name => 'DBI',
connected_determination_strategy => sub { $_[1]->{Driver}{Name} },
unconnected_determination_strategy => sub {
my $dsn = $_[1] || $ENV{DBI_DSN} || '';
my ($driver) = $dsn =~ /dbi:([^:]+):/i;
$driver ||= $ENV{DBI_DRIVER};
return $driver
},
},
{
name => 'SQLite',
parents => ['DBI'],
connected_determination_strategy => sub {
my ($v) = $_[1]->selectrow_array('SELECT "value" FROM "a"');
return "SQLite$v"
},
connected_options => {
bar => sub { 2 },
},
unconnected_options => {
borg => sub { 'magic ham' },
},
},
{ name => 'SQLite1', parents => ['SQLite'] },
{ name => 'SQLite2', parents => ['SQLite'] },
]
);
$d->add_driver({ name => 'SQLite3', parents => ['SQLite'] });
my $dbh = DBI->connect('dbi:SQLite::memory:');
$dbh->do($_) for (
'CREATE TABLE "a" ("value" NOT NULL)',
'INSERT INTO "a" ("value") VALUES (1)',
);
is($d->get($dbh, 'dbi:SQLite::memory:', '_introspector_driver'), 'SQLite1');
ok(exception { $d->get($dbh, 'dbi:SQLite::memory:', 'foo') }, 'unknown option dies');;
$d->replace_driver({
name => 'SQLite1',
parents => ['SQLite'],
connected_options => {
foo => sub { 'bar' },
},
});
is($d->get($dbh, 'dbi:SQLite::memory:', 'foo'), 'bar');
$dbh->do('UPDATE "a" SET "value" = 2');
is($d->get($dbh, 'dbi:SQLite::memory:', '_introspector_driver'), 'SQLite2');
is($d->get($dbh, 'dbi:SQLite::memory:', 'bar'), 2, 'oo dispatch');
is($d->get($dbh, 'dbi:SQLite::memory:', 'borg'), 'magic ham', 'working $dbh still dispatches to dsn');
done_testing;
|
