view release on metacpan or  search on metacpan

t/32-async-load-age.t  view on Meta::CPAN

{
  package RecPool;
  use base 'DBIO::Storage::PoolBase';

  my $NEXT = 0;
  sub _create_connection {
    my @log;
    return { id => ++$NEXT, log => \@log, dbh => RecHandle->new(\@log) };
  }
  sub _shutdown_connection { }   # keep the log alive for post-shutdown asserts
}

# --- The real Age async backend, with its pool swapped for the recorder -------
# The composed backend's ISA is (Age async layer, future_io transport); we
# reconstruct exactly that here and swap in the recording pool.
{
  package RecAgeBackend;
  use base qw( DBIO::PostgreSQL::Age::Storage::Async DBIO::PostgreSQL::Storage::Async );
  use mro 'c3';

  sub pool {
    my $self = shift;
    $self->{pool} ||= RecPool->new(
      storage  => $self,
      conninfo => 'fake',
      size     => $self->{_pool_size} || 2,
    );
  }
}

my $schema = DBIO::Test->init_schema;   # kept alive: storages weaken their refs

# The owning SYNC storage is the composed Age storage (Age LAYER over the PG
# driver) -- it carries connect_call_load_age via the layer.
my $owner_class = DBIO::Storage::Composed->compose(
  'DBIO::PostgreSQL::Storage', ['DBIO::PostgreSQL::Age::Storage'],
);
my $owner   = $owner_class->new($schema);
my $backend = RecAgeBackend->new($schema);

$owner->on_connect_call('load_age');