lib/DBIx/Class/Storage/DBI/InsertReturning.pm

   1 package DBIx::Class::Storage::DBI::InsertReturning;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class::Storage::DBI/;
   7 use mro 'c3';
   8
   9 =head1 NAME
  10
  11 DBIx::Class::Storage::DBI::InsertReturning - Storage component for RDBMSes
  12 supporting INSERT ... RETURNING
  13
  14 =head1 DESCRIPTION
  15
  16 Provides Auto-PK and
  17 L<is_auto_increment|DBIx::Class::ResultSource/is_auto_increment> support for
  18 databases supporting the C<INSERT ... RETURNING> syntax.
  19
  20 =cut
  21
  22 sub insert {
  23   my $self = shift;
  24   my ($source, $to_insert, $opts) = @_;
  25
  26   return $self->next::method (@_) unless ($opts && $opts->{returning});
  27
  28   my $updated_cols = $self->_prefetch_insert_auto_nextvals ($source, $to_insert);
  29
  30   my $bind_attributes = $self->source_bind_attributes($source);
  31   my ($rv, $sth) = $self->_execute (insert => [], $source, $bind_attributes, $to_insert, $opts);
  32
  33   if (my @ret_cols = @{$opts->{returning}}) {
  34
  35     my @ret_vals = eval {
  36       local $SIG{__WARN__} = sub {};
  37       my @r = $sth->fetchrow_array;
  38       $sth->finish;
  39       @r;
  40     };
  41
  42     my %ret;
  43     @ret{@ret_cols} = @ret_vals if (@ret_vals);
  44
  45     $updated_cols = {
  46       %$updated_cols,
  47       %ret,
  48     };
  49   }
  50
  51   return $updated_cols;
  52 }
  53
  54 =head1 AUTHOR
  55
  56 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>
  57
  58 =head1 LICENSE
  59
  60 You may distribute this code under the same terms as Perl itself.
  61
  62 =cut
  63
  64 1;