gistfile1.txt

package DBIx::Class::Storage::DBI::mysql_query_thief;

# oh black rock shooter~

use precise;

use DBIx::Class::ResultSet;

use parent 'DBIx::Class::Storage::DBI::mysql';
use Test::More;
use Data::Dumper::Compact 'ddc';

# prevent debugger variable view serialization from causing buggy side effects
package DBIx::Class::ResultSet { use overload fallback => 0; no overload "0+", "bool" }

our @QUERIES;

1;

sub get_queries  { my @q = @QUERIES; @QUERIES = (); @q }
sub dbh_do       { push @QUERIES, [ $_[2], map $_->[1], $_[3]->@* ] }
sub _dbh_details { { info => { normalized_dbms_version => 4 } } }
sub _dbh         { ( caller 1 )[3] eq "DBIx::Class::Storage::DBI::_determine_driver" ? () : 1 }
sub _dbh_last_insert_id { 1 }

sub get_query {
	my ($r) = @_;
	my @queries = $r->result_source->schema->storage->get_queries;
	## carp is ok here, only expect to see this in tests
	carp "more than one query: " . ddc \@queries if @queries > 1;
	return $queries[0]->@*;
}

sub DBIx::Class::ResultSet::gen_update {
	my ( $self, $orig, $changes ) = @_;
	my $r = $self->new_result($orig);
	$r->in_storage(1);
	$r->$_( $changes->{$_} ) for keys $changes->%*;
	$r->update;
	return get_query $self;
}

sub DBIx::Class::ResultSet::gen_insert {
	my ( $self, $data ) = @_;
	$self->new_result($data)->insert;
	return get_query $self;
}

sub DBIx::Class::ResultSet::gen_delete {
	my ( $self, $data ) = @_;
	$self->search($data)->delete;
	return get_query $self;
}