lib/DBIx/Class/UUIDColumns.pm

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