lib/DBIx/Class/UUIDColumns.pm

   1 package DBIx::Class::UUIDColumns;
   2 use base qw/DBIx::Class/;
   3
   4 use Carp qw/croak/;
   5
   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
  29 =head2 uuid_columns
  30
  31 =cut
  32
  33 # be compatible with Class::DBI::UUID
  34 sub uuid_columns {
  35     my $self = shift;
  36     for (@_) {
  37         croak "column $_ doesn't exist" unless $self->has_column($_);
  38     }
  39     $self->uuid_auto_columns(\@_);
  40 }
  41
  42 sub insert {
  43     my $self = shift;
  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 =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;