Commit | Line | Data |
b8e1e21f |
1 | package DBIx::Class::PK::Auto; |
2 | |
97cc0025 |
3 | use base qw/Class::Data::Inheritable/; |
b8e1e21f |
4 | use strict; |
5 | use warnings; |
6 | |
34d52be2 |
7 | =head1 NAME |
8 | |
9 | DBIx::Class::PK::Auto - Automatic Primary Key class |
10 | |
11 | =head1 SYNOPSIS |
12 | |
13 | =head1 DESCRIPTION |
14 | |
15 | This class overrides the insert method to get automatically |
16 | incremented primary keys. |
17 | |
7624b19f |
18 | You don't want to be using this directly - instead load the appropriate |
19 | one for your database, e.g. PK::Auto::SQLite |
20 | |
34d52be2 |
21 | =head1 METHODS |
22 | |
23 | =over 4 |
24 | |
25 | =item insert |
26 | |
27 | Overrides insert so that it will get the value of autoincremented |
28 | primary keys. |
29 | |
30 | =cut |
31 | |
b8e1e21f |
32 | sub insert { |
33 | my ($self, @rest) = @_; |
34 | my $ret = $self->NEXT::ACTUAL::insert(@rest); |
0675cd04 |
35 | |
36 | # if all primaries are already populated, skip auto-inc |
37 | my $populated = 0; |
38 | map { $populated++ if $self->$_ } keys %{ $self->_primaries }; |
39 | return $ret if ( $populated == scalar keys %{ $self->_primaries } ); |
40 | |
b8e1e21f |
41 | my ($pri, $too_many) = |
42 | (grep { $self->_primaries->{$_}{'auto_increment'} } |
43 | keys %{ $self->_primaries }) |
44 | || (keys %{ $self->_primaries }); |
78bab9ca |
45 | $self->throw( "More than one possible key found for auto-inc on ".ref $self ) |
b8e1e21f |
46 | if $too_many; |
c1d23573 |
47 | unless (defined $self->get_column($pri)) { |
78bab9ca |
48 | $self->throw( "Can't auto-inc for $pri on ".ref $self.": no _last_insert_id method" ) |
126042ee |
49 | unless $self->can('last_insert_id'); |
50 | my $id = $self->last_insert_id; |
78bab9ca |
51 | $self->throw( "Can't get last insert id" ) unless $id; |
b8e1e21f |
52 | $self->store_column($pri => $id); |
53 | } |
54 | return $ret; |
55 | } |
56 | |
97cc0025 |
57 | =item sequence |
58 | |
59 | Manually define the correct sequence for your table, to avoid the overhead |
60 | associated with looking up the sequence automatically. |
61 | |
62 | =cut |
63 | |
64 | __PACKAGE__->mk_classdata('sequence'); |
65 | |
b8e1e21f |
66 | 1; |
34d52be2 |
67 | |
68 | =back |
69 | |
70 | =head1 AUTHORS |
71 | |
daec44b8 |
72 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
34d52be2 |
73 | |
74 | =head1 LICENSE |
75 | |
76 | You may distribute this code under the same terms as Perl itself. |
77 | |
78 | =cut |
79 | |