$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);
}
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);
return \%result;
}
+sub last_insert_id {
+ my ($self, $row) = @_;
+
+ return $self->dbh->func('last_insert_rowid');
+
+}
+
+
+
sub DESTROY { shift->disconnect }
1;
--- /dev/null
+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
--- /dev/null
+package DBIx::Class::Storage::DBI::MSSQL;\r
+\r
+use strict;\r
+use warnings;\r
+\r
+use base qw/DBIx::Class::Storage::DBI/;\r
+\r
+# __PACKAGE__->load_components(qw/PK::Auto/);\r
+\r
+sub last_insert_id {\r
+ my( $id ) = $_[0]->_dbh->selectrow_array('SELECT @@IDENTITY' );\r
+ return $id;\r
+}\r
+\r
+1;\r
+\r
+=head1 NAME \r
+\r
+DBIx::Class::Storage::DBI::MSSQL - Automatic primary key class for MSSQL\r
+\r
+=head1 SYNOPSIS\r
+\r
+ # In your table classes\r
+ __PACKAGE__->load_components(qw/PK::Auto Core/);\r
+ __PACKAGE__->set_primary_key('id');\r
+\r
+=head1 DESCRIPTION\r
+\r
+This class implements autoincrements for MSSQL.\r
+\r
+=head1 AUTHORS\r
+\r
+Brian Cassidy <bricas@cpan.org>\r
+\r
+=head1 LICENSE\r
+\r
+You may distribute this code under the same terms as Perl itself.\r
+\r
+=cut\r
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::BasicRels;
+
+require "t/run/21db2.tl";
+run_tests(DBICTest->schema);
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' } );
#'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' });
$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' });
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' });
\r
$dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(255));");\r
\r
-MSSQLTest::Artist->load_components('PK::Auto::MSSQL');\r
+MSSQLTest::Artist->load_components('PK::Auto');\r
\r
# Test PK\r
my $new = MSSQLTest::Artist->create( { name => 'foo' } );\r
--- /dev/null
+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;
projects / dbsrgits/DBIx-Class.git / commitdiff