Merge 'trunk' into 'DBIx-Class-C3'
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / UUIDColumns.pm
CommitLineData
7da9cd47 1package DBIx::Class::UUIDColumns;
1edd1722 2use base qw/DBIx::Class/;
7da9cd47 3
4use Data::UUID;
5
6__PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] );
7
8=head1 NAME
9
10DBIx::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
20This L<DBIx::Class> component resambles the behaviour of
21L<Class::DBI::UUID>, to make some columns implicitly created as uuid.
22
23Note 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
34sub uuid_columns {
35 my $self = shift;
36 for (@_) {
103647d5 37 die "column $_ doesn't exist" unless $self->has_column($_);
7da9cd47 38 }
39 $self->uuid_auto_columns(\@_);
40}
41
42sub insert {
43 my ($self) = @_;
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 }
147dd158 48 $self->next::method;
7da9cd47 49}
50
51sub get_uuid {
52 return Data::UUID->new->to_string(Data::UUID->new->create),
53}
54
55=back
56
57=head1 AUTHORS
58
59Chia-liang Kao <clkao@clkao.org>
60
61=head1 LICENSE
62
63You may distribute this code under the same terms as Perl itself.
64
65=cut
66
671;