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::Data::Accessor/;
   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.02000';
  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     } else {
  82         die 'no suitable uuid module could be found for use with DBIx::Class::UUIDColumns';
  83     };
  84 };
  85
  86 1;
  87 __END__
  88
  89 =head1 NAME
  90
  91 DBIx::Class::UUIDColumns - Implicit uuid columns
  92
  93 =head1 SYNOPSIS
  94
  95 In your L<DBIx::Class> table class:
  96
  97   __PACKAGE__->load_components(qw/UUIDColumns ... Core/);
  98   __PACKAGE__->uuid_columns('artist_id');
  99
 100 B<Note:> The component needs to be loaded I<before> Core.
 101
 102 =head1 DESCRIPTION
 103
 104 This L<DBIx::Class> component resembles the behaviour of L<Class::DBI::UUID>,
 105 to make some columns implicitly created as uuid.
 106
 107 When loaded, C<UUIDColumns> will search for a suitable uuid generation module
 108 from the following list of supported modules:
 109
 110   Data::UUID
 111   APR::UUID*
 112   UUID
 113   Win32::Guidgen
 114   Win32API::GUID
 115
 116 If no supporting module can be found, an exception will be thrown.
 117
 118 *APR::UUID will not be loaded under OpenBSD due to an as yet unidentified XS
 119 issue.
 120
 121 If you would like to use a specific module, you can set L</uuid_class>:
 122
 123   __PACKAGE__->uuid_class('::Data::UUID');
 124   __PACKAGE__->uuid_class('MyUUIDGenerator');
 125
 126 =head1 METHODS
 127
 128 =head2 get_uuid
 129
 130 Returns a uuid string from the current uuid_maker.
 131
 132 =head2 insert
 133
 134 Inserts a new uuid string into each column in L</uuid_columns>.
 135
 136 =head2 uuid_columns
 137
 138 Gets/sets the list of columns to be filled with uuids during insert.
 139
 140   __PACKAGE__->uuid_columns('artist_id');
 141
 142 =head2 uuid_class
 143
 144 Takes the name of a UUIDMaker subclass to be used for uuid value generation.
 145 This can be a fully qualified class name, or a shortcut name starting with ::
 146 that matches one of the available L<DBIx::Class::UUIDColumns::UUIDMaker> subclasses:
 147
 148   __PACKAGE__->uuid_class('CustomUUIDGenerator');
 149   # loads CustomeUUIDGenerator
 150
 151   __PACKAGE__->uuid_class('::Data::UUID');
 152   # loads DBIx::Class::UUIDMaker::Data::UUID;
 153
 154 Note that C<uuid_class> checks to see that the specified class isa
 155 L<DBIx::Class::UUIDColumns::UUIDMaker> subclass and throws and exception if it isn't.
 156
 157 =head2 uuid_maker
 158
 159 Returns the current UUIDMaker instance for the given module.
 160
 161   my $uuid = __PACKAGE__->uuid_maker->as_string;
 162
 163 =head1 SEE ALSO
 164
 165 L<DBIx::Class::UUIDColumns::UUIDMaker>
 166
 167 =head1 AUTHOR
 168
 169 Chia-liang Kao <clkao@clkao.org>
 170
 171 =head1 CONTRIBUTERS
 172
 173 Chris Laco <claco@chrislaco.com>
 174
 175 =head1 LICENSE
 176
 177 You may distribute this code under the same terms as Perl itself.