view release on metacpan or  search on metacpan

t/debug/async_upsert_trace.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More;

use DBIO::Test::Storage;
use DBIO::Future::Immediate;
use DBIO::Storage::DBI;
use DBIO::Storage::Async;
use DBIO::Storage::Statistics;

# Every rendering of a statement gets its own copy of the options (karr k405).
# A driver SQL maker consumes on_conflict (and insert_or) from the options it
# receives, so the statement on the wire and the rendering that resolves the
# bind attributes of a level 2 trace each see the complete options: the
# attribute list lines up with the binds, an encode_column value is masked, the
# redact_bind_value hook sees the column name, and the options of the caller
# keep what they were given.

{
  package T405::SQLMaker;
  use base 'DBIO::SQLMaker';
  use mro 'c3';

  # the shape of the driver makers: consume the keys, append a conflict tail
  # with a bind of its own
  sub insert {
    my ($self, $table, $data, $options) = @_;
    my $or          = ref $options eq 'HASH' ? delete $options->{insert_or}   : undef;
    my $on_conflict = ref $options eq 'HASH' ? delete $options->{on_conflict} : undef;

    my ($sql, @bind) = $self->next::method($table, $data, $options);
    $sql =~ s/^INSERT/INSERT OR $or/ if defined $or;
    if ($on_conflict) {
      $sql .= ' ON CONFLICT (id) DO UPDATE SET name = ?';
      push @bind, $self->{bindtype} eq 'columns'
        ? [ { dbic_colname => 'name' } => 'tail-value' ]
        : 'tail-value';
    }
    return ($sql, @bind);
  }

  # update and delete: a key of the options is consumed
  sub update {
    my ($self, $table, $set, $where, $options) = @_;
    delete $options->{marker} if ref $options eq 'HASH';
    return $self->next::method($table, $set, $where);
  }

  sub delete {
    my ($self, $table, $where, $options) = @_;
    delete $options->{marker} if ref $options eq 'HASH';
    return $self->next::method($table, $where);
  }
}

{
  package T405::Schema::Result::User;
  use base 'DBIO::Core';
  __PACKAGE__->table('users');
  __PACKAGE__->add_columns(
    id       => { data_type => 'integer', is_auto_increment => 1 },
    name     => { data_type => 'varchar', size => 64, is_nullable => 1 },
    password => { data_type => 'varchar', size => 255, is_nullable => 1, encode_column => 1 },
  );
  __PACKAGE__->set_primary_key('id');

  package T405::Schema;
  use base 'DBIO::Schema';
  __PACKAGE__->register_class(User => 'T405::Schema::Result::User');
}

{
  package T405::Backend;
  use base 'DBIO::Storage::Async';

  sub future_class     { 'DBIO::Future::Immediate' }
  sub sql_maker_class  { 'T405::SQLMaker' }
  sub _sql_maker_args  { (quote_char => '"', name_sep => '.') }
  sub _transform_sql   { $_[1] }
  sub _post_insert_sql { '' }

  sub _query_async {
    my ($self, $sql, $bind, $attrs) = @_;
    push @{ $self->{seen} }, { sql => $sql, bind => $bind, attrs => $attrs };
    $self->_debug_query($sql, $bind, $attrs);
    return $self->future_class->done(1);
  }
}

T405::Schema->storage_type('+DBIO::Test::Storage');
my $schema = T405::Schema->connect(sub { });
$schema->storage(DBIO::Test::Storage->new($schema));
my $owner = $schema->storage;

my $out = '';
open my $fh, '>', \$out or die;
my $stats = DBIO::Storage::Statistics->new;
$stats->debugfh($fh);
$owner->debugobj($stats);

my @hook_calls;
my $default_hook = $owner->redact_bind_value;
$owner->redact_bind_value(sub {