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 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, no pool), record the six
# *_async op names, and resolve to an immediate DBIO::Future::Immediate.

{
  package My::Mock::AsyncA;
  use base 'DBIO::Storage::Async';
  sub new { my ($c, $s) = @_; bless { schema => $s, calls => [], disconnected => 0 }, $c }
  sub future_class { 'DBIO::Future::Immediate' }
  sub connect_info { my $s = shift; $s->{connect_info} = shift if @_; $s->{connect_info} }
  sub disconnect { $_[0]{disconnected}++ }
  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') }
}

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

# 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 registered mock mode is built per-instance and answers all six *_async
# -----------------------------------------------------------------------
{
  my $schema  = DBIO::Test->init_schema;
  my $storage = set_mode($schema->storage, 'mock_a');

  my $async = $storage->_async_storage;
  isa_ok $async, 'My::Mock::AsyncA',
    'mode mock_a builds the registered backend for this instance';
  is $storage->async, $async,
    'public async() returns the same built backend';
  is $async->{schema}, $schema,
    'backend was built with ->new($schema)';
  is $storage->future_class, 'DBIO::Future::Immediate',
    'future_class delegates to the live backend';

  for my $op (qw(select select_single insert update delete txn_do)) {