Here's my first crack at it. I still have to do pod, and I'm not sure what to do about the recommends: in meta.yml/build.pl or tests yet, since they assume just Data::UUID...
UUIDColumns now looks for a suitable uuid generator on the users machine
and loads the appropriate UUIDMaker subclass. You can override the
choice using uuid_class().
I've included Data::Uniqid just for grins [unique ids need not be
guids], but it is not part of the default searching. I've left those to
just the modules that return the uuids in the following format:
xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx
-=Chris
Index: C:/Development/DBIx-Class/lib/DBIx/Class/UUIDColumns.pm
===================================================================
--- C:/Development/DBIx-Class/lib/DBIx/Class/UUIDColumns.pm (revision 855)
+++ C:/Development/DBIx-Class/lib/DBIx/Class/UUIDColumns.pm (working copy)
@@ -1,9 +1,9 @@
package DBIx::Class::UUIDColumns;
use base qw/DBIx::Class/;
-use Data::UUID;
-
__PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] );
+__PACKAGE__->mk_classdata( 'uuid_maker' );
+__PACKAGE__->uuid_class( __PACKAGE__->_find_uuid_module );
=head1 NAME
@@ -11,9 +11,9 @@
=head1 SYNOPSIS
- pacakge Artist;
+ package Artist;
__PACKAGE__->load_components(qw/UUIDColumns Core DB/);
- __PACKAGE__->uuid_columns( 'artist_id' );x
+ __PACKAGE__->uuid_columns( 'artist_id' );
=head1 DESCRIPTION
@@ -37,6 +37,24 @@
$self->uuid_auto_columns([EMAIL PROTECTED]);
}
+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}) {
@@ -47,9 +65,30 @@
}
sub get_uuid {
- return Data::UUID->new->to_string(Data::UUID->new->create),
+ return shift->uuid_maker->as_string;
}
+sub _find_uuid_module {
+ if ($^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{require Data::UUID}) {
+ return '::Data::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')
+ };
+};
+
=head1 AUTHORS
Chia-liang Kao <[EMAIL PROTECTED]>
Index: C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker.pm
===================================================================
--- C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker.pm (revision 0)
+++ C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker.pm (revision 0)
@@ -0,0 +1,11 @@
+package DBIx::Class::UUIDMaker;
+
+sub new {
+ return bless {}, shift;
+};
+
+sub as_string {
+ return undef;
+};
+
+1;
Index: C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/APR/UUID.pm
===================================================================
--- C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/APR/UUID.pm
(revision 0)
+++ C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/APR/UUID.pm
(revision 0)
@@ -0,0 +1,9 @@
+package DBIx::Class::UUIDMaker::APR::UUID;
+use base qw/DBIx::Class::UUIDMaker/;
+use APR::UUID ();
+
+sub as_string {
+ return APR::UUID->new->format;
+};
+
+1;
Index: C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm
===================================================================
--- C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm
(revision 0)
+++ C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm
(revision 0)
@@ -0,0 +1,9 @@
+package DBIx::Class::UUIDMaker::Data::Uniqid;
+use base qw/DBIx::Class::UUIDMaker/;
+use Data::Uniqid ();
+
+sub as_string {
+ return Data::Uniqid->luniqid;
+};
+
+1;
Index: C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Data/UUID.pm
===================================================================
--- C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Data/UUID.pm
(revision 0)
+++ C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Data/UUID.pm
(revision 0)
@@ -0,0 +1,9 @@
+package DBIx::Class::UUIDMaker::Data::UUID;
+use base qw/DBIx::Class::UUIDMaker/;
+use Data::UUID ();
+
+sub as_string {
+ return Data::UUID->new->to_string(Data::UUID->new->create);
+};
+
+1;
Index: C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/UUID.pm
===================================================================
--- C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/UUID.pm (revision 0)
+++ C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/UUID.pm (revision 0)
@@ -0,0 +1,13 @@
+package DBIx::Class::UUIDMaker::UUID;
+use base qw/DBIx::Class::UUIDMaker/;
+use UUID ();
+
+sub as_string {
+ my ($uuid, $uuidstring);
+ UUID::generate($uuid);
+ UUID::unparse($uuid, $uuidstring);
+
+ return $uuidstring;
+};
+
+1;
Index: C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm
===================================================================
--- C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm
(revision 0)
+++ C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm
(revision 0)
@@ -0,0 +1,12 @@
+package DBIx::Class::UUIDMaker::Win32::Guidgen;
+use base qw/DBIx::Class::UUIDMaker/;
+use Win32::Guidgen ();
+
+sub as_string {
+ my $uuid = Win32::Guidgen::create();
+ $uuid =~ s/(^\{|\}$)//;
+
+ return $uuid;
+};
+
+1;
Index: C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm
===================================================================
--- C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm
(revision 0)
+++ C:/Development/DBIx-Class/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm
(revision 0)
@@ -0,0 +1,9 @@
+package DBIx::Class::UUIDMaker::Win32API::GUID;
+use base qw/DBIx::Class::UUIDMaker/;
+use Win32API::GUID ();
+
+sub as_string {
+ return Win32API::GUID::CreateGuid();
+};
+
+1;
signature.asc
Description: OpenPGP digital signature
_______________________________________________ List: http://lists.rawmode.org/cgi-bin/mailman/listinfo/dbix-class Wiki: http://dbix-class.shadowcatsystems.co.uk/ IRC: irc.perl.org#dbix-class SVN: http://dev.catalyst.perl.org/repos/bast/trunk/DBIx-Class/
