From: Jess Robinson <castaway@desert-island.me.uk>
Date: Thu, 9 Feb 2006 21:04:48 +0000 (+0000)
Subject: Shovelling PK::Auto stuff where it belongs..
X-Git-Tag: v0.06000~61^2~53
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=843f8ecda2d9885b79402416f048016c1ecc4114;p=dbsrgits%2FDBIx-Class.git

Shovelling PK::Auto stuff where it belongs..
---

diff --git a/lib/DBIx/Class/PK/Auto.pm b/lib/DBIx/Class/PK/Auto.pm
index c2bb440..e62dbc1 100644
--- a/lib/DBIx/Class/PK/Auto.pm
+++ b/lib/DBIx/Class/PK/Auto.pm
@@ -65,9 +65,9 @@ sub insert {
   $self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
     if $too_many;
   unless (defined $self->get_column($pri)) {
-    $self->throw_exception( "Can't auto-inc for $pri on ".ref $self.": no _last_insert_id method" )
-      unless $self->can('last_insert_id');
-    my $id = $self->last_insert_id;
+#     $self->throw_exception( "Can't auto-inc for $pri on ".ref $self.": no _last_insert_id method" )
+#       unless $self->can('last_insert_id');
+    my $id = $self->result_source->storage->last_insert_id($self->result_source);
     $self->throw_exception( "Can't get last insert id" ) unless $id;
     $self->store_column($pri => $id);
   }
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index c218ef1..1f67826 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -263,7 +263,13 @@ sub _populate_dbh {
   my ($self) = @_;
   my @info = @{$self->connect_info || []};
   $self->_dbh($self->_connect(@info));
-
+  my $driver = $self->_dbh->{Driver}->{Name};
+  eval qq{
+require DBIx::Class::Storage::DBI::${driver};
+  };
+  if(!$@) {
+    bless $self, "DBIx::Class::Storage::DBI::${driver}";
+  }
   # if on-connect sql statements are given execute them
   foreach my $sql_statement (@{$self->on_connect_do || []}) {
     $self->_dbh->do($sql_statement);
@@ -424,6 +430,15 @@ sub columns_info_for {
     return \%result;
 }
 
+sub last_insert_id {
+  my ($self, $row) = @_;
+    
+  return $self->dbh->func('last_insert_rowid');
+
+}
+
+
+
 sub DESTROY { shift->disconnect }
 
 1;
diff --git a/lib/DBIx/Class/Storage/DBI/DB2.pm b/lib/DBIx/Class/Storage/DBI/DB2.pm
new file mode 100644
index 0000000..a6e1452
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/DB2.pm
@@ -0,0 +1,48 @@
+package DBIx::Class::Storage::DBI::DB2;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+# __PACKAGE__->load_components(qw/PK::Auto/);
+
+sub last_insert_id
+{
+    my ($self) = @_;
+
+    my $dbh = $self->_dbh;
+    my $sth = $dbh->prepare_cached("VALUES(IDENTITY_VAL_LOCAL())", {}, 3);
+    $sth->execute();
+
+    my @res = $sth->fetchrow_array();
+
+    return @res ? $res[0] : undef;
+                         
+}
+
+1;
+
+=head1 NAME 
+
+DBIx::Class::Storage::DBI::DB2 - Automatic primary key class for DB2
+
+=head1 SYNOPSIS
+
+  # In your table classes
+  __PACKAGE__->load_components(qw/PK::Auto Core/);
+  __PACKAGE__->set_primary_key('id');
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for DB2.
+
+=head1 AUTHORS
+
+Jess Robinson
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
new file mode 100644
index 0000000..7a30b65
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
@@ -0,0 +1,39 @@
+package DBIx::Class::Storage::DBI::MSSQL;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+# __PACKAGE__->load_components(qw/PK::Auto/);
+
+sub last_insert_id {
+  my( $id ) = $_[0]->_dbh->selectrow_array('SELECT @@IDENTITY' );
+  return $id;
+}
+
+1;
+
+=head1 NAME 
+
+DBIx::Class::Storage::DBI::MSSQL - Automatic primary key class for MSSQL
+
+=head1 SYNOPSIS
+
+  # In your table classes
+  __PACKAGE__->load_components(qw/PK::Auto Core/);
+  __PACKAGE__->set_primary_key('id');
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for MSSQL.
+
+=head1 AUTHORS
+
+Brian Cassidy <bricas@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm
new file mode 100644
index 0000000..b979f79
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm
@@ -0,0 +1,77 @@
+package DBIx::Class::Storage::DBI::Oracle;
+
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+# __PACKAGE__->load_components(qw/PK::Auto/);
+
+sub last_insert_id {
+  my ($self, $source) = shift;
+  $self->get_autoinc_seq($source) unless $self->{_autoinc_seq};
+  my $sql = "SELECT " . $self->{_autoinc_seq} . ".currval FROM DUAL";
+  my ($id) = $self->_dbh->selectrow_array($sql);
+  return $id;  
+}
+
+sub get_autoinc_seq {
+  my ($self, $source) = shift;
+  
+  # return the user-defined sequence if known
+  if ($source->sequence) {
+    return $self->{_autoinc_seq} = $source->sequence;
+  }
+  
+  # look up the correct sequence automatically
+  my $dbh = $self->_dbh;
+  my $sql = qq{
+    SELECT trigger_body FROM ALL_TRIGGERS t
+    WHERE t.table_name = ?
+    AND t.triggering_event = 'INSERT'
+    AND t.status = 'ENABLED'
+  };
+  # trigger_body is a LONG
+  $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
+  my $sth = $dbh->prepare($sql);
+  $sth->execute( uc($source->name) );
+  while (my ($insert_trigger) = $sth->fetchrow_array) {
+    if ($insert_trigger =~ m!(\w+)\.nextval!i ) {
+      $self->{_autoinc_seq} = uc($1);
+    }
+  }
+  unless ($self->{_autoinc_seq}) {
+    croak "Unable to find a sequence INSERT trigger on table '" . $self->_table_name . "'.";
+  }
+}
+
+1;
+
+=head1 NAME 
+
+DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle
+
+=head1 SYNOPSIS
+
+  # In your table classes
+  __PACKAGE__->load_components(qw/PK::Auto Core/);
+  __PACKAGE__->set_primary_key('id');
+  __PACKAGE__->sequence('mysequence');
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for Oracle.
+
+=head1 AUTHORS
+
+Andy Grundman <andy@hybridized.org>
+
+Scott Connelly <scottsweep@yahoo.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm
new file mode 100644
index 0000000..88d401b
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/Pg.pm
@@ -0,0 +1,65 @@
+package DBIx::Class::Storage::DBI::Pg;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+# __PACKAGE__->load_components(qw/PK::Auto/);
+
+sub last_insert_id {
+  my ($self, $source) = @_;
+  $self->get_autoinc_seq unless $self->{_autoinc_seq};
+  $self->_dbh->last_insert_id(undef,undef,undef,undef,
+    {sequence=>$self->{_autoinc_seq}});
+}
+
+sub get_autoinc_seq {
+  my $self = shift;
+  
+  # return the user-defined sequence if known
+  if ($source->sequence) {
+    return $self->{_autoinc_seq} = $source->sequence;
+  }
+  
+  my @pri = $source->primary_columns;
+  my $dbh = $self->_dbh;
+  my ($schema,$table) = $source->name =~ /^(.+)\.(.+)$/ ? ($1,$2) : (undef,$sou
+rce->table);
+  while (my $col = shift @pri) {
+    my $info = $dbh->column_info(undef,$schema,$table,$col)->fetchrow_arrayref;
+    if (defined $info->[12] and $info->[12] =~ 
+      /^nextval\('"?([^"']+)"?'::(?:text|regclass)\)/)
+    {
+      $self->{_autoinc_seq} = $1;
+      last;
+    } 
+  }
+}
+
+1;
+
+=head1 NAME 
+
+DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
+
+=head1 SYNOPSIS
+
+  # In your table classes
+  __PACKAGE__->load_components(qw/PK::Auto Core/);
+  __PACKAGE__->set_primary_key('id');
+  __PACKAGE__->sequence('mysequence');
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for PostgreSQL.
+
+=head1 AUTHORS
+
+Marcus Ramberg <m.ramberg@cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm
new file mode 100644
index 0000000..d5b9c62
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm
@@ -0,0 +1,36 @@
+package DBIx::Class::Storage::DBI::SQLite;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+sub last_insert_id {
+  return $self->dbh->func('last_insert_rowid');
+}
+
+1;
+
+=head1 NAME 
+
+DBIx::Class::PK::Auto::SQLite - Automatic primary key class for SQLite
+
+=head1 SYNOPSIS
+
+  # In your table classes
+  __PACKAGE__->load_components(qw/PK::Auto::SQLite Core/);
+  __PACKAGE__->set_primary_key('id');
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for SQLite.
+
+=head1 AUTHORS
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBIx/Class/Storage/DBI/mysql.pm b/lib/DBIx/Class/Storage/DBI/mysql.pm
new file mode 100644
index 0000000..dcd124f
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/mysql.pm
@@ -0,0 +1,38 @@
+package DBIx::Class::Storage::DBI::mysql;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+# __PACKAGE__->load_components(qw/PK::Auto/);
+
+sub last_insert_id {
+  return $_[0]->_dbh->{mysql_insertid};
+}
+
+1;
+
+=head1 NAME 
+
+DBIx::Class::Storage::DBI::mysql - Automatic primary key class for MySQL
+
+=head1 SYNOPSIS
+
+  # In your table classes
+  __PACKAGE__->load_components(qw/PK::Auto Core/);
+  __PACKAGE__->set_primary_key('id');
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for MySQL.
+
+=head1 AUTHORS
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
diff --git a/t/basicrels/20db2.t b/t/basicrels/20db2.t
new file mode 100644
index 0000000..a5695fe
--- /dev/null
+++ b/t/basicrels/20db2.t
@@ -0,0 +1,7 @@
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/21db2.tl";
+run_tests(DBICTest->schema);
diff --git a/t/run/10auto.tl b/t/run/10auto.tl
index 6e474a5..3d2a038 100644
--- a/t/run/10auto.tl
+++ b/t/run/10auto.tl
@@ -3,7 +3,7 @@ my $schema = shift;
 
 plan tests => 2;
 
-$schema->class("Artist")->load_components(qw/PK::Auto::SQLite/);
+$schema->class("Artist")->load_components(qw/PK::Auto/);
 
 # add an artist without primary key to test Auto
 my $artist = $schema->resultset("Artist")->create( { name => 'Auto' } );
diff --git a/t/run/11mysql.tl b/t/run/11mysql.tl
index 2411b96..234474f 100644
--- a/t/run/11mysql.tl
+++ b/t/run/11mysql.tl
@@ -20,7 +20,7 @@ $dbh->do("CREATE TABLE artist (artistid INTEGER NOT NULL AUTO_INCREMENT PRIMARY
 
 #'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', '');
 
-MySQLTest::Artist->load_components('PK::Auto::MySQL');
+MySQLTest::Artist->load_components('PK::Auto');
 
 # test primary key handling
 my $new = MySQLTest::Artist->create({ name => 'foo' });
diff --git a/t/run/12pg.tl b/t/run/12pg.tl
index 22c4008..5ffef5c 100644
--- a/t/run/12pg.tl
+++ b/t/run/12pg.tl
@@ -16,7 +16,7 @@ my $dbh = PgTest->schema->storage->dbh;
 
 $dbh->do("CREATE TABLE artist (artistid serial PRIMARY KEY, name VARCHAR(255), charfield CHAR(10));");
 
-PgTest::Artist->load_components('PK::Auto::Pg');
+PgTest::Artist->load_components('PK::Auto');
 
 my $new = PgTest::Artist->create({ name => 'foo' });
 
diff --git a/t/run/13oracle.tl b/t/run/13oracle.tl
index e169995..42d37d3 100644
--- a/t/run/13oracle.tl
+++ b/t/run/13oracle.tl
@@ -33,7 +33,7 @@ $dbh->do(qq{
   END;
 });
 
-OraTest::Artist->load_components('PK::Auto::Oracle');
+OraTest::Artist->load_components('PK::Auto');
 
 # test primary key handling
 my $new = OraTest::Artist->create({ name => 'foo' });
diff --git a/t/run/14mssql.tl b/t/run/14mssql.tl
index 4a9e696..a6eb5b2 100644
--- a/t/run/14mssql.tl
+++ b/t/run/14mssql.tl
@@ -19,7 +19,7 @@ $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL
 
 $dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(255));");
 
-MSSQLTest::Artist->load_components('PK::Auto::MSSQL');
+MSSQLTest::Artist->load_components('PK::Auto');
 
 # Test PK
 my $new = MSSQLTest::Artist->create( { name => 'foo' } );
diff --git a/t/run/21db2.tl b/t/run/21db2.tl
new file mode 100644
index 0000000..4c860bf
--- /dev/null
+++ b/t/run/21db2.tl
@@ -0,0 +1,73 @@
+sub run_tests {
+my $schema = shift;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_DB2_${_}" } qw/DSN USER PASS/};
+
+#warn "$dsn $user $pass";
+
+plan skip_all, 'Set $ENV{DBICTEST_DB2_DSN}, _USER and _PASS to run this test'
+  unless ($dsn && $user);
+
+plan tests => 5;
+
+DBICTest::Schema->compose_connection('DB2Test' => $dsn, $user, $pass);
+
+my $dbh = DB2Test->schema->storage->dbh;
+
+$dbh->do("DROP TABLE artist;");
+
+$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10));");
+
+#'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', '');
+
+DB2Test::Artist->load_components('PK::Auto');
+
+# test primary key handling
+my $new = DB2Test::Artist->create({ name => 'foo' });
+ok($new->artistid, "Auto-PK worked");
+
+# test LIMIT support
+for (1..6) {
+    DB2Test::Artist->create({ name => 'Artist ' . $_ });
+}
+my $it = DB2Test::Artist->search( {},
+    { rows => 3,
+      order_by => 'artistid'
+      }
+);
+is( $it->count, 3, "LIMIT count ok" );
+is( $it->next->name, "Artist 2", "iterator->next ok" );
+$it->next;
+$it->next;
+is( $it->next, undef, "next past end of resultset ok" );
+
+my $test_type_info = {
+    'artistid' => {
+        'data_type' => 'INTEGER',
+        'is_nullable' => 0,
+        'size' => 11
+    },
+    'name' => {
+        'data_type' => 'VARCHAR',
+        'is_nullable' => 1,
+        'size' => 255
+    },
+    'charfield' => {
+        'data_type' => 'VARCHAR',
+        'is_nullable' => 1,
+        'size' => 10 
+    },
+};
+
+
+my $type_info = DB2Test->schema->storage->columns_info_for('artist');
+is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
+
+
+
+# clean up our mess
+$dbh->do("DROP TABLE artist");
+
+}
+
+1;