Commit | Line | Data |
b8e1e21f |
1 | package DBIx::Class::PK::Auto; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
34d52be2 |
6 | =head1 NAME |
7 | |
8 | DBIx::Class::PK::Auto - Automatic Primary Key class |
9 | |
10 | =head1 SYNOPSIS |
11 | |
12 | =head1 DESCRIPTION |
13 | |
14 | This class overrides the insert method to get automatically |
15 | incremented primary keys. |
16 | |
17 | =head1 METHODS |
18 | |
19 | =over 4 |
20 | |
21 | =item insert |
22 | |
23 | Overrides insert so that it will get the value of autoincremented |
24 | primary keys. |
25 | |
26 | =cut |
27 | |
b8e1e21f |
28 | sub insert { |
29 | my ($self, @rest) = @_; |
30 | my $ret = $self->NEXT::ACTUAL::insert(@rest); |
31 | my ($pri, $too_many) = |
32 | (grep { $self->_primaries->{$_}{'auto_increment'} } |
33 | keys %{ $self->_primaries }) |
34 | || (keys %{ $self->_primaries }); |
78bab9ca |
35 | $self->throw( "More than one possible key found for auto-inc on ".ref $self ) |
b8e1e21f |
36 | if $too_many; |
c1d23573 |
37 | unless (defined $self->get_column($pri)) { |
78bab9ca |
38 | $self->throw( "Can't auto-inc for $pri on ".ref $self.": no _last_insert_id method" ) |
b8e1e21f |
39 | unless $self->can('_last_insert_id'); |
40 | my $id = $self->_last_insert_id; |
78bab9ca |
41 | $self->throw( "Can't get last insert id" ) unless $id; |
b8e1e21f |
42 | $self->store_column($pri => $id); |
43 | } |
44 | return $ret; |
45 | } |
46 | |
47 | 1; |
34d52be2 |
48 | |
49 | =back |
50 | |
51 | =head1 AUTHORS |
52 | |
53 | Matt S. Trout <perl-stuff@trout.me.uk> |
54 | |
55 | =head1 LICENSE |
56 | |
57 | You may distribute this code under the same terms as Perl itself. |
58 | |
59 | =cut |
60 | |