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