cache.diff

diff --git a/Changes b/Changes
index b015449..a86f24e 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,5 @@

-3.07  2017-06-02
+4.0  2017-07-06

 3.06  2017-06-01
   - Updated example application with tests.
diff --git a/lib/Mojo/Pg.pm b/lib/Mojo/Pg.pm
index 7c94ebf..ec1528c 100644
--- a/lib/Mojo/Pg.pm
+++ b/lib/Mojo/Pg.pm
@@ -7,13 +7,13 @@ use Mojo::Pg::Database;
 use Mojo::Pg::Migrations;
 use Mojo::Pg::PubSub;
 use Mojo::URL;
-use Scalar::Util 'weaken';
+use Scalar::Util qw(blessed weaken);
 use SQL::Abstract;

 has abstract => sub {
   SQL::Abstract->new(array_datatypes => 1, name_sep => '.', quote_char => '"');
 };
-has [qw(auto_migrate search_path)];
+has [qw(auto_migrate parent search_path)];
 has database_class  => 'Mojo::Pg::Database';
 has dsn             => 'dbi:Pg:';
 has max_connections => 5;
@@ -38,15 +38,18 @@ has pubsub => sub {
   return $pubsub;
 };

-our $VERSION = '3.07';
+our $VERSION = '4.0';

-sub db { $_[0]->database_class->new(dbh => $_[0]->_dequeue, pg => $_[0]) }
+sub db { $_[0]->database_class->new(dbh => $_[0]->_prepare, pg => $_[0]) }

 sub from_string {
   my ($self, $str) = @_;

-  # Protocol
+  # Parent
   return $self unless $str;
+  return $self->parent($str) if blessed $str && $str->isa('Mojo::Pg');
+
+  # Protocol
   my $url = Mojo::URL->new($str);
   croak qq{Invalid PostgreSQL connection string "$str"}
     unless $url->protocol =~ /^postgres(?:ql)?$/;
@@ -74,13 +77,12 @@ sub from_string {

 sub new { @_ > 1 ? shift->SUPER::new->from_string(@_) : shift->SUPER::new }

-sub _dequeue {
+sub _connect {
   my $self = shift;

-  # Fork-safety
-  delete @$self{qw(pid queue)} unless ($self->{pid} //= $$) eq $$;
+  # Shared connection queue
+  if (my $parent = $self->parent) { return $parent->_connect }

-  while (my $dbh = shift @{$self->{queue} || []}) { return $dbh if $dbh->ping }
   my $dbh = DBI->connect(map { $self->$_ } qw(dsn username password options));

   # Search path
@@ -89,21 +91,48 @@ sub _dequeue {
     $dbh->do("set search_path to $search_path");
   }

-  # Automatic migrations
-  ++$self->{migrated} and $self->migrations->migrate
-    if !$self->{migrated} && $self->auto_migrate;
-  $self->emit(connection => $dbh);
-
   return $dbh;
 }

+sub _dequeue {
+  my $self = shift;
+
+  # Shared connection queue
+  if (my $parent = $self->parent) { return $parent->_dequeue }
+
+  # Fork-safety
+  delete @$self{qw(pid queue)} unless ($self->{pid} //= $$) eq $$;
+
+  while (my $dbh = shift @{$self->{queue} || []}) { return $dbh if $dbh->ping }
+
+  return undef;
+}
+
 sub _enqueue {
   my ($self, $dbh) = @_;
+
+  # Shared connection queue
+  if (my $parent = $self->parent) { return $parent->_enqueue($dbh) }
+
   my $queue = $self->{queue} ||= [];
   push @$queue, $dbh if $dbh->{Active};
   shift @$queue while @$queue > $self->max_connections;
 }

+sub _prepare {
+  my $self = shift;
+
+  if (my $dbh = $self->_dequeue) { return $dbh }
+  my $dbh = $self->_connect;
+
+  # Automatic migrations
+  ++$self->{migrated} and $self->migrations->migrate
+    if !$self->{migrated} && $self->auto_migrate;
+  $self->emit(connection => $dbh);
+
+  return $dbh;
+}
+
 1;

 =encoding utf8
@@ -377,6 +406,14 @@ C<AutoInactiveDestroy> as well as C<RaiseError> and deactivating C<PrintError>
 as well as C<PrintWarn>. Note that C<AutoCommit> and C<RaiseError> are
 considered mandatory, so deactivating them would be very dangerous.

+=head2 parent
+
+  my $parent = $pg->parent;
+  $pg        = $pg->parent(Mojo::Pg->new);
+
+Another L<Mojo::Pg> to use for database connection management, instead of
+establishing and caching our own database connections.
+
 =head2 password

   my $password = $pg->password;
@@ -444,8 +481,10 @@ gracefully by holding on to it only for short amounts of time.
 =head2 from_string

   $pg = $pg->from_string('postgresql://postgres@/test');
+  $pg = $pg->from_string(Mojo::Pg->new);

-Parse configuration from connection string.
+Parse configuration from connection string or use another L<Mojo::Pg> object as
+L</"parent">.

   # Just a database
   $pg->from_string('postgresql:///db1');
@@ -475,6 +514,7 @@ Parse configuration from connection string.

   my $pg = Mojo::Pg->new;
   my $pg = Mojo::Pg->new('postgresql://postgres@/test');
+  my $pg = Mojo::Pg->new(Mojo::Pg->new);

 Construct a new L<Mojo::Pg> object and parse connection string with
 L</"from_string"> if necessary.
diff --git a/t/database.t b/t/database.t
index 691e5a6..c4264b6 100644
--- a/t/database.t
+++ b/t/database.t
@@ -174,6 +174,13 @@ ok !$connections, 'no new connections';
 };
 $pg->unsubscribe('connection');

+# Shared connection queue
+my $pg2 = Mojo::Pg->new($pg);
+is $pg2->parent, $pg, 'right parent';
+$dbh = $pg->db->dbh;
+is $pg->db->dbh,  $dbh, 'same database handle';
+is $pg2->db->dbh, $dbh, 'same database handle';
+
 # Notifications
 $db = $pg->db;
 ok !$db->is_listening, 'not listening';