[Dbix-class] PK::Auto::Pg patch

[Matt S Trout]

This looks sane to me. Would the Pg users among us care to try it and report
back? 0.04001 beckons :)

On Sun, Dec 11, 2005 at 01:01:28AM -0500, mbailey at vortexit.net wrote:
> Index: t/run/12pg.tl
> ===================================================================
> --- t/run/12pg.tl	(revision 380)
> +++ t/run/12pg.tl	(working copy)
> @@ -7,7 +7,7 @@
>  plan skip_all, 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
>    unless ($dsn && $user);
>  
> -plan tests => 1;
> +plan tests => 2;
>  
>  DBICTest::Schema->compose_connection('PgTest' => $dsn, $user, $pass);
>  
> @@ -23,8 +23,12 @@
>  
>  my $new = PgTest::Artist->create({ name => 'foo' });
>  
> -ok($new->artistid, "Auto-PK worked");
> +is($new->artistid, 1, "Auto-PK worked");
>  
> +my $new = PgTest::Artist->create({ name => 'bar' });
> +
> +is($new->artistid, 2, "Auto-PK worked");
> +
>  }
>  
>  1;
> Index: lib/DBIx/Class/PK/Auto/Pg.pm
> ===================================================================
> --- lib/DBIx/Class/PK/Auto/Pg.pm	(revision 380)
> +++ lib/DBIx/Class/PK/Auto/Pg.pm	(working copy)
> @@ -16,6 +16,7 @@
>  
>  sub get_autoinc_seq {
>    my $self=shift;
> +  my ( @pri_keys); 
>    
>    # return the user-defined sequence if known
>    if ($self->sequence) {
> @@ -23,13 +24,15 @@
>    }
>    
>    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)\)!;
> -      }
> +  (@pri_keys) = map ( ($dbh->column_info(undef,undef,$self->_table_name,$_)),
> +                    ($dbh->primary_key(undef,undef,$self->_table_name)));
> +  while( my $p_key = pop @pri_keys){
> +    my $d_seq_name = $p_key->fetchrow_arrayref->[12];
> +    if(defined $d_seq_name && $d_seq_name =~ /^nextval/) {
> +   	  ($self->{_autoinc_seq}) = $d_seq_name =~ 
> +  	   m!^nextval\('"?([^"']+)"?'::(?:text|regclass)\)!;
>      }
> +  }
>  }
>  
>  1;
> @@ -39,7 +42,30 @@
>  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.
> _______________________________________________
> List: http://lists.rawmode.org/cgi-bin/mailman/listinfo/dbix-class
> Wiki: http://dbix-class.shadowcatsystems.co.uk/
> IRC: irc.perl.org#dbix-class
> SVN: http://dev.catalyst.perl.org/repos/bast/trunk/DBIx-Class/

-- 
     Matt S Trout       Offering custom development, consultancy and support
  Technical Director    contracts for Catalyst, DBIx::Class and BAST. Contact
Shadowcat Systems Ltd.  mst (at) shadowcatsystems.co.uk for more information

 + Help us build a better perl ORM: http://dbix-class.shadowcatsystems.co.uk/ +