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