DBIO-Forked

 view release on metacpan or  search on metacpan

lib/DBIO/Forked/Storage.pm  view on Meta::CPAN

      . 'DDL deploy (fork-per-query, Model A); deploy through the sync owner with '
      . '$schema->deploy';
}

# --- Async CRUD ---


sub select_async        { my $self = shift; $self->_run_forked('select',        @_) }
sub select_single_async { my $self = shift; $self->_run_forked('select_single', @_) }
sub insert_async        { my $self = shift; $self->_run_forked('insert',        @_) }
sub update_async        { my $self = shift; $self->_run_forked('update',        @_) }
sub delete_async        { my $self = shift; $self->_run_forked('delete',        @_) }

# txn_do_async is just _run_forked('txn_do', $body, @args): the child runs the
# inherited sync storage's txn_do($body, @args), so BEGIN/body/COMMIT all happen
# in the child on its freshly-reconnected connection. See the method POD for the
# return-value and sync-only limits.
sub txn_do_async        { my $self = shift; $self->_run_forked('txn_do',        @_) }

# --- Fork-per-query seam (Model A) ---
#

lib/DBIO/Forked/Storage.pm  view on Meta::CPAN

      . "(it must be plain serializable data): $err";
}

# --- Sync wrappers ---
# The sync entry points block on the forked result: run the query in a child
# and wait for it via ->get.

sub select        { my $self = shift; $self->select_async(@_)->get        }
sub select_single { my $self = shift; $self->select_single_async(@_)->get }
sub insert        { my $self = shift; $self->insert_async(@_)->get        }
sub update        { my $self = shift; $self->update_async(@_)->get        }
sub delete        { my $self = shift; $self->delete_async(@_)->get        }
sub txn_do        { my $self = shift; $self->txn_do_async(@_)->get        }

1;

__END__

=pod

=encoding UTF-8

t/01-fork-roundtrip.t  view on Meta::CPAN

# --- Mock driver: a sync storage whose CRUD returns fixed data, and a schema
# --- whose ->storage hands it back. No DBI, no real database. This exercises
# --- the full Model A path: fork -> inherited sync CRUD -> Storable -> Future.

{
  package t::Mock::Storage;
  sub new { bless {}, shift }
  sub select { shift; return ([ 1, 'Alice' ], [ 2, 'Bob' ]) }
  sub insert { shift; return ([ 99 ]) }
  sub update { die "update boom\n" }   # error-path op

  package t::Mock::Schema;
  sub new { my ($c, $storage) = @_; bless { storage => $storage }, $c }
  sub storage { $_[0]->{storage} }
}

my $schema  = t::Mock::Schema->new(t::Mock::Storage->new);
my $storage = DBIO::Forked::Storage->new($schema);

# --- success roundtrip ------------------------------------------------------

t/01-fork-roundtrip.t  view on Meta::CPAN

# --- update/delete resolve the affected-row COUNT, a plain scalar -------------
# A real DBI storage's update()/delete() return ($rv, $sth, @bind) in list
# context and $rv in scalar context (DBIO::Storage::DBI::_execute). The child
# must ask for the count, or the statement handle -- full of code refs -- goes
# into Storable and the Future fails with "cannot serialize" although the
# statement ran. The contract (DBIO::Storage::Async::update_async, which
# Row::update_async relies on for "row not found") is the count alone.
{
  package t::Mock::DBI::Storage;
  sub new { bless {}, shift }
  sub update { shift; return wantarray ? (3, sub { 'sth' }, 'bind') : 3 }
  sub delete { shift; return wantarray ? (1, sub { 'sth' }, 'bind') : 1 }

  package main;
  my $dbi_schema = t::Mock::Schema->new(t::Mock::DBI::Storage->new);   # held: the backend keeps it weakly
  my $dbi = DBIO::Forked::Storage->new($dbi_schema);

  my @upd = eval { $dbi->update_async('artist', { x => 1 }, { y => 2 })->get };
  is($@, '', 'update_async whose sync update returns a statement handle in list context does not fail');
  is_deeply(\@upd, [ 3 ], 'update_async resolves with the affected-row count alone');

t/07-transport-paths.t  view on Meta::CPAN

    return ([ 1, 'Alice' ], [ 2, 'Bob' ]);
  }

  # Sync select_single returns the column values as a flat list.
  sub select_single {
    my ($self, $what) = @_;
    return $what eq 'miss' ? () : (7, 'Grace');
  }

  sub insert { my $self = shift; return { op => 'insert', pid => $$, args => [ @_ ] } }
  sub update { my $self = shift; return { op => 'update', pid => $$, args => [ @_ ] } }
  sub delete { my $self = shift; return { op => 'delete', pid => $$, args => [ @_ ] } }

  sub txn_do {
    my ($self, $code, @args) = @_;
    return { op => 'txn_do', pid => $$, body => [ $code->(@args) ] };
  }

  package t::Mock::Schema;
  sub new { my ($class, $storage) = @_; bless { storage => $storage }, $class }
  sub storage { $_[0]->{storage} }