From: Moritz Lenz Date: Thu, 4 Feb 2010 12:44:02 +0000 (+0000) Subject: primitive, non-working and very specific Storage::DBI::InterBase X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=88a8d0fabfdaa60d2b29f5f572b2baa064731b3d;p=dbsrgits%2FDBIx-Class-Historic.git primitive, non-working and very specific Storage::DBI::InterBase --- diff --git a/lib/DBIx/Class/Storage/DBI/InterBase.pm b/lib/DBIx/Class/Storage/DBI/InterBase.pm new file mode 100644 index 0000000..a15bb1f --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/InterBase.pm @@ -0,0 +1,71 @@ +package DBIx::Class::Storage::DBI::InterBase; + +# mostly stolen from DBIx::Class::Storage::DBI::MSSQL + +use strict; +use warnings; + +use base qw/DBIx::Class::Storage::DBI::AmbiguousGlob DBIx::Class::Storage::DBI/; +use mro 'c3'; + +use List::Util(); + +__PACKAGE__->mk_group_accessors(simple => qw/ + _identity _identity_method +/); + +__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::InterBase'); + +sub insert_bulk { + my $self = shift; + my ($source, $cols, $data) = @_; + + my $is_identity_insert = (List::Util::first + { $source->column_info ($_)->{is_auto_increment} } + (@{$cols}) + ) + ? 1 + : 0; + + $self->next::method(@_); +} + + +sub _prep_for_execute { + my $self = shift; + my ($op, $extra_bind, $ident, $args) = @_; + + my ($sql, $bind) = $self->next::method (@_); + + if ($op eq 'insert') { + $sql .= 'RETURNING "Id"'; + + } + + return ($sql, $bind); +} + +sub _execute { + my $self = shift; + my ($op) = @_; + + my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_); + + if ($op eq 'insert') { + + # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked + # on in _prep_for_execute above + local $@; + my ($identity) = eval { $sth->fetchrow_array }; + + $self->_identity($identity); + $sth->finish; + } + + return wantarray ? ($rv, $sth, @bind) : $rv; +} + +sub last_insert_id { shift->_identity } + +1; +