File Coverage

blib/lib/Test/Environment/Plugin/PostgreSQL.pm
Criterion Covered Total %
statement 55 59 93.2
branch 24 36 66.6
condition 2 6 33.3
subroutine 10 10 100.0
pod 1 1 100.0
total 92 112 82.1


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