[Dbix-class]
Rewrite of PK::Auto::Pg, as well as more tests coverage
mbailey at vortexit.net
mbailey at vortexit.net
Sat Dec 10 21:49:47 CET 2005
Index: t/run/12pg.tl
===================================================================
--- t/run/12pg.tl (revision 374)
+++ t/run/12pg.tl (working copy)
@@ -1,13 +1,13 @@
sub run_tests {
-my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER
PASS/};
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_" . $_ } qw/DSN USER
PASS/};
-#warn "$dsn $user $pass";
+#warn "dsn: $dsn user: $user pass: $pass \n";
plan skip_all, 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 1;
+plan tests => 5;
DBICTest::Schema->compose_connection('PgTest' => $dsn, $user, $pass);
@@ -17,14 +17,43 @@
$dbh->do("DROP TABLE artist;");
};
+## Create Artist table with one auto-primary key
$dbh->do("CREATE TABLE artist (artistid serial PRIMARY KEY, name
VARCHAR(255));");
PgTest::Artist->load_components('PK::Auto::Pg');
-my $new = PgTest::Artist->create({ name => 'foo' });
+# Test that primary keys are correctly being returned
+my $artist1 = PgTest::Artist->create({ name => 'artist1' });
+is( $artist1->artistid, 1, "Auto-PK for first artist worked");
-ok($new->artistid, "Auto-PK worked");
+my $artist2 = PgTest::Artist->create({ name => 'artist2' });
+is( $artist2->artistid, 2, "Auto-PK for second artist worked");
+my $artist3 = PgTest::Artist->create({ name => 'artist3' });
+is( $artist3->artistid, 3, "Auto-PK for third artist worked");
+
+# Drop and recreate table with two auto-primary keys
+eval {
+ $dbh->do("DROP TABLE artist;");
+};
+
+## Create Artist table with two auto-primary keys
+$dbh->do("CREATE TABLE artist (artistid1 serial , artistid2 serial, name
VARCHAR(255), CONSTRAINT double_keys primary key(artistid1,artistid2));");
+
+# Make sure It throws a error
+throws_ok{my $double_artist = PgTest::Artist->create({ name => 'double
art' })} qr/too many/, 'Trying to catch exception for too many
auto-incrementing primary keys in this table.';
+
+# Drop and recreate table with two auto-primary keys
+eval {
+ $dbh->do("DROP TABLE artist;");
+};
+
+## Create Artist table with no auto-primary keys
+$dbh->do("CREATE TABLE artist (artistid1 integer, name VARCHAR(255));");
+
+# Make sure It throws a error
+throws_ok{my $nokey_artist = PgTest::Artist->create({ name => 'no key'
})} qr/no auto-incrementing/, 'Try to catch exception for table having no
auto-incrementing primary keys.';
+
}
1;
Index: t/helperrels/12pg.t
===================================================================
--- t/helperrels/12pg.t (revision 374)
+++ t/helperrels/12pg.t (working copy)
@@ -1,4 +1,5 @@
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
use DBICTest::HelperRels;
Index: lib/DBIx/Class/PK/Auto/Pg.pm
===================================================================
--- lib/DBIx/Class/PK/Auto/Pg.pm (revision 374)
+++ lib/DBIx/Class/PK/Auto/Pg.pm (working copy)
@@ -7,29 +7,45 @@
__PACKAGE__->load_components(qw/PK::Auto/);
-sub last_insert_id {
- my $self=shift;
- $self->get_autoinc_seq unless $self->{_autoinc_seq};
- $self->storage->dbh->last_insert_id(undef,undef,undef,undef,
- {sequence=>$self->{_autoinc_seq}});
+sub last_insert_id
+{
+ my $self=shift;
+ my ($id);
+ my $dbh=$self->storage->dbh;
+ $self->_get_autoinc_seq($dbh) unless $self->{_autoinc_seq};
+ if($self->{_autoinc_seq})
+ {
+ ($id)=$dbh->selectrow_array("select currval('$self->{_autoinc_seq}')");
+ }
+ return $id;
}
-sub get_autoinc_seq {
- my $self=shift;
-
- # return the user-defined sequence if known
- if ($self->sequence) {
- return $self->{_autoinc_seq} = $self->sequence;
- }
-
- my $dbh= $self->storage->dbh;
- my $sth = $dbh->column_info( undef, undef, $self->_table_name, '%');
- while (my $foo = $sth->fetchrow_arrayref){
- if(defined $foo->[12] && $foo->[12] =~ /^nextval/) {
- ($self->{_autoinc_seq}) = $foo->[12] =~
- m!^nextval\('"?([^"']+)"?'::(?:text|regclass)\)!;
- }
- }
+sub _get_autoinc_seq
+{
+ my $self=shift;
+ my $dbh=shift;
+ my (@pri_keys);
+ my $table_name=$self->_table_name;
+
+ # return the user-defined sequence if known
+ if ($self->sequence)
+ {
+ return $self->{_autoinc_seq} = $self->sequence;
+ }
+ @pri_keys = map ( ($dbh->column_info(undef,undef,$table_name,$_)),
($dbh->primary_key(undef,undef,$self->_table_name)));
+ if(scalar @pri_keys == 1)
+ {
+ my $pkey = $pri_keys[0];
+ ($self->{_autoinc_seq}) = $pkey->fetchrow_arrayref->[12] =~
m!^nextval\('"?([^"']+)"?'::(?:text|regclass)\)!;
+ }
+ elsif(scalar @pri_keys > 1)
+ {
+ $self->throw("Table: $table_name has too many auto-incrementing primary
keys, I can only handle one. \n");
+ }
+ else
+ {
+ $self->throw("Table: $table_name has no auto-incrementing primary keys.");
+ }
}
1;
@@ -39,14 +55,41 @@
DBIx::Class::PK::Auto::Pg - Automatic Primary Key class for Postgresql
=head1 SYNOPSIS
+# Inside Base Class
+Package MyApp::DB;
+use base qw/DBIx::Class/;
+...
+...
+
+# Inside Table Class
+
+Package MyApp::DB::Artist;
+
+use base qw/MyApp::DB/;
+
+__PACKAGE__->load_components('PK::Auto::Pg');
+...
+...
+
+# Inside your App
+# assuming that there is an auto-incrementing column artist_id in this table
+my $artist1 = MyApp::DB::Artist->create({ name => 'artist1' });
+
+# this should be the value stored in the auto-incrementing primary key
column of object
+my $id = $artist1->artist_id;
+
+
=head1 DESCRIPTION
-This class implements autoincrements for Postgresql.
+This class implements autoincrements for Postgresql. I do not suggest
loading this from your base DBIx::Class, but instead loading it from your
Table Class. Here is why:
+Do NOT load this component on a table that has more than one
auto-incrementing primary key, unless you have designated one in your
table class by calling __PACKAGE__->sequence('sequence_name').
+Do NOT load this component on a table that has no auto-incrementing
primary keys.
+Do NOT load this component on a table that has no primary keys.
=head1 AUTHORS
-Marcus Ramberg <m.ramberg at cpan.org>
+Marlon Bailey <mbailey at vortexit.net>
=head1 LICENSE
--
This message has been scanned for viruses and
dangerous content by MailScanner, and is
believed to be clean.
More information about the Dbix-class
mailing list