Commit | Line | Data |
7da9cd47 |
1 | package DBIx::Class::UUIDColumns; |
1edd1722 |
2 | use base qw/DBIx::Class/; |
7da9cd47 |
3 | |
aa562407 |
4 | use Carp qw/croak/; |
5 | |
7da9cd47 |
6 | use Data::UUID; |
7 | |
8 | __PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] ); |
9 | |
10 | =head1 NAME |
11 | |
12 | DBIx::Class::UUIDColumns - Implicit uuid columns |
13 | |
14 | =head1 SYNOPSIS |
15 | |
16 | pacakge Artist; |
17 | __PACKAGE__->load_components(qw/UUIDColumns Core DB/); |
18 | __PACKAGE__->uuid_columns( 'artist_id' );x |
19 | |
20 | =head1 DESCRIPTION |
21 | |
22 | This L<DBIx::Class> component resambles the behaviour of |
23 | L<Class::DBI::UUID>, to make some columns implicitly created as uuid. |
24 | |
25 | Note that the component needs to be loaded before Core. |
26 | |
27 | =head1 METHODS |
28 | |
8091aa91 |
29 | =head2 uuid_columns |
7da9cd47 |
30 | |
31 | =cut |
32 | |
33 | # be compatible with Class::DBI::UUID |
34 | sub uuid_columns { |
35 | my $self = shift; |
36 | for (@_) { |
aa562407 |
37 | croak "column $_ doesn't exist" unless $self->has_column($_); |
7da9cd47 |
38 | } |
39 | $self->uuid_auto_columns(\@_); |
40 | } |
41 | |
42 | sub insert { |
3b7992e1 |
43 | my $self = shift; |
7da9cd47 |
44 | for my $column (@{$self->uuid_auto_columns}) { |
103647d5 |
45 | $self->store_column( $column, $self->get_uuid ) |
46 | unless defined $self->get_column( $column ); |
7da9cd47 |
47 | } |
3b7992e1 |
48 | $self->next::method(@_); |
7da9cd47 |
49 | } |
50 | |
51 | sub get_uuid { |
52 | return Data::UUID->new->to_string(Data::UUID->new->create), |
53 | } |
54 | |
7da9cd47 |
55 | =head1 AUTHORS |
56 | |
57 | Chia-liang Kao <clkao@clkao.org> |
58 | |
59 | =head1 LICENSE |
60 | |
61 | You may distribute this code under the same terms as Perl itself. |
62 | |
63 | =cut |
64 | |
65 | 1; |