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         $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
  36     }
  37     $self->uuid_auto_columns(\@_);
  38 }
  39
  40 sub insert {
  41     my $self = shift;
  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;