1 package DBIx::Class::UUIDColumns;
2 use base qw/DBIx::Class/;
4 __PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] );
5 __PACKAGE__->mk_classdata( 'uuid_maker' );
6 __PACKAGE__->uuid_class( __PACKAGE__->_find_uuid_module );
10 DBIx::Class::UUIDColumns - Implicit uuid columns
15 __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
16 __PACKAGE__->uuid_columns( 'artist_id' );
20 This L<DBIx::Class> component resembles the behaviour of
21 L<Class::DBI::UUID>, to make some columns implicitly created as uuid.
23 Note that the component needs to be loaded before Core.
31 # be compatible with Class::DBI::UUID
35 $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
37 $self->uuid_auto_columns(\@_);
41 my ($self, $class) = @_;
44 $class = "DBIx::Class::UUIDMaker$class" if $class =~ /^::/;
46 if (!eval "require $class") {
47 $self->throw_exception("$class could not be loaded: $@");
48 } elsif (!$class->isa('DBIx::Class::UUIDMaker')) {
49 $self->throw_exception("$class is not a UUIDMaker subclass");
51 $self->uuid_maker($class->new);
55 return ref $self->uuid_maker;
60 for my $column (@{$self->uuid_auto_columns}) {
61 $self->store_column( $column, $self->get_uuid )
62 unless defined $self->get_column( $column );
64 $self->next::method(@_);
68 return shift->uuid_maker->as_string;
71 sub _find_uuid_module {
72 if ($^O ne 'openbsd' && eval{require APR::UUID}) {
73 # APR::UUID on openbsd causes some as yet unfound nastyness for XS
75 } elsif (eval{require UUID}) {
77 } elsif (eval{require Data::UUID}) {
78 return '::Data::UUID';
80 # squelch the 'too late for INIT' warning in Win32::API::Type
82 require Win32::Guidgen;
84 return '::Win32::Guidgen';
85 } elsif (eval{require Win32API::GUID}) {
86 return '::Win32API::GUID';
88 shift->throw_exception('no suitable uuid module could be found')
94 Chia-liang Kao <clkao@clkao.org>
98 You may distribute this code under the same terms as Perl itself.