add_relationship, relationship_info, relationships moved to ResultSource
[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 =head2 uuid_columns
28
29 =cut
30
31 # be compatible with Class::DBI::UUID
32 sub uuid_columns {
33     my $self = shift;
34     for (@_) {
35         die "column $_ doesn't exist" unless $self->has_column($_);
36     }
37     $self->uuid_auto_columns(\@_);
38 }
39
40 sub insert {
41     my ($self) = @_;
42     for my $column (@{$self->uuid_auto_columns}) {
43         $self->store_column( $column, $self->get_uuid )
44             unless defined $self->get_column( $column );
45     }
46     $self->next::method;
47 }
48
49 sub get_uuid {
50     return Data::UUID->new->to_string(Data::UUID->new->create),
51 }
52
53 =head1 AUTHORS
54
55 Chia-liang Kao <clkao@clkao.org>
56
57 =head1 LICENSE
58
59 You may distribute this code under the same terms as Perl itself.
60
61 =cut
62
63 1;