File Coverage

File:	lib/OpenAPI/Backend/Pg.pm
Coverage:	76.8%

line	stmt	bran	cond	sub	pod	time	code
1							package OpenAPI::Backend::Pg;
2
3	23 23 23			23		185 65 216	use strict;
4	23 23 23			23		243 70 201	use warnings;
5	23 23 23			23		244 71 353	use DBI;
6	23 23 23			23		272 77 494	use SQL::Select;
7	23 23 23			23		275 73 219	use base 'OpenAPI::Backend::Base';
8	23 23 23			23		271 75 286	use Encode 'from_to';
9
10							our ($Host, $User, $Password, $Port, $Database);
11
12							sub new {
13	23			23	0	156	my $class = shift;
14	23		100			440	my $opts = shift \|\| {};
15
16	23	50	33			491	$Host \|\|= $OpenAPI::Config{'backend.host'} or
17							die "No backend.host specified in the config files.\n";
18	23	50	33			433	$User \|\|= $OpenAPI::Config{'backend.user'} or
19							die "No backend.user specified in the config files.\n";
20	23		0			284	$Password \|\|= $OpenAPI::Config{'backend.password'} \|\| '';
21	23		50			201	$Port \|\|= $OpenAPI::Config{'backend.port'};
22	23	50	33			408	$Database \|\|= $OpenAPI::Config{'backend.database'} or
23							die "No backend.database specified in the config files.\n";
24
25	23	50				727	my $dbh = DBI->connect(
26							"dbi:Pg:dbname=$Database;host=$Host".
27							($Port ? ";port=$Port" : ""),
28							$User, $Password,
29							{AutoCommit => 1, RaiseError => 1, pg_enable_utf8 => 1, %$opts}
30							);
31
32	23					1111	return bless {
33							dbh => $dbh
34							}, $class;
35							}
36
37							sub encode_string {
38	586			586	0	4443	my ($self, $str, $charset) = @_;
39	586					4893	from_to($str, 'UTF-8', $charset);
40	585					42102	$str;
41							}
42
43							sub select {
44	2362			2362	0	15246	my ($self, $sql, $opts) = @_;
45	2362		100			17773	$opts \|\|= {};
46	2362					13474	my $dbh = $self->{dbh};
47	2362	100				8812	return $dbh->selectall_arrayref(
48							$sql,
49							$opts->{use_hash} ? {Slice=>{}} : ()
50							);
51							}
52
53							sub do {
54	835			835	0	9289	my ($self, $sql) = @_;
55	835					1731632	$self->{dbh}->do($sql);
56							}
57
58							sub quote {
59	5169			5169	0	29910	my ($self, $val) = @_;
60	5169					110789	return $self->{dbh}->quote($val);
61							}
62
63							sub quote_identifier {
64	758			758	0	4435	my ($self, $val) = @_;
65	758					1822	return $self->{dbh}->quote_identifier($val);
66							}
67
68							sub last_insert_id {
69	40			40	0	261	my ($self, $table) = @_;
70							#die "Found table!!! $table";
71	40					370	my $res = $self->select("select max(id) from \"$table\"");
72	40 40	50	33			29571 572	if ($res && @$res) { return $res->[0][0]; }
73							}
74
75							sub has_user {
76	591			591	0	3689	my ($self, $user) = @_;
77	591					6898	my $select = SQL::Select->new('nspname')
78							->from('pg_namespace')
79							->where(nspname => $self->quote($user))
80							->limit(1);
81	591					2730	my $retval;
82	591					1950	eval {
83	591					1637	$retval = $self->do("$select");
84							};
85	591 0	50				5204 0	if ($@) { warn $@; }
86	591					2180	return $retval + 0;
87							}
88
89							sub set_user {
90	591			591	0	3668	my ($self, $user) = @_;
91	591					187570	$self->{dbh}->do("set search_path to $user");
92	591					5920	$self->{user} = $user;
93							}
94
95							sub add_user {
96	1			1	0	15	my $self = shift;
97	1					11	my $user = shift;
98	1					38	$self->do(<<"_EOC_");
99							create schema $user;
100							set search_path to $user;
101							_EOC_
102	1					58	$self->SUPER::add_user($user, @_);
103							}
104
105							sub drop_user {
106	1			1	0	9	my ($self, $user) = @_;
107	1					13	$self->do(<<"_EOC_");
108							drop schema $user cascade
109							_EOC_
110							}
111
112							1;
113