Commit | Line | Data |
be860760 |
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 | __PACKAGE__->mk_group_accessors(simple => qw/ |
10 | _returning_cols |
11 | /); |
12 | |
13 | =head1 NAME |
14 | |
15 | DBIx::Class::Storage::DBI::InsertReturning - Storage component for RDBMSes |
16 | supporting INSERT ... RETURNING |
17 | |
18 | =head1 DESCRIPTION |
19 | |
20 | Provides Auto-PK and |
21 | L<is_auto_increment|DBIx::Class::ResultSource/is_auto_increment> support for |
22 | databases supporting the C<INSERT ... RETURNING> syntax. Currently |
23 | L<PostgreSQL|DBIx::Class::Storage::DBI::Pg> and |
24 | L<Firebird|DBIx::Class::Storage::DBI::InterBase>. |
25 | |
26 | =cut |
27 | |
28 | sub _prep_for_execute { |
29 | my $self = shift; |
30 | my ($op, $extra_bind, $ident, $args) = @_; |
31 | |
32 | if ($op eq 'insert') { |
33 | $self->_returning_cols([]); |
34 | |
35 | my %pk; |
36 | @pk{$ident->primary_columns} = (); |
37 | |
38 | my @auto_inc_cols = grep { |
39 | my $inserting = $args->[0]{$_}; |
40 | |
41 | ($ident->column_info($_)->{is_auto_increment} |
42 | || exists $pk{$_}) |
43 | && ( |
44 | (not defined $inserting) |
45 | || |
46 | (ref $inserting eq 'SCALAR' && $$inserting =~ /^null\z/i) |
47 | ) |
48 | } $ident->columns; |
49 | |
50 | if (@auto_inc_cols) { |
51 | $args->[1]{returning} = \@auto_inc_cols; |
52 | |
53 | $self->_returning_cols->[0] = \@auto_inc_cols; |
54 | } |
55 | } |
56 | |
57 | return $self->next::method(@_); |
58 | } |
59 | |
60 | sub _execute { |
61 | my $self = shift; |
62 | my ($op) = @_; |
63 | |
64 | my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_); |
65 | |
66 | if ($op eq 'insert' && $self->_returning_cols) { |
67 | local $@; |
68 | my (@returning_cols) = eval { |
69 | local $SIG{__WARN__} = sub {}; |
70 | $sth->fetchrow_array |
71 | }; |
72 | $self->_returning_cols->[1] = \@returning_cols; |
73 | $sth->finish; |
74 | } |
75 | |
76 | return wantarray ? ($rv, $sth, @bind) : $rv; |
77 | } |
78 | |
79 | sub insert { |
80 | my $self = shift; |
81 | |
82 | my $updated_cols = $self->next::method(@_); |
83 | |
84 | if ($self->_returning_cols->[0]) { |
85 | my %returning_cols; |
86 | @returning_cols{ @{ $self->_returning_cols->[0] } } = @{ $self->_returning_cols->[1] }; |
87 | |
88 | $updated_cols = { %$updated_cols, %returning_cols }; |
89 | } |
90 | |
91 | return $updated_cols; |
92 | } |
93 | |
94 | sub last_insert_id { |
95 | my ($self, $source, @cols) = @_; |
96 | my @result; |
97 | |
98 | my %returning_cols; |
99 | @returning_cols{ @{ $self->_returning_cols->[0] } } = |
100 | @{ $self->_returning_cols->[1] }; |
101 | |
102 | push @result, $returning_cols{$_} for @cols; |
103 | |
104 | return @result; |
105 | } |
106 | |
107 | =head1 AUTHOR |
108 | |
109 | See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS> |
110 | |
111 | =head1 LICENSE |
112 | |
113 | You may distribute this code under the same terms as Perl itself. |
114 | |
115 | =cut |
116 | |
117 | 1; |