[Dbix-class] PK::Sequence

[Lee Standen]

Hi Guys,

I've build PK::Sequence...apologies in advance, but i'm having issues 
getting this to work in the current SVN build for some reason...i'm 
probably doing something silly (again).  As a result, i'm going to 
include the PK::Sequence file, and the functions for Pg, since 
i've tested it as working.

I'll include the DB2 and Oracle functions too, but I don't have a copy of 
Oracle to test it.  I kind of got the DB2 one to work, but I an into the 
SVN problems with it too :)


DB2 Function: File - DBIx::Class::Storage::DBI::DB2.pm
--------------------------------------------------------------------------
sub seq_nextval {
     my ($self,$seq) = @_;

     my $dbh = $self->dbh;
     my $sth = $dbh->prepare_cached("NEXTVAL FOR ?");

     $sth->execute($seq);
     my $id = $sth->fetchrow_arrayref()->[0];
     $sth->finish();
     return $id;
}
--------------------------------------------------------------------------


Pg Function: File - DBIx::Class::Storage::DBI::Pg.pm
--------------------------------------------------------------------------
sub seq_nextval {
     my ($self,$seq) = @_;

     my $dbh = $self->dbh;
     my $sth = $dbh->prepare_cached("SELECT nextval(?)");

     $sth->execute($seq);
     my $id = $sth->fetchrow_arrayref()->[0];
     $sth->finish();

     return $id;
}
--------------------------------------------------------------------------


Oracle Function: File - DBIx::Class::Storage::DBI::Oracle.pm
--------------------------------------------------------------------------
sub seq_nextval {
     my ($self,$seq) = @_;

     my $dbh = $self->dbh;
     my $sth = $dbh->prepare_cached("SELECT $seq.nextval");

     $sth->execute($seq);
     my $id = $sth->fetchrow_arrayref()->[0];
     return $id;
}
--------------------------------------------------------------------------


It would probably make sense to put a standard 'someone hasn't written 
this function' message into DBIx::Class::Storage::DBI.pm, but i'll leave 
that up to the masters :)

Thanks :)
-------------- next part --------------
Index: Sequence.pm
===================================================================
--- Sequence.pm	(revision 0)
+++ Sequence.pm	(revision 0)
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+package DBIx::Class::PK::Sequence;
+
+=head2 NAME
+
+DBIx::Class::PK::Sequence - support for named sequences on inserting rows
+
+=head2 SYNOPSYS
+
+Allows you to use a standalone sequence (created with the standard CREATE
+SEQUENCE command) to populate the primary key column of a table upon inserts.
+
+=head2 USAGE
+
+Add the B<sequence> key to your column definitions, for example:
+
+    package My::Schema::Table;
+    __PACKAGE__->load_components( qw/PK::Sequence Core/ );
+
+    __PACKAGE__->add_column( 
+        table_id => {
+            data_type => 'integer',
+            sequence => 'seq_table_pk',
+            },
+        username => {
+            data_type => 'varchar',
+            size => '32',
+            },
+        );
+    __PACKAGE__->set_primary_key( qw/table_id/ );
+
+Then, just insert rows as you would normally:
+
+    My::Schema->populate( 'Table', [ [qw/username/], [qw/test1/], [qw/test2] ] );
+
+This will call the driver function get_nextval with the sequence name specified and 
+insert the row.
+
+=head2 AUTHOR
+
+Lee Standen <nom at standen.id.au>
+
+=head2 ACKNOWLEDGEMENTS
+
+mst, castaway, purl :) and anyone else in #dbix-class who helped out!
+    
+=cut
+
+use base 'DBIx::Class';
+use strict;
+use warnings;
+
+sub insert {
+    my ($self, at rest) = @_;
+
+    my $storage = $self->result_source->storage();
+    $storage->ensure_connected;
+    
+    foreach my $col ($self->primary_columns) {
+        next if $self->$col;
+        if ($self->column_info($col)->{sequence}) {
+            $self->throw_exception("Missing primary key, but Storage doesn't support nextval()") unless $storage->can('seq_nextval');
+            my $id = $storage->seq_nextval( $self->column_info($col)->{sequence} );
+            $self->store_column($col => $id);
+        }
+    }
+
+    return $self->next::method(@rest);
+}
+
+
+1;