[Bast-commits] r8531 - DBIx-Class/0.08/branches/storage-interbase/lib/DBIx/Class/Storage/DBI

[moritz at dev.catalyst.perl.org]

Author: moritz
Date: 2010-02-04 12:44:02 +0000 (Thu, 04 Feb 2010)
New Revision: 8531

Added:
   DBIx-Class/0.08/branches/storage-interbase/lib/DBIx/Class/Storage/DBI/InterBase.pm
Log:
primitive, non-working and very specific Storage::DBI::InterBase

Added: DBIx-Class/0.08/branches/storage-interbase/lib/DBIx/Class/Storage/DBI/InterBase.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-interbase/lib/DBIx/Class/Storage/DBI/InterBase.pm	                        (rev 0)
+++ DBIx-Class/0.08/branches/storage-interbase/lib/DBIx/Class/Storage/DBI/InterBase.pm	2010-02-04 12:44:02 UTC (rev 8531)
@@ -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;
+