our
%Registered
;
sub
DateTime::Duration::TO_JSON {
my
$d
=
shift
;
return
DateTime::Format::Pg->format_duration(
$d
);
}
{
my
%connections
;
sub
dbi_connect {
my
$self
=
shift
;
my
$class
=
ref
$self
||
$self
;
$ENV
{PGTZ} =
"UTC"
;
$connections
{
$class
} ||= DBIx::Connector->new(
@_
);
$connections
{
$class
}->dbh->{pg_server_prepare} = 0;
return
$connections
{
$class
}->dbh;
}
}
sub
release_dbh {
return
0;
}
sub
register_databases {
my
$class
=
shift
;
my
%args
=
@_
;
my
$module_name
=
$args
{module_name} or
die
"no module name passed"
;
my
$conf
=
$args
{conf};
my
$register_params
=
$args
{register_params} || {};
my
$mbd
=
$ENV
{HARNESS_ACTIVE}
&& Module::Build::Database->can(
'current'
)
&& -d
'./_build'
? Module::Build::Database->current :
undef
;
my
$we_are_testing
= (
$mbd
&&
$mbd
->module_name eq
$module_name
);
my
$live_env_var
= (
uc
$module_name
) .
'_LIVE'
;
my
$we_are_live
=
$ENV
{
$live_env_var
} ? 1 : 0;
die
"no conf argument passed"
if
!
$conf
&& !
$we_are_testing
;
$Registered
{
$module_name
} = (
ref
$class
||
$class
);
my
%default
= (
type
=>
"main"
,
driver
=>
"Pg"
,
connect_options
=> {
PrintError
=> 1,
RaiseError
=> 0,
},
%$register_params
,
);
$class
->default_type(
"main"
);
if
(
$we_are_testing
) {
die
"ERROR: no test db instance found. Please run ./Build dbtest --leave-running=1\n\n "
unless
$mbd
->notes(
"dbtest_host"
) ||
$register_params
;
my
%opts
= %{
$mbd
->can(
'database_options'
) ?
$mbd
->database_options : {} };
if
(
$opts
{name}) {
$opts
{database} =
delete
$opts
{name};
};
$opts
{host} =
$mbd
->notes(
"dbtest_host"
)
if
$mbd
->notes(
"dbtest_host"
);
delete
$ENV
{PGPORT};
delete
$ENV
{PGUSER};
$class
->register_db(
%default
,
%opts
,
domain
=>
"test"
);
$class
->default_domain(
"test"
);
return
;
}
if
(
$conf
->db(
default
=>
''
)) {
my
$domain
=
$we_are_live
?
"live"
:
"dev"
;
eval
{
$class
->register_db(
%default
,
domain
=>
$domain
,
$conf
->db );
};
warn
"Error registering database : $@"
if
$@;
$class
->default_domain(
$domain
);
return
;
}
warn
"'db' may now be used instead of 'databases->dev' in the configuration file."
;
unless
(
$conf
->databases(
is_defined
=> 1)) {
warn
"No databases defined in configuration file."
;
$conf
->databases(
default
=> {});
}
warn
"No dev database was defined in the configuration file.\n"
unless
$conf
->databases->dev(
is_defined
=> 1);
$conf
->databases->dev(
default
=> {});
$class
->register_db(
%default
,
domain
=>
"dev"
,
$conf
->databases->dev )
if
$conf
->databases->dev(
is_defined
=> 1);
$class
->register_db(
%default
,
domain
=>
"live"
,
$conf
->databases->live )
if
$conf
->databases->live(
is_defined
=> 1);
$class
->default_domain(
$we_are_live
?
"live"
:
"dev"
);
}
sub
registered_by {
my
$class
=
shift
;
my
$module_name
=
shift
or
die
"missing required parameter module_name"
;
return
$Registered
{
$module_name
};
}
sub
load_golden {
my
$class
=
shift
;
LOGDIE
"Will not load golden dataset unless the database domain is test or dev"
unless
$class
->domain =~ /^(dev|test)$/;
INFO
"Loading golden dataset, domain : "
.
$class
->domain;
LOGDIE
"not yet implemented"
;
}
sub
has_primary_key {
my
$self
=
shift
;
my
$table
=
shift
;
return
1
if
$table
=~ /^v_/;
$self
->SUPER::has_primary_key(
$table
);
}
sub
do_sql {
my
$class
=
shift
;
my
$sql
=
shift
;
my
@bind
=
@_
;
my
$obj
= (
ref
$class
?
$class
:
$class
->new_or_cached);
my
$sth
=
$obj
->dbh->prepare(
$sql
);
$sth
->execute(
@bind
) or
die
$sth
->errstr;
my
$types
=
$sth
->{
'pg_type'
};
my
$names
=
$sth
->{
'NAME'
};
my
$res
=
$sth
->fetchall_arrayref({});
return
$res
unless
ref
$names
&&
ref
$types
;
my
%name2type
= mesh
@$names
,
@$types
;
return
$res
unless
grep
/int8/,
@$types
;
my
@nums
;
for
(
@$names
) {
push
@nums
,
$_
if
$name2type
{
$_
} eq
'int8'
;
}
for
my
$row
(
@$res
) {
for
my
$col
(
@nums
) {
next
unless
defined
(
$row
->{
$col
});
$row
->{
$col
} += 0;
}
}
return
$res
;
}
1;