view release on metacpan or  search on metacpan

t/test/14_async_backend.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use Test::Exception;

use Scalar::Util ();
use DBIO::Test;
use DBIO::Future::Immediate;
use DBIO::Test::Storage;
use DBIO::Storage::Async;
use DBIO::Storage::DBI;

# ADR 0030: async is an explicit, per-connection mode resolved through a mode
# registry. A mode name maps to an embedded backend class; the backend is built
# per-instance via ->new($schema) + connect_info. The mock storage defaults to
# the 'immediate' mode. This test drives the whole selection model on mock
# storage only -- no event loop, no real database.

# --- Two in-file mock backends, registered under distinct mode names ----------
# Each tags its results so the resolved CHOICE is observable. They override new()
# to dodge base DBIO::Storage construction (no loop or real pool), record the six
# *_async op names, and resolve to an immediate DBIO::Future::Immediate. Backend
# A owns a tiny per-instance fake pool so disconnect/re-resolve can prove both
# ownership objects are rebuilt.

{
  package My::Mock::Pool;
  sub new { bless { shutdown => 0, shutdown_count => 0 }, $_[0] }
  sub shutdown {
    my ($self) = @_;
    return 1 if $self->{shutdown};
    $self->{shutdown} = 1;
    $self->{shutdown_count}++;
    return 1;
  }

  package My::Mock::AsyncA;
  use base 'DBIO::Storage::Async';
  sub new {
    my ($class, $schema) = @_;
    return bless {
      schema       => $schema,
      calls        => [],
      disconnected => 0,
      pool         => My::Mock::Pool->new,
    }, $class;
  }
  sub future_class { 'DBIO::Future::Immediate' }
  sub pool { $_[0]{pool} }
  sub connect_info { my $s = shift; $s->{connect_info} = shift if @_; $s->{connect_info} }
  sub disconnect {
    my ($self) = @_;
    $self->{disconnected}++;
    $self->{pool}->shutdown if $self->{pool};
    $self->{pool} = undef;
    return 1;
  }
  sub select_async        { push @{$_[0]{calls}}, 'select';        DBIO::Future::Immediate->done('A:select') }
  sub select_single_async { push @{$_[0]{calls}}, 'select_single'; DBIO::Future::Immediate->done('A:select_single') }
  sub insert_async        { push @{$_[0]{calls}}, 'insert';        DBIO::Future::Immediate->done('A:insert') }
  sub update_async        { push @{$_[0]{calls}}, 'update';        DBIO::Future::Immediate->done('A:update') }
  sub delete_async        { push @{$_[0]{calls}}, 'delete';        DBIO::Future::Immediate->done('A:delete') }
  sub txn_do_async        { push @{$_[0]{calls}}, 'txn_do';        DBIO::Future::Immediate->done('A:txn_do') }

  package My::Mock::AsyncB;
  use base 'DBIO::Storage::Async';
  sub new { my ($c, $s) = @_; bless { schema => $s, calls => [] }, $c }
  sub future_class { 'DBIO::Future::Immediate' }
  sub connect_info { my $s = shift; $s->{connect_info} = shift if @_; $s->{connect_info} }
  sub disconnect { 1 }
  sub select_async { push @{$_[0]{calls}}, 'select'; DBIO::Future::Immediate->done('B:select') }

  package My::Mock::NotAsyncBackend;
  sub marker { 'loadable but not async' }
}

DBIO::Storage::DBI->register_async_mode( mock_a => 'My::Mock::AsyncA' );
DBIO::Storage::DBI->register_async_mode( mock_b => 'My::Mock::AsyncB' );
DBIO::Storage::DBI->register_async_mode(
  not_backend => 'My::Mock::NotAsyncBackend',
);

# Set the chosen mode on a mock storage exactly as connect would, clearing the
# resolved-backend cache (the connect_info path clears it; a direct setter must
# too). Returns the storage for chaining.
sub set_mode {
  my ($storage, $mode) = @_;
  $storage->_async_mode($mode);
  delete $storage->{_async_storage_obj};
  return $storage;
}

# -----------------------------------------------------------------------
# Registry resolution: register + MRO-walk lookup, plus the core 'immediate'
# -----------------------------------------------------------------------
{
  is( DBIO::Storage::DBI->_resolve_async_mode_class('mock_a'), 'My::Mock::AsyncA',
    'registry resolves a registered generic mode to its backend class' );
  is( DBIO::Storage::DBI->_resolve_async_mode_class('immediate'), 'DBIO::Future::Immediate',
    "core registers 'immediate' -> DBIO::Future::Immediate" );
  is( DBIO::Storage::DBI->_resolve_async_mode_class('nope'), undef,
    'unregistered mode resolves to undef' );

  # The driver storage class (DBIO::Test::Storage) inherits the generic
  # registrations via the MRO walk.
  is( DBIO::Test::Storage->_resolve_async_mode_class('mock_a'), 'My::Mock::AsyncA',
    'driver subclass inherits generic mode registrations through the MRO' );
}

# -----------------------------------------------------------------------
# A loadable registry target of the wrong type must not silently degrade
# -----------------------------------------------------------------------
{
  my $storage = DBIO::Test->init_schema->storage;
  set_mode($storage, 'not_backend');

  throws_ok { $storage->_async_storage }
    qr/async mode 'not_backend'.*My::Mock::NotAsyncBackend.*DBIO::Storage::Async/,
    'loaded registry target must satisfy the async backend contract';
  throws_ok {
    $storage->select_async('artist', ['artistid'], {}, {});