lib/DBIx/Class/UUIDColumns.pm

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