1package DBIx::QuickDB::Driver::PostgreSQL;
2use strict;
3use warnings;
4
5our $VERSION = '0.000021';
6
7use IPC::Cmd qw/can_run/;
8use DBIx::QuickDB::Util qw/strip_hash_defaults/;
9use Time::HiRes qw/sleep/;
10use Scalar::Util qw/reftype/;
11
12use parent 'DBIx::QuickDB::Driver';
13
14use DBIx::QuickDB::Util::HashBase qw{
15    -data_dir
16
17    -initdb -createdb -postgres -psql
18
19    -config
20    -socket
21    -port
22};
23
24my ($INITDB, $CREATEDB, $POSTGRES, $PSQL, $DBDPG);
25
26BEGIN {
27    local $@;
28
29    $INITDB   = can_run('initdb');
30    $CREATEDB = can_run('createdb');
31    $POSTGRES = can_run('postgres');
32    $PSQL     = can_run('psql');
33    $DBDPG    = eval { require DBD::Pg; 'DBD::Pg'};
34}
35
36sub version_string {
37    my $binary;
38
39    # Go in reverse order assuming the last param hash provided is most important
40    for my $arg (reverse @_) {
41        my $type = reftype($arg) or next;    # skip if not a ref
42        next if $type eq 'HASH';             # We have a hashref, possibly blessed
43
44        # If we find a launcher we are done looping, we want to use this binary.
45        $binary = $arg->{+POSTGRES} and last;
46    }
47
48    # If no args provided one to use we fallback to the default from $PATH
49    $binary ||= $POSTGRES;
50
51    # Call the binary with '-V', capturing and returning the output using backticks.
52    return `$binary -V`;
53}
54
55sub list_env_vars {
56    my $self = shift;
57    return (
58        $self->SUPER::list_env_vars(),
59        qw{
60            PGAPPNAME PGCLIENTENCODING PGCONNECT_TIMEOUT PGDATABASE PGDATESTYLE
61            PGGEQO PGGSSLIB PGHOST PGHOSTADDR PGKRBSRVNAME PGLOCALEDIR
62            PGOPTIONS PGPASSFILE PGPASSWORD PGPORT PGREQUIREPEER PGREQUIRESSL
63            PGSERVICE PGSERVICEFILE PGSSLCERT PGSSLCOMPRESSION PGSSLCRL
64            PGSSLKEY PGSSLMODE PGSSLROOTCERT PGSYSCONFDIR PGTARGETSESSIONATTRS
65            PGTZ PGUSER
66        }
67    );
68}
69
70sub _default_paths {
71    return (
72        initdb   => $INITDB,
73        createdb => $CREATEDB,
74        postgres => $POSTGRES,
75        psql     => $PSQL,
76    );
77}
78
79sub _default_config {
80    my $self = shift;
81
82    return (
83        datestyle                  => "'iso, mdy'",
84        default_text_search_config => "'pg_catalog.english'",
85        lc_messages                => "'en_US.UTF-8'",
86        lc_monetary                => "'en_US.UTF-8'",
87        lc_numeric                 => "'en_US.UTF-8'",
88        lc_time                    => "'en_US.UTF-8'",
89        listen_addresses           => "''",
90        max_connections            => "100",
91        shared_buffers             => "128MB",
92        unix_socket_directories    => "'$self->{+DIR}'",
93        port                       => $self->{+PORT},
94
95        #dynamic_shared_memory_type => "posix",
96        #log_timezone               => "'US/Pacific'",
97        #timezone                   => "'US/Pacific'",
98    );
99}
100
101sub viable {
102    my $this = shift;
103    my ($spec) = @_;
104
105    my %check = (ref($this) ? %$this : (), $this->_default_paths, %$spec);
106
107    my @bad;
108
109    push @bad => "'DBD::Pg' module could not be loaded, needed for everything" unless $DBDPG;
110
111    if ($spec->{bootstrap}) {
112        push @bad => "'initdb' command is missing, needed for bootstrap"   unless $check{initdb}   && -x $check{initdb};
113        push @bad => "'createdb' command is missing, needed for bootstrap" unless $check{createdb} && -x $check{createdb};
114    }
115
116    if ($spec->{autostart}) {
117        push @bad => "'postgres' command is missing, needed for autostart" unless $check{postgres} && -x $check{postgres};
118    }
119
120    if ($spec->{load_sql}) {
121        push @bad => "'psql' command is missing, needed for load_sql" unless $check{psql} && -x $check{psql};
122    }
123
124    return (1, undef) unless @bad;
125    return (0, join "\n" => @bad);
126}
127
128sub init {
129    my $self = shift;
130    $self->SUPER::init();
131
132    my $port = $self->{+PORT} ||= '5432';
133
134    my $dir = $self->{+DIR};
135    $self->{+DATA_DIR} = "$dir/data";
136    $self->{+SOCKET} ||= "$dir/.s.PGSQL.$port";
137
138    $self->{+ENV_VARS} ||= {};
139    $self->{+ENV_VARS}->{PGPORT} = $port unless defined $self->{+ENV_VARS}->{PGPORT};
140
141    my %defaults = $self->_default_paths;
142    $self->{$_} ||= $defaults{$_} for keys %defaults;
143
144    my %cfg_defs = $self->_default_config;
145    my $cfg = $self->{+CONFIG} ||= {};
146
147    for my $key (keys %cfg_defs) {
148        next if defined $cfg->{$key};
149        $cfg->{$key} = $cfg_defs{$key};
150    }
151}
152
153sub clone_data {
154    my $self = shift;
155
156    my $vars = $self->env_vars || {};
157    delete $vars->{PGPORT} if $vars->{PGPORT} && $vars->{PGPORT} eq $self->port;
158
159    my $config = strip_hash_defaults(
160        $self->{+CONFIG},
161        { $self->_default_config },
162    );
163
164    return (
165        $self->SUPER::clone_data(),
166        ENV_VARS() => $vars,
167        CONFIG()   => $config,
168    );
169}
170
171sub write_config {
172    my $self = shift;
173
174    my $db_dir = $self->{+DATA_DIR};
175    open(my $cf, '>', "$db_dir/postgresql.conf") or die "Could not open config file: $!";
176    for my $key (sort keys %{$self->{+CONFIG}}) {
177        my $val = $self->{+CONFIG}->{$key};
178        next unless length($val);
179
180        print $cf "$key = $val\n";
181    }
182    close($cf);
183}
184
185sub bootstrap {
186    my $self = shift;
187
188    my $dir = $self->{+DIR};
189    my $db_dir = $self->{+DATA_DIR};
190    mkdir($db_dir) or die "Could not create data dir: $!";
191    $self->run_command([$self->{+INITDB}, '-E', 'UTF8', '-D', $db_dir]);
192
193    $self->write_config;
194    $self->start;
195
196    for my $try (1 .. 10) {
197        my ($ok, $err);
198        {
199            local $@;
200            $ok = eval {
201                $self->catch_startup(sub {
202                    $self->run_command([$self->{+CREATEDB}, '-T', 'template0', '-E', 'UTF8', '-h', $dir, 'quickdb']);
203                });
204
205                1;
206            };
207            $err = $@;
208        }
209
210        last if $ok;
211
212        die $@ if $try == 5;
213
214        sleep 0.5;
215    }
216
217    $self->stop unless $self->{+AUTOSTART};
218
219    return;
220}
221
222sub connect {
223    my $self = shift;
224    my ($db_name, %params) = @_;
225
226    my $dbh;
227    $self->catch_startup(sub {
228        $dbh = $self->SUPER::connect($db_name, %params);
229    });
230
231    return $dbh;
232}
233
234sub connect_string {
235    my $self = shift;
236    my ($db_name) = @_;
237    $db_name = 'quickdb' unless defined $db_name;
238
239    my $dir = $self->{+DIR};
240
241    require DBD::Pg;
242    return "dbi:Pg:dbname=$db_name;host=$dir"
243}
244
245sub load_sql {
246    my $self = shift;
247    my ($dbname, $file) = @_;
248
249    my $dir = $self->{+DIR};
250
251    $self->catch_startup(sub {
252        $self->run_command([
253            $self->{+PSQL},
254            '-h' => $dir,
255            '-v' => 'ON_ERROR_STOP=1',
256            '-f' => $file,
257            $dbname,
258        ]);
259    });
260}
261
262sub shell_command {
263    my $self = shift;
264    my ($db_name) = @_;
265
266    return ($self->{+PSQL}, '-h' => $self->{+DIR}, $db_name);
267}
268
269sub start_command {
270    my $self = shift;
271    return ($self->{+POSTGRES}, '-D' => $self->{+DATA_DIR}, '-p' => $self->{+PORT});
272}
273
274sub catch_startup {
275    my $self = shift;
276    my ($code) = @_;
277
278    my $start = time;
279    while (1) {
280        my $waited = time - $start;
281        die "Timeout waiting for server" if $waited > 10;
282
283        my ($ok, $err, $out);
284        {
285            local $@;
286            $ok = eval {
287                $out = $code->($self);
288                1;
289            };
290
291            $err = $@;
292        }
293
294        return $out if $ok;
295
296        die $err unless $err =~ m/the database system is starting up/;
297
298        sleep 0.01;
299    }
300}
301
3021;
303
304__END__
305
306=pod
307
308=encoding UTF-8
309
310=head1 NAME
311
312DBIx::QuickDB::Driver::PostgreSQL - PostgreSQL driver for DBIx::QuickDB.
313
314=head1 DESCRIPTION
315
316PostgreSQL driver for L<DBIx::QuickDB>.
317
318=head1 SYNOPSIS
319
320See L<DBIx::QuickDB>.
321
322=head1 SOURCE
323
324The source code repository for DBIx-QuickDB can be found at
325F<https://github.com/exodist/DBIx-QuickDB/>.
326
327=head1 MAINTAINERS
328
329=over 4
330
331=item Chad Granum E<lt>exodist@cpan.orgE<gt>
332
333=back
334
335=head1 AUTHORS
336
337=over 4
338
339=item Chad Granum E<lt>exodist@cpan.orgE<gt>
340
341=back
342
343=head1 COPYRIGHT
344
345Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>.
346
347This program is free software; you can redistribute it and/or
348modify it under the same terms as Perl itself.
349
350See F<http://dev.perl.org/licenses/>
351
352=cut
353