X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FUUIDColumns.pm;h=fdd6adced783140bceee370de86ab4a0b2dc548c;hb=77d6b403a25fbc60eccf11e0466ab4ce5b255a4b;hp=c15dd1a9958e9eebacb4742c7457cb25728a5876;hpb=7daf649db5e644ea6d26a12f2caba1582bed6224;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/UUIDColumns.pm b/lib/DBIx/Class/UUIDColumns.pm index c15dd1a..fdd6adc 100644 --- a/lib/DBIx/Class/UUIDColumns.pm +++ b/lib/DBIx/Class/UUIDColumns.pm @@ -1,4 +1,8 @@ package DBIx::Class::UUIDColumns; + +use strict; +use warnings; + use base qw/DBIx::Class/; __PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] ); @@ -9,7 +13,7 @@ __PACKAGE__->uuid_class( __PACKAGE__->_find_uuid_module ); sub uuid_columns { my $self = shift; for (@_) { - $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_); + $self->throw_exception("column $_ doesn't exist") unless $self->has_column($_); } $self->uuid_auto_columns(\@_); } @@ -35,107 +39,8 @@ sub uuid_class { sub insert { my $self = shift; for my $column (@{$self->uuid_auto_columns}) { - $self->store_column( $column, $self->get_uuid ) - unless defined $self->get_column( $column ); - } - $self->next::method(@_); -} - -sub get_uuid { - return shift->uuid_maker->as_string; -} - -sub _find_uuid_module { - if (eval{require Data::UUID}) { - return '::Data::UUID'; - } elsif ($^O ne 'openbsd' && eval{require APR::UUID}) { - # APR::UUID on openbsd causes some as yet unfound nastyness for XS - return '::APR::UUID'; - } elsif (eval{require UUID}) { - return '::UUID'; - } elsif (eval{ - # squelch the 'too late for INIT' warning in Win32::API::Type - local $^W = 0; - require Win32::Guidgen; - }) { - return '::Win32::Guidgen'; - } elsif (eval{require Win32API::GUID}) { - return '::Win32API::GUID'; - } else { - shift->throw_exception('no suitable uuid module could be found') - }; -}; - -1; -__END__ - -=head1 NAME - -DBIx::Class::UUIDColumns - Implicit uuid columns - -=head1 SYNOPSIS - - package Artist; - __PACKAGE__->load_components(qw/UUIDColumns Core DB/); - __PACKAGE__->uuid_columns( 'artist_id' ); - -=head1 DESCRIPTION - -This L component resembles the behaviour of -L, to make some columns implicitly created as uuid. - -When loaded, C will search for a suitable uuid generation module -from the following list of supported modules: - - Data::UUID - APR::UUID* - UUID - Win32::Guidgen - Win32API::GUID - -If no supporting module can be found, an exception will be thrown. - -*APR::UUID will not be loaded under OpenBSD due to an as yet unidentified XS -issue. - -If you would like to use a specific module, you can set C: - - __PACKAGE__->uuid_class('::Data::UUID'); - __PACKAGE__->uuid_class('MyUUIDGenerator'); - -Note that the component needs to be loaded before Core. - -=head1 METHODS - -=head2 uuid_columns(@columns) - -Takes a list of columns to be filled with uuids during insert. - - __PACKAGE__->uuid_columns('id'); - -sub uuid_class { - my ($self, $class) = @_; - - if ($class) { - $class = "DBIx::Class::UUIDMaker$class" if $class =~ /^::/; - - if (!eval "require $class") { - $self->throw_exception("$class could not be loaded: $@"); - } elsif (!$class->isa('DBIx::Class::UUIDMaker')) { - $self->throw_exception("$class is not a UUIDMaker subclass"); - } else { - $self->uuid_maker($class->new); - }; - }; - - return ref $self->uuid_maker; -}; - -sub insert { - my $self = shift; - for my $column (@{$self->uuid_auto_columns}) { - $self->store_column( $column, $self->get_uuid ) - unless defined $self->get_column( $column ); + $self->store_column( $column, $self->get_uuid ) + unless defined $self->get_column( $column ); } $self->next::method(@_); } @@ -148,7 +53,7 @@ sub _find_uuid_module { if (eval{require Data::UUID}) { return '::Data::UUID'; } elsif ($^O ne 'openbsd' && eval{require APR::UUID}) { - # APR::UUID on openbsd causes some as yet unfound nastyness for XS + # APR::UUID on openbsd causes some as yet unfound nastiness for XS return '::APR::UUID'; } elsif (eval{require UUID}) { return '::UUID';