--- /dev/null
+package DBIx::Class::Storage::DBI::InsertReturning;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+__PACKAGE__->mk_group_accessors(simple => qw/
+ _returning_cols
+/);
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::InsertReturning - Storage component for RDBMSes
+supporting INSERT ... RETURNING
+
+=head1 DESCRIPTION
+
+Provides Auto-PK and
+L<is_auto_increment|DBIx::Class::ResultSource/is_auto_increment> support for
+databases supporting the C<INSERT ... RETURNING> syntax. Currently
+L<PostgreSQL|DBIx::Class::Storage::DBI::Pg> and
+L<Firebird|DBIx::Class::Storage::DBI::InterBase>.
+
+=cut
+
+sub _prep_for_execute {
+ my $self = shift;
+ my ($op, $extra_bind, $ident, $args) = @_;
+
+ if ($op eq 'insert') {
+ $self->_returning_cols([]);
+
+ my %pk;
+ @pk{$ident->primary_columns} = ();
+
+ my @auto_inc_cols = grep {
+ my $inserting = $args->[0]{$_};
+
+ ($ident->column_info($_)->{is_auto_increment}
+ || exists $pk{$_})
+ && (
+ (not defined $inserting)
+ ||
+ (ref $inserting eq 'SCALAR' && $$inserting =~ /^null\z/i)
+ )
+ } $ident->columns;
+
+ if (@auto_inc_cols) {
+ $args->[1]{returning} = \@auto_inc_cols;
+
+ $self->_returning_cols->[0] = \@auto_inc_cols;
+ }
+ }
+
+ return $self->next::method(@_);
+}
+
+sub _execute {
+ my $self = shift;
+ my ($op) = @_;
+
+ my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
+
+ if ($op eq 'insert' && $self->_returning_cols) {
+ local $@;
+ my (@returning_cols) = eval {
+ local $SIG{__WARN__} = sub {};
+ $sth->fetchrow_array
+ };
+ $self->_returning_cols->[1] = \@returning_cols;
+ $sth->finish;
+ }
+
+ return wantarray ? ($rv, $sth, @bind) : $rv;
+}
+
+sub insert {
+ my $self = shift;
+
+ my $updated_cols = $self->next::method(@_);
+
+ if ($self->_returning_cols->[0]) {
+ my %returning_cols;
+ @returning_cols{ @{ $self->_returning_cols->[0] } } = @{ $self->_returning_cols->[1] };
+
+ $updated_cols = { %$updated_cols, %returning_cols };
+ }
+
+ return $updated_cols;
+}
+
+sub last_insert_id {
+ my ($self, $source, @cols) = @_;
+ my @result;
+
+ my %returning_cols;
+ @returning_cols{ @{ $self->_returning_cols->[0] } } =
+ @{ $self->_returning_cols->[1] };
+
+ push @result, $returning_cols{$_} for @cols;
+
+ return @result;
+}
+
+=head1 AUTHOR
+
+See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
use strict;
use warnings;
-use base qw/DBIx::Class::Storage::DBI/;
+use base qw/DBIx::Class::Storage::DBI::InsertReturning/;
use mro 'c3';
use List::Util();
-__PACKAGE__->mk_group_accessors(simple => qw/
- _auto_incs
-/);
-
=head1 NAME
DBIx::Class::Storage::DBI::InterBase - Driver for the Firebird RDBMS
=cut
-sub _prep_for_execute {
- my $self = shift;
- my ($op, $extra_bind, $ident, $args) = @_;
-
- if ($op eq 'insert') {
- $self->_auto_incs([]);
-
- my %pk;
- @pk{$ident->primary_columns} = ();
-
- my @auto_inc_cols = grep {
- my $inserting = $args->[0]{$_};
-
- ($ident->column_info($_)->{is_auto_increment}
- || exists $pk{$_})
- && (
- (not defined $inserting)
- ||
- (ref $inserting eq 'SCALAR' && $$inserting =~ /^null\z/i)
- )
- } $ident->columns;
-
- if (@auto_inc_cols) {
- $args->[1]{returning} = \@auto_inc_cols;
-
- $self->_auto_incs->[0] = \@auto_inc_cols;
- }
- }
-
- return $self->next::method(@_);
-}
-
-sub _execute {
- my $self = shift;
- my ($op) = @_;
-
- my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
-
- if ($op eq 'insert' && $self->_auto_incs) {
- local $@;
- my (@auto_incs) = eval {
- local $SIG{__WARN__} = sub {};
- $sth->fetchrow_array
- };
- $self->_auto_incs->[1] = \@auto_incs;
- $sth->finish;
- }
-
- return wantarray ? ($rv, $sth, @bind) : $rv;
-}
-
sub _sequence_fetch {
my ($self, $nextval, $sequence) = @_;
return undef;
}
-sub last_insert_id {
- my ($self, $source, @cols) = @_;
- my @result;
-
- my %auto_incs;
- @auto_incs{ @{ $self->_auto_incs->[0] } } =
- @{ $self->_auto_incs->[1] };
-
- push @result, $auto_incs{$_} for @cols;
-
- return @result;
-}
-
-sub insert {
- my $self = shift;
-
- my $updated_cols = $self->next::method(@_);
-
- if ($self->_auto_incs->[0]) {
- my %auto_incs;
- @auto_incs{ @{ $self->_auto_incs->[0] } } = @{ $self->_auto_incs->[1] };
-
- $updated_cols = { %$updated_cols, %auto_incs };
- }
-
- return $updated_cols;
-}
-
# this sub stolen from DB2
sub _sql_maker_opts {
use strict;
use warnings;
-use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/;
+use base qw/
+ DBIx::Class::Storage::DBI::MultiColumnIn
+ DBIx::Class::Storage::DBI::InsertReturning
+/;
use mro 'c3';
use DBD::Pg qw(:pg_types);
warn __PACKAGE__.": DBD::Pg 2.9.2 or greater is strongly recommended\n"
if ($DBD::Pg::VERSION < 2.009002); # pg uses (used?) version::qv()
-__PACKAGE__->mk_group_accessors(simple => qw/
- _auto_cols
-/);
-
-sub _prep_for_execute {
- my $self = shift;
- my ($op, $extra_bind, $ident, $args) = @_;
-
- if ($op eq 'insert') {
- $self->_auto_cols([]);
-
- my %pk;
- @pk{$ident->primary_columns} = ();
-
- my @auto_inc_cols = grep {
- my $inserting = $args->[0]{$_};
-
- ($ident->column_info($_)->{is_auto_increment}
- || exists $pk{$_})
- && (
- (not defined $inserting)
- ||
- (ref $inserting eq 'SCALAR' && $$inserting =~ /^null\z/i)
- )
- } $ident->columns;
-
- if (@auto_inc_cols) {
- $args->[1]{returning} = \@auto_inc_cols;
-
- $self->_auto_cols->[0] = \@auto_inc_cols;
- }
- }
-
- return $self->next::method(@_);
-}
-
-sub _execute {
- my $self = shift;
- my ($op) = @_;
-
- my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
-
- if ($op eq 'insert' && $self->_auto_cols) {
- local $@;
- my (@auto_cols) = eval {
- local $SIG{__WARN__} = sub {};
- $sth->fetchrow_array
- };
- $self->_auto_cols->[1] = \@auto_cols;
- $sth->finish;
- }
-
- return wantarray ? ($rv, $sth, @bind) : $rv;
-}
-
-
sub with_deferred_fk_checks {
my ($self, $sub) = @_;
after => sub { $txn_scope_guard->commit });
}
-sub insert {
- my $self = shift;
-
- my $updated_cols = $self->next::method(@_);
-
- if ($self->_auto_cols->[0]) {
- my %auto_cols;
- @auto_cols{ @{ $self->_auto_cols->[0] } } = @{ $self->_auto_cols->[1] };
-
- $updated_cols = { %$updated_cols, %auto_cols };
- }
-
- return $updated_cols;
-}
-
-sub last_insert_id {
- my ($self, $source, @cols) = @_;
- my @result;
-
- my %auto_cols;
- @auto_cols{ @{ $self->_auto_cols->[0] } } =
- @{ $self->_auto_cols->[1] };
-
- push @result, $auto_cols{$_} for @cols;
-
- return @result;
-}
-
sub _sequence_fetch {
my ($self, $function, $sequence) = @_;
my $row = $schema->resultset('TimestampPrimaryKey')->create({});
ok $row->id;
+######## test with_deferred_fk_checks
+
+$schema->source('CD')->name('dbic_t_schema.cd');
+$schema->source('Track')->name('dbic_t_schema.track');
+lives_ok {
+ $schema->storage->with_deferred_fk_checks(sub {
+ $schema->resultset('Track')->create({
+ trackid => 999, cd => 999, position => 1, title => 'deferred FK track'
+ });
+ $schema->resultset('CD')->create({
+ artist => 1, cdid => 999, year => '2003', title => 'deferred FK cd'
+ });
+ });
+} 'with_deferred_fk_checks code survived';
+
+is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track',
+ 'code in with_deferred_fk_checks worked';
+
+throws_ok {
+ $schema->resultset('Track')->create({
+ trackid => 1, cd => 9999, position => 1, title => 'Track1'
+ });
+} qr/constraint/i, 'with_deferred_fk_checks is off';
+
done_testing;
exit;
$dbh->do(<<EOS);
CREATE TABLE dbic_t_schema.timestamp_primary_key_test (
- id timestamp default current_timestamp
+ id timestamp default current_timestamp
)
EOS
$dbh->do(<<EOS);
+CREATE TABLE dbic_t_schema.cd (
+ cdid int PRIMARY KEY,
+ artist int,
+ title varchar(255),
+ year varchar(4),
+ genreid int,
+ single_track int
+)
+EOS
+ $dbh->do(<<EOS);
+CREATE TABLE dbic_t_schema.track (
+ trackid int,
+ cd int REFERENCES dbic_t_schema.cd(cdid) DEFERRABLE,
+ position int,
+ title varchar(255),
+ last_updated_on date,
+ last_updated_at date,
+ small_dt date
+)
+EOS
+
+ $dbh->do(<<EOS);
CREATE TABLE dbic_t_schema.sequence_test (
pkid1 integer
, pkid2 integer
projects / dbsrgits/DBIx-Class.git / commitdiff