line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Environment::Plugin::PostgreSQL; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Test::Environment::Plugin::PostgreSQL - PostreSQL psql function for testing |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 SYNOPSIS |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use Test::Environment qw{ |
10
|
|
|
|
|
|
|
PostgreSQL |
11
|
|
|
|
|
|
|
}; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# set database credentials |
14
|
|
|
|
|
|
|
psql( |
15
|
|
|
|
|
|
|
'database' => $config->{'db'}->{'database'}, |
16
|
|
|
|
|
|
|
'hostname' => $config->{'db'}->{'hostname'}, |
17
|
|
|
|
|
|
|
'username' => $config->{'db'}->{'username'}, |
18
|
|
|
|
|
|
|
'password' => $config->{'db'}->{'password'}, |
19
|
|
|
|
|
|
|
# or skip hostname and database and set them via |
20
|
|
|
|
|
|
|
#'dbi_dsn' => 'dbi:Pg:dbname=dsn_test;host=localhost', |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# execute sql query |
25
|
|
|
|
|
|
|
my @output = psql( |
26
|
|
|
|
|
|
|
'switches' => '--expanded', |
27
|
|
|
|
|
|
|
'command' => 'SELECT * FROM Table', |
28
|
|
|
|
|
|
|
# ..., see psql function description for more |
29
|
|
|
|
|
|
|
) |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 DESCRIPTION |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
This plugin will export 'psql' function that can be used to execute PostreSQL psql command |
35
|
|
|
|
|
|
|
with lot of options for testing. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Module will prepare %ENV for postgres: |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
'username' => 'PGUSER', |
40
|
|
|
|
|
|
|
'password' => 'PGPASSWORD', |
41
|
|
|
|
|
|
|
'database' => 'PGDATABASE', |
42
|
|
|
|
|
|
|
'hostname' => 'PGHOST', |
43
|
|
|
|
|
|
|
'port' => 'PGPORT', |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Any postgres connection settings not listed or undef will be deleted from the %ENV hash. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=cut |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
|
50
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
30
|
|
51
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
39
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
our $VERSION = "0.07"; |
54
|
|
|
|
|
|
|
|
55
|
1
|
|
|
1
|
|
5
|
use base qw{ Exporter }; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
135
|
|
56
|
|
|
|
|
|
|
our @EXPORT = qw{ |
57
|
|
|
|
|
|
|
psql |
58
|
|
|
|
|
|
|
}; |
59
|
|
|
|
|
|
|
our $debug = 0; |
60
|
|
|
|
|
|
|
|
61
|
1
|
|
|
1
|
|
13
|
use Carp::Clan; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
62
|
1
|
|
|
1
|
|
795
|
use String::ShellQuote; |
|
1
|
|
|
|
|
731
|
|
|
1
|
|
|
|
|
56
|
|
63
|
1
|
|
|
1
|
|
735
|
use List::MoreUtils 'any'; |
|
1
|
|
|
|
|
10905
|
|
|
1
|
|
|
|
|
7
|
|
64
|
1
|
|
|
1
|
|
2792
|
use DBI; |
|
1
|
|
|
|
|
62803
|
|
|
1
|
|
|
|
|
953
|
|
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head1 FUNCTIONS |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head2 import |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
All functions are exported 2 levels up. That is to the use Test::Environment caller. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=cut |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub import { |
75
|
1
|
|
|
1
|
|
3
|
my $package = shift; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# export symbols two levels up - to the Test::Environment caller |
78
|
1
|
|
|
|
|
173
|
__PACKAGE__->export_to_level(2, $package, @EXPORT); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head2 psql() |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
psql command executed easily. Here is the list of options that can be used. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Option related to the connection to the database. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
username |
89
|
|
|
|
|
|
|
password |
90
|
|
|
|
|
|
|
database |
91
|
|
|
|
|
|
|
hostname |
92
|
|
|
|
|
|
|
port |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
By setting this PostreSQL %ENV variables will be set. So for psql command to the |
95
|
|
|
|
|
|
|
same databse you need to set them only once. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
The rest of the option related to the psql command. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
command - scalar or array ref of sql commands |
100
|
|
|
|
|
|
|
switches - scalar or array of additional psql switches |
101
|
|
|
|
|
|
|
output_filename - the output will be written to this file (-o) |
102
|
|
|
|
|
|
|
execution_path - before executing psql change to that folder |
103
|
|
|
|
|
|
|
stderr_redirect - will redirect stderr to stdout so that also error appears in the return value |
104
|
|
|
|
|
|
|
debug - turn on debug mode, it can be also done globaly by setting "$ENV{'IN_DEBUG_MODE'} = 1" |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=cut |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub psql { |
109
|
5
|
|
|
5
|
1
|
15744
|
my %arg = @_; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# deparse dbi_dsn if passed |
112
|
5
|
100
|
|
|
|
26
|
if (defined $arg{'dbi_dsn'}) { |
113
|
|
|
|
|
|
|
my($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) |
114
|
2
|
|
|
|
|
39
|
= DBI->parse_dsn($arg{'dbi_dsn'}); |
115
|
|
|
|
|
|
|
|
116
|
2
|
50
|
33
|
|
|
88
|
croak 'not a Pg dbi dsn "'.$arg{'dbi_dsn'}.'"' |
117
|
|
|
|
|
|
|
if (($scheme ne 'dbi') or ($driver ne 'Pg')); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# contruct hash out of "dbname=dsn_test;host=localhost;port=123" |
120
|
2
|
|
|
|
|
10
|
my %dsn_options = map { split '=', $_ } split(';',$driver_dsn); |
|
5
|
|
|
|
|
33
|
|
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
$arg{'database'} = $dsn_options{'dbname'} |
123
|
2
|
50
|
|
|
|
39
|
if exists $dsn_options{'dbname'}; |
124
|
|
|
|
|
|
|
$arg{'hostname'} = $dsn_options{'host'} |
125
|
2
|
50
|
|
|
|
11
|
if exists $dsn_options{'host'}; |
126
|
|
|
|
|
|
|
$arg{'port'} = $dsn_options{'port'} |
127
|
2
|
100
|
|
|
|
12
|
if exists $dsn_options{'port'}; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
5
|
|
|
|
|
29
|
my %pg_settings_names = ( |
131
|
|
|
|
|
|
|
'username' => 'PGUSER', |
132
|
|
|
|
|
|
|
'password' => 'PGPASSWORD', |
133
|
|
|
|
|
|
|
'database' => 'PGDATABASE', |
134
|
|
|
|
|
|
|
'hostname' => 'PGHOST', |
135
|
|
|
|
|
|
|
'port' => 'PGPORT', |
136
|
|
|
|
|
|
|
); |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# change %ENV only if at least one pg connection setting set |
139
|
5
|
100
|
|
9
|
|
76
|
if (any { $pg_settings_names{$_} } keys %arg) { |
|
9
|
|
|
|
|
32
|
|
140
|
|
|
|
|
|
|
# set/delete postgres ENV variables |
141
|
4
|
|
|
|
|
17
|
foreach my $arg_name (keys %pg_settings_names) { |
142
|
20
|
|
|
|
|
34
|
my $env_name = $pg_settings_names{$arg_name}; |
143
|
|
|
|
|
|
|
( defined $arg{$arg_name} |
144
|
|
|
|
|
|
|
? $ENV{$env_name} = $arg{$arg_name} |
145
|
20
|
100
|
|
|
|
213
|
: delete $ENV{$env_name} |
146
|
|
|
|
|
|
|
); |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# function paramaters |
151
|
5
|
|
|
|
|
26
|
my $command = $arg{'command'}; |
152
|
5
|
|
|
|
|
10
|
my $output_filename = $arg{'output_filename'}; |
153
|
5
|
|
|
|
|
11
|
my $execution_path = $arg{'execution_path'}; |
154
|
5
|
|
|
|
|
10
|
my $stderr_redirect = $arg{'stderr_redirect'}; |
155
|
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
0
|
my @switches = (ref $arg{'switches'} eq 'ARRAY' ? @{$arg{'switches'}} : $arg{'switches'} ) |
157
|
5
|
50
|
|
|
|
19
|
if exists $arg{'switches'}; |
|
|
100
|
|
|
|
|
|
158
|
|
|
|
|
|
|
|
159
|
5
|
50
|
33
|
|
|
30
|
local $debug = 1 if ($arg{'debug'} or $ENV{'IN_DEBUG_MODE'}); |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# if there is no command return nothink to do more |
162
|
5
|
100
|
|
|
|
29
|
return if not defined $command; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# if more commands then join them together |
165
|
1
|
50
|
|
|
|
4
|
if (ref $command eq 'ARRAY') { |
166
|
0
|
|
|
|
|
0
|
$command = join '; ', @{$command}; |
|
0
|
|
|
|
|
0
|
|
167
|
|
|
|
|
|
|
} |
168
|
1
|
50
|
|
|
|
5
|
$command .= ';' if ($command !~ m{;\s*$}xms); |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
|
171
|
1
|
50
|
|
|
|
3
|
if (defined $output_filename) { |
172
|
1
|
|
|
|
|
4
|
push(@switches, '-o', '"'.$output_filename.'"') |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# redirect stderr to stdout |
176
|
1
|
50
|
|
|
|
2
|
open(STDERR, ">&STDOUT") if (defined $stderr_redirect); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# chdir if needed |
179
|
1
|
50
|
|
|
|
4
|
if (defined $execution_path) { |
180
|
1
|
50
|
|
|
|
3
|
print STDERR '+ cd ', $execution_path, "\n" if $debug; |
181
|
1
|
|
|
|
|
29
|
chdir($execution_path); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
1
|
|
|
|
|
7
|
my @ret = execute( |
185
|
|
|
|
|
|
|
'psql', |
186
|
|
|
|
|
|
|
@switches, |
187
|
|
|
|
|
|
|
'-c', |
188
|
|
|
|
|
|
|
$command, |
189
|
|
|
|
|
|
|
); |
190
|
|
|
|
|
|
|
|
191
|
1
|
50
|
|
|
|
146
|
return @ret if defined wantarray; |
192
|
0
|
|
|
|
|
|
return join('', @ret); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=head2 execute |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Executes command as system and return output. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
In debug mode prints command to stderr. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=cut |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub execute { |
205
|
|
|
|
|
|
|
my $cmd = shell_quote @_; |
206
|
|
|
|
|
|
|
print STDERR '+ ', $cmd, "\n" if $debug; |
207
|
|
|
|
|
|
|
my @ret = `$cmd`; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
1; |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head1 SEE ALSO |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
Test::Environment L |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=head1 AUTHOR |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Jozef Kutej - Ejozef@kutej.netE |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=cut |