lib/DBIx/Class/UUIDColumns.pm

   1 package DBIx::Class::UUIDColumns;
   2 use base qw/Class::Data::Inheritable/;
   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::ACTUAL::insert;
  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;