Commit | Line | Data |
b8e1e21f |
1 | package DBIx::Class::PK::Auto; |
2 | |
773e3015 |
3 | #use base qw/DBIx::Class::PK/; |
4 | use base qw/DBIx::Class/; |
b8e1e21f |
5 | use strict; |
6 | use warnings; |
7 | |
75d07914 |
8 | =head1 NAME |
34d52be2 |
9 | |
eb49d4e3 |
10 | DBIx::Class::PK::Auto - Automatic primary key class |
34d52be2 |
11 | |
12 | =head1 SYNOPSIS |
13 | |
77254782 |
14 | __PACKAGE__->load_components(qw/PK::Auto Core/); |
15 | __PACKAGE__->set_primary_key('id'); |
6718c5f0 |
16 | |
34d52be2 |
17 | =head1 DESCRIPTION |
18 | |
eb49d4e3 |
19 | This class overrides the insert method to get automatically incremented primary |
20 | keys. |
34d52be2 |
21 | |
77254782 |
22 | __PACKAGE__->load_components(qw/PK::Auto Core/); |
f4ccda68 |
23 | |
e2441ae6 |
24 | Note that C<PK::Auto> is specified as the left of the Core component. |
25 | See L<DBIx::Class::Manual::Component> for details of component interactions. |
7624b19f |
26 | |
c8f4b52b |
27 | =head1 LOGIC |
28 | |
eb49d4e3 |
29 | C<PK::Auto> does this by letting the database assign the primary key field and |
30 | fetching the assigned value afterwards. |
c8f4b52b |
31 | |
34d52be2 |
32 | =head1 METHODS |
33 | |
130c6439 |
34 | =head2 insert |
34d52be2 |
35 | |
eb49d4e3 |
36 | Overrides C<insert> so that it will get the value of autoincremented primary |
37 | keys. |
34d52be2 |
38 | |
39 | =cut |
40 | |
b8e1e21f |
41 | sub insert { |
42 | my ($self, @rest) = @_; |
147dd158 |
43 | my $ret = $self->next::method(@rest); |
0675cd04 |
44 | |
ca48cd7d |
45 | my ($pri, $too_many) = grep { !defined $self->get_column($_) } $self->primary_columns; |
46 | return $ret unless defined $pri; # if all primaries are already populated, skip auto-inc |
701da8c4 |
47 | $self->throw_exception( "More than one possible key found for auto-inc on ".ref $self ) |
ca48cd7d |
48 | if defined $too_many; |
49 | |
fefe2816 |
50 | my $storage = $self->result_source->storage; |
51 | $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" ) unless $storage->can('last_insert_id'); |
52 | my $id = $storage->last_insert_id($self->result_source,$pri); |
ca48cd7d |
53 | $self->throw_exception( "Can't get last insert id" ) unless $id; |
54 | $self->store_column($pri => $id); |
55 | |
b8e1e21f |
56 | return $ret; |
57 | } |
58 | |
130c6439 |
59 | =head2 sequence |
97cc0025 |
60 | |
61 | Manually define the correct sequence for your table, to avoid the overhead |
62 | associated with looking up the sequence automatically. |
63 | |
64 | =cut |
65 | |
ecb6488f |
66 | sub sequence { |
67 | my ($self,$seq) = @_; |
68 | foreach my $pri ($self->primary_columns) { |
69 | $self->column_info($pri)->{sequence} = $seq; |
70 | } |
71 | } |
97cc0025 |
72 | |
b8e1e21f |
73 | 1; |
34d52be2 |
74 | |
34d52be2 |
75 | =head1 AUTHORS |
76 | |
daec44b8 |
77 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
34d52be2 |
78 | |
79 | =head1 LICENSE |
80 | |
81 | You may distribute this code under the same terms as Perl itself. |
82 | |
83 | =cut |