lib/DBIx/Class/UUIDColumns.pm

   1 package DBIx::Class::UUIDColumns;
   2 use base qw/DBIx::Class/;
   3
   4 __PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] );
   5 __PACKAGE__->mk_classdata( 'uuid_maker' );
   6 __PACKAGE__->uuid_class( __PACKAGE__->_find_uuid_module );
   7
   8 # be compatible with Class::DBI::UUID
   9 sub uuid_columns {
  10     my $self = shift;
  11     for (@_) {
  12         $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
  13     }
  14     $self->uuid_auto_columns(\@_);
  15 }
  16
  17 sub uuid_class {
  18     my ($self, $class) = @_;
  19
  20     if ($class) {
  21         $class = "DBIx::Class::UUIDMaker$class" if $class =~ /^::/;
  22
  23         if (!eval "require $class") {
  24             $self->throw_exception("$class could not be loaded: $@");
  25         } elsif (!$class->isa('DBIx::Class::UUIDMaker')) {
  26             $self->throw_exception("$class is not a UUIDMaker subclass");
  27         } else {
  28             $self->uuid_maker($class->new);
  29         };
  30     };
  31
  32     return ref $self->uuid_maker;
  33 };
  34
  35 sub insert {
  36     my $self = shift;
  37     for my $column (@{$self->uuid_auto_columns}) {
  38         $self->store_column( $column, $self->get_uuid )
  39             unless defined $self->get_column( $column );
  40     }
  41     $self->next::method(@_);
  42 }
  43
  44 sub get_uuid {
  45     return shift->uuid_maker->as_string;
  46 }
  47
  48 sub _find_uuid_module {
  49     if (eval{require Data::UUID}) {
  50         return '::Data::UUID';
  51     } elsif ($^O ne 'openbsd' && eval{require APR::UUID}) {
  52         # APR::UUID on openbsd causes some as yet unfound nastyness for XS
  53         return '::APR::UUID';
  54     } elsif (eval{require UUID}) {
  55         return '::UUID';
  56     } elsif (eval{
  57             # squelch the 'too late for INIT' warning in Win32::API::Type
  58             local $^W = 0;
  59             require Win32::Guidgen;
  60         }) {
  61         return '::Win32::Guidgen';
  62     } elsif (eval{require Win32API::GUID}) {
  63         return '::Win32API::GUID';
  64     } else {
  65         shift->throw_exception('no suitable uuid module could be found')
  66     };
  67 };
  68
  69 1;
  70 __END__
  71
  72 =head1 NAME
  73
  74 DBIx::Class::UUIDColumns - Implicit uuid columns
  75
  76 =head1 SYNOPSIS
  77
  78   package Artist;
  79   __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
  80   __PACKAGE__->uuid_columns( 'artist_id' );
  81
  82 =head1 DESCRIPTION
  83
  84 This L<DBIx::Class> component resembles the behaviour of
  85 L<Class::DBI::UUID>, to make some columns implicitly created as uuid.
  86
  87 When loaded, C<UUIDColumns> will search for a suitable uuid generation module
  88 from the following list of supported modules:
  89
  90   Data::UUID
  91   APR::UUID*
  92   UUID
  93   Win32::Guidgen
  94   Win32API::GUID
  95
  96 If no supporting module can be found, an exception will be thrown.
  97
  98 *APR::UUID will not be loaded under OpenBSD due to an as yet unidentified XS
  99 issue.
 100
 101 If you would like to use a specific module, you can set C<uuid_class>:
 102
 103   __PACKAGE__->uuid_class('::Data::UUID');
 104   __PACKAGE__->uuid_class('MyUUIDGenerator');
 105
 106 Note that the component needs to be loaded before Core.
 107
 108 =head1 METHODS
 109
 110 =head2 uuid_columns(@columns)
 111
 112 Takes a list of columns to be filled with uuids during insert.
 113
 114   __PACKAGE__->uuid_columns('id');
 115
 116 =head2 uuid_class($classname)
 117
 118 Takes the name of a UUIDMaker subclass to be used for uuid value generation.
 119 This can be a fully qualified class name, or a shortcut name starting with ::
 120 that matches one of the available DBIx::Class::UUIDMaker subclasses:
 121
 122   __PACKAGE__->uuid_class('CustomUUIDGenerator');
 123   # loads CustomeUUIDGenerator
 124
 125   __PACKAGE->uuid_class('::Data::UUID');
 126   # loads DBIx::Class::UUIDMaker::Data::UUID;
 127
 128 Note that C<uuid_class> chacks to see that the specified class isa
 129 DBIx::Class::UUIDMaker subbclass and throws and exception if it isn't.
 130
 131 =head2 uuid_maker
 132
 133 Returns the current UUIDMaker instance for the given module.
 134
 135   my $uuid = __PACKAGE__->uuid_maker->as_string;
 136
 137 =head1 SEE ALSO
 138
 139 L<DBIx::Class::UUIDMaker>
 140
 141 =head1 AUTHORS
 142
 143 Chia-liang Kao <clkao@clkao.org>
 144 Chris Laco <claco@chrislaco.com>
 145
 146 =head1 LICENSE
 147
 148 You may distribute this code under the same terms as Perl itself.