File Coverage

blib/lib/Test/Mojo/Pg.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Test::Mojo::Pg;
2 2     2   46666 use Mojo::Base -base;
  2         23978  
  2         18  
3 2     2   441 use File::Basename;
  2         5  
  2         204  
4 2     2   1564 use Mojo::Pg;
  0            
  0            
5             use Mojo::Pg::Migrations;
6              
7             our $VERSION = '0.33';
8              
9             has host => undef;
10             has port => undef;
11             has db => 'testdb';
12             has username => undef;
13             has password => undef;
14             has migsql => undef;
15             has verbose => 0;
16              
17             sub construct {
18             my ($self) = @_;
19             $self->drop_database;
20             $self->create_database;
21             }
22              
23             sub deconstruct {
24             my ($self) = @_;
25             $self->drop_database;
26             }
27              
28             sub get_version {
29             my ($self, $p) = @_;
30             my $q_v = 'SELECT version()';
31             my $q_sv = 'SHOW server_version';
32             my $q_svn = 'SHOW server_version_num';
33              
34             my $full_version = $p->db->query($q_v)->array->[0];
35             my $server_version = $p->db->query($q_sv)->array->[0];
36             my $server_version_num = $p->db->query($q_svn)->array->[0];
37             say '-> Pg full version is ' . $full_version
38             if $self->verbose;
39             say '-> Pg server_version is ' . $server_version
40             if $self->verbose;
41             say '-> Pg server_version_num is ' . $server_version_num
42             if $self->verbose;
43             return $server_version_num;
44             }
45              
46             sub connstring {
47             my ($self, $dbms) = @_;
48             my $prefix = 'postgresql://';
49             my $result = $prefix
50             . $self->_connstring_user
51             . $self->_connstring_server;
52             return $result if defined $dbms;
53              
54             $result .= '/' . $self->db;
55              
56             return $result;
57             }
58              
59             sub _connstring_server {
60             my ($self) = @_;
61             return $self->host . ':' . $self->port
62             if defined $self->host and defined $self->port;
63             return $self->host if defined $self->host;
64             return '';
65             }
66              
67             sub _connstring_user {
68             my ($self) = @_;
69             return $self->username . ':' . $self->password . '@'
70             if defined $self->username and defined $self->password;
71             return $self->username . '@' if defined $self->username;
72             return '';
73             }
74              
75             sub drop_database {
76             my ($self) = @_;
77             # Connect to the DBMS
78             my $c = $self->connstring(1);
79             say "Dropping database " . $self->db . " as $c" if $self->verbose;
80             my $p = Mojo::Pg->new($c);
81             $self->remove_connections($p);
82             $p->db->query('drop database if exists ' . $self->db . ';');
83             $p->db->disconnect;
84             }
85              
86             sub create_database {
87             my ($self) = @_;
88             my $c = $self->connstring(1);
89             say "Creating database defined as $c" if $self->verbose;
90             my $p = Mojo::Pg->new($c);
91             $p->db->query('create database '. $self->db .';');
92              
93             if (not defined $self->migsql) {
94             warn 'No migration script - empty database created.';
95             $p->db->disconnect;
96             return 1;
97             }
98              
99             my $db = Mojo::Pg->new($self->connstring);
100             my $migrations = Mojo::Pg::Migrations->new(pg => $db);
101             $migrations->from_file($self->migsql);
102             $migrations->migrate(0)->migrate;
103             $db->db->disconnect;
104             return 1;
105             }
106              
107             sub remove_connections {
108             my ($self, $p) = @_;
109             say 'Removing existing connections' if $self->verbose;
110             my $pf = $self->get_version($p) < 90200 ? 'procpid' : 'pid';
111             my $q = q|SELECT pg_terminate_backend(pg_stat_activity.| . $pf . q|) |
112             . q|FROM pg_stat_activity |
113             . q|WHERE pg_stat_activity.datname='| . $self->db . q|' |
114             . q|AND | . $pf . q| <> pg_backend_pid();|;
115             $p->db->query($q);
116             }
117              
118             =head1 NAME
119              
120             Test::Mojo::Pg - a helper for dealing with Pg during tests
121              
122             =head1 SYNOPSIS
123              
124             use Test::Mojo::Pg;
125             my $db;
126              
127             # Bring up database to prepare for tests
128             BEGIN {
129             $db = Test::Mojo::Pg->new(host => 'ananke', db => 'mydb'), 'Test::Mojo::Pg';
130             $db->construct;
131             }
132              
133             # Tear down the database to clean the environment
134             END {
135             $db->deconstruct;
136             }
137              
138             =head1 DESCRIPTION
139              
140             Test::Mojo::Pg makes the creation and removal of a transitory database during
141             testing when using Mojo::Pg. This is useful when every test should work from a 'clean' database.
142              
143             =head1 CONSTRUCTOR
144              
145             You can either pass options in when calling the constructor or set the attributes later.
146              
147             my $p1 = Test::Mojo::Pg->new();
148             my $p2 = Test::Mojo::Pg->new(host=>'myhost', db => 'db1');
149              
150             Option keys match the attribute names.
151              
152             =head1 ATTRIBUTES
153              
154             The following are the attributes for this module.
155              
156             =head2 host
157              
158             Sets the Postgres server hostname. If omitted, no hostname (or port, if defined)
159             will be configured for the connection string (which effectively means use localhost).
160              
161             =head2 port
162              
163             Sets the Postgres server port. If omitted, no port will be configured for the
164             connection string.
165              
166             =head2 db
167              
168             Sets the test database name.
169              
170             default: testdb
171              
172             =head2 username
173              
174             Sets the login username. If omitted, no username will be provided to the server.
175              
176             =head2 password
177              
178             Sets the login password. If omitted, no password will be provided to the server.
179              
180             =head2 migsql
181              
182             Sets the file to use for Mojo::Pg::Migrations. If no sql file is provided, a
183             warning will be emitted that only an empty database has been provided.
184              
185             =head2 verbose
186              
187             Enables verbose output of operations such as the server's version string.
188              
189             # get the verbose level - 0|1
190             $p->verbose;
191              
192             # set the verbose level to 'on'
193             $p->verbose(1);
194              
195              
196             =head1 METHODS
197              
198             The following are the methods for this module.
199              
200             =head2 connstring
201              
202             Returns the connection string for the database. Returns the connection string
203             for the dbms by passing in '1'.
204              
205             my $testdb_connstring = $testdb->connstring;
206              
207             my $testdb_dbms = $testdb->connstring(1);
208              
209             =head2 construct
210              
211             The construct method removes current connections to the database and
212             the database itself if it exists, creates a new database, and loads the
213             migrations file if it's defined. This normally gets called from the BEGIN block.
214              
215             $testdb->construct;
216              
217             =head2 deconstruct
218              
219             The deconstruct method removes current connections to the database and the
220             database itself if it exists. This normally gets called from the END block.
221              
222             $testdb->desconstruct;
223              
224             =head2 create_database
225              
226             Creates the database as defined by the connection string.
227              
228             $testdb->create_database;
229              
230             =head2 drop_database
231              
232             Drops the database as defined by the connection string.
233              
234             $testdb->drop_database;
235              
236             =head2 get_version
237              
238             my $version = $testdb->get_version;
239              
240             Retrieve the database version.
241              
242             =head2 remove_connections
243              
244             Force removal of connection related data in the dbms. Many times required in
245             order to drop the database.
246              
247             $testdb->remove_connections;
248              
249             =head1 AUTHORS
250              
251             Richard A. Elberger Eriche@cpan.orgE.
252              
253             =head1 MAINTAINERS
254              
255             =over 4
256              
257             =item Richard A. Elberger Eriche@cpan.orgE
258              
259             =back
260              
261             =head1 CONTRIBUTORS
262              
263             =over 4
264              
265             =item Vladimir N. Indik (vovka667@github)
266              
267             =back
268              
269             =head1 BUGS
270              
271             See F to report and view bugs.
272              
273              
274             =head1 SOURCE
275              
276             The source code repository for Test::More can be found at
277             F.
278              
279             =head1 COPYRIGHT
280              
281             Copyright 2015 by Richard A. Elberger Eriche@cpan.orgE.
282              
283             This program is free software; you can redistribute it and/or
284             modify it under the same terms as Perl itself.
285              
286             See F
287              
288             =cut
289              
290             1;