From: Jess Robinson Date: Thu, 9 Feb 2006 21:04:48 +0000 (+0000) Subject: Shovelling PK::Auto stuff where it belongs.. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=843f8ecda2d9885b79402416f048016c1ecc4114;p=dbsrgits%2FDBIx-Class-Historic.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 + +=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 + +Scott Connelly + +=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 + +=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 + +=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 + +=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;