X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FPK%2FAuto.pm;h=b7ebda70937e8a584712ce3ef9a372e6fec90962;hb=75d079145a507a0e5ff89b2676d383f4fd1a5511;hp=84e679a70a590087a841ed94feef5bf868a5b7e0;hpb=0675cd04337cafdc5a8ce19e707e3b2ce2508087;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/PK/Auto.pm b/lib/DBIx/Class/PK/Auto.pm index 84e679a..b7ebda7 100644 --- a/lib/DBIx/Class/PK/Auto.pm +++ b/lib/DBIx/Class/PK/Auto.pm @@ -1,72 +1,77 @@ package DBIx::Class::PK::Auto; -use base qw/Class::Data::Inheritable/; +#use base qw/DBIx::Class::PK/; +use base qw/DBIx::Class/; use strict; use warnings; -=head1 NAME +=head1 NAME -DBIx::Class::PK::Auto - Automatic Primary Key class +DBIx::Class::PK::Auto - Automatic primary key class =head1 SYNOPSIS +__PACKAGE__->load_components(qw/PK::Auto Core/); +__PACKAGE__->set_primary_key('id'); + =head1 DESCRIPTION -This class overrides the insert method to get automatically -incremented primary keys. +This class overrides the insert method to get automatically incremented primary +keys. -You don't want to be using this directly - instead load the appropriate -one for your database, e.g. PK::Auto::SQLite + __PACKAGE__->load_components(qw/PK::Auto Core/); -=head1 METHODS +Note that C is specified as the left of the Core component. +See L for details of component interactions. + +=head1 LOGIC -=over 4 +C does this by letting the database assign the primary key field and +fetching the assigned value afterwards. -=item insert +=head1 METHODS + +=head2 insert -Overrides insert so that it will get the value of autoincremented -primary keys. +Overrides C so that it will get the value of autoincremented primary +keys. =cut sub insert { my ($self, @rest) = @_; - my $ret = $self->NEXT::ACTUAL::insert(@rest); - - # if all primaries are already populated, skip auto-inc - my $populated = 0; - map { $populated++ if $self->$_ } keys %{ $self->_primaries }; - return $ret if ( $populated == scalar keys %{ $self->_primaries } ); - - my ($pri, $too_many) = - (grep { $self->_primaries->{$_}{'auto_increment'} } - keys %{ $self->_primaries }) - || (keys %{ $self->_primaries }); - $self->throw( "More than one possible key found for auto-inc on ".ref $self ) - if $too_many; - unless (defined $self->get_column($pri)) { - $self->throw( "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( "Can't get last insert id" ) unless $id; - $self->store_column($pri => $id); - } + my $ret = $self->next::method(@rest); + + my ($pri, $too_many) = grep { !defined $self->get_column($_) } $self->primary_columns; + return $ret unless defined $pri; # if all primaries are already populated, skip auto-inc + $self->throw_exception( "More than one possible key found for auto-inc on ".ref $self ) + if defined $too_many; + + my $storage = $self->result_source->storage; + $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" ) unless $storage->can('last_insert_id'); + my $id = $storage->last_insert_id($self->result_source,$pri); + $self->throw_exception( "Can't get last insert id" ) unless $id; + $self->store_column($pri => $id); + return $ret; } -=item sequence +=head2 sequence Manually define the correct sequence for your table, to avoid the overhead associated with looking up the sequence automatically. =cut -__PACKAGE__->mk_classdata('sequence'); +sub sequence { + my ($self,$seq) = @_; + foreach my $pri ($self->primary_columns) { + $self->column_info($pri)->{sequence} = $seq; + } +} 1; -=back - =head1 AUTHORS Matt S. Trout @@ -76,4 +81,3 @@ Matt S. Trout You may distribute this code under the same terms as Perl itself. =cut -