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