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