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
|
package DBConfig;
use DBI;
use Tangram qw(:core :compat_quiet);
local $/;
my $config = $ENV{TANGRAM_CONFIG} || 't/CONFIG';
open CONFIG, "$config"
or die "Cannot open $config, reason: $!";
my ($tx, $subsel, $ttype);
($cs, $user, $passwd, $tx, $subsel, $ttype)
= split "\n", <CONFIG>;
if ($tx =~ m/(\d)/) {
$no_tx = !$1;
}
if ($subsel =~ m/(\d)/) {
$no_subselects = !$1;
}
if ($ttype =~ m/table_type\s*=\s*(.*)/) {
$table_type = $1;
}
$vendor = (split ':', $cs)[1];;
$dialect = "Tangram::$vendor"; # deduce dialect from DBI driver
eval "use $dialect";
($dialect = 'Tangram::Relational'), eval("use $dialect") if $@;
print $Tangram::TRACE "Vendor driver $dialect not found - using ANSI SQL ($@)\n"
if $@ and $Tangram::TRACE;
if ($Tangram::TRACE) {
print $Tangram::TRACE "DBConfig.pm: dialect = $dialect, cparm = $cs, "
.($user ? "$user" : "(no user)").", "
.($passwd ? ("x" x (length $passwd)) : "(no passwd)")."\n";
}
our $AUTOLOAD;
sub AUTOLOAD {
shift if UNIVERSAL::isa($_[0], __PACKAGE__);
$AUTOLOAD =~ s{.*::}{};
return $$AUTOLOAD;
}
sub cparm {
return ($cs, $user, $passwd);
}
sub setup {
my $class = shift if UNIVERSAL::isa($_[0], __PACKAGE__);
$class ||= __PACKAGE__;
my $schema = shift;
my ($dsn, $u, $p) = $class->cparm;
my $dbh = DBI->connect($dsn, $u, $p);
eval {
local $dbh->{RaiseError};
local $dbh->{PrintError};
Tangram::Relational->retreat($schema, $dbh);
};
Tangram::Relational->deploy($schema, $dbh);
}
1;
|
