[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