lib/DBIx/Class/UUIDColumns.pm

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