From: Matt S Trout <mst@shadowcat.co.uk>
Date: Thu, 9 Feb 2006 14:04:54 +0000 (+0000)
Subject: UUIDColumns patches from Chris Laco
X-Git-Tag: v0.06000~61^2~55
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=947acfd929fb4d83f467581114228eb0682b41c9;p=dbsrgits%2FDBIx-Class.git

UUIDColumns patches from Chris Laco
---

diff --git a/lib/DBIx/Class/UUIDColumns.pm b/lib/DBIx/Class/UUIDColumns.pm
index efbe3d4..5df4ed8 100644
--- a/lib/DBIx/Class/UUIDColumns.pm
+++ b/lib/DBIx/Class/UUIDColumns.pm
@@ -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,7 +11,7 @@ DBIx::Class::UUIDColumns - Implicit uuid columns
 
 =head1 SYNOPSIS
 
-  pacakge Artist;
+  package Artist;
   __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
   __PACKAGE__->uuid_columns( 'artist_id' );
 
@@ -37,6 +37,24 @@ sub uuid_columns {
     $self->uuid_auto_columns(\@_);
 }
 
+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 insert {
 }
 
 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 <clkao@clkao.org>
diff --git a/lib/DBIx/Class/UUIDColumns.pm~ b/lib/DBIx/Class/UUIDColumns.pm~
new file mode 100644
index 0000000..1873c90
--- /dev/null
+++ b/lib/DBIx/Class/UUIDColumns.pm~
@@ -0,0 +1,63 @@
+package DBIx::Class::UUIDColumns;
+use base qw/DBIx::Class/;
+
+use Data::UUID;
+
+__PACKAGE__->mk_classdata( 'uuid_auto_columns' => [] );
+
+=head1 NAME
+
+DBIx::Class::UUIDColumns - Implicit uuid columns
+
+=head1 SYNOPSIS
+
+  pacakge Artist;
+  __PACKAGE__->load_components(qw/UUIDColumns Core DB/);
+  __PACKAGE__->uuid_columns( 'artist_id' );x
+
+=head1 DESCRIPTION
+
+This L<DBIx::Class> component resambles the behaviour of
+L<Class::DBI::UUID>, to make some columns implicitly created as uuid.
+
+Note that the component needs to be loaded before Core.
+
+=head1 METHODS
+
+=head2 uuid_columns
+
+=cut
+
+# be compatible with Class::DBI::UUID
+sub uuid_columns {
+    my $self = shift;
+    for (@_) {
+	$self->throw_exception("column $_ doesn't exist") unless $self->has_column($_);
+    }
+    $self->uuid_auto_columns(\@_);
+}
+
+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 Data::UUID->new->to_string(Data::UUID->new->create),
+}
+
+=head1 AUTHORS
+
+Chia-liang Kao <clkao@clkao.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/DBIx/Class/UUIDMaker.pm b/lib/DBIx/Class/UUIDMaker.pm
new file mode 100644
index 0000000..67061ad
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker.pm
@@ -0,0 +1,11 @@
+package DBIx::Class::UUIDMaker;
+
+sub new {
+    return bless {}, shift;
+};
+
+sub as_string {
+    return undef;
+};
+
+1;
diff --git a/lib/DBIx/Class/UUIDMaker/APR/UUID.pm b/lib/DBIx/Class/UUIDMaker/APR/UUID.pm
new file mode 100644
index 0000000..65305f0
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/APR/UUID.pm
@@ -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;
diff --git a/lib/DBIx/Class/UUIDMaker/Data/UUID.pm b/lib/DBIx/Class/UUIDMaker/Data/UUID.pm
new file mode 100644
index 0000000..ffa1afb
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/Data/UUID.pm
@@ -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;
diff --git a/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm b/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm
new file mode 100644
index 0000000..61bf347
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/Data/Uniqid.pm
@@ -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;
diff --git a/lib/DBIx/Class/UUIDMaker/UUID.pm b/lib/DBIx/Class/UUIDMaker/UUID.pm
new file mode 100644
index 0000000..28a34b9
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/UUID.pm
@@ -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;
diff --git a/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm b/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm
new file mode 100644
index 0000000..9afa652
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/Win32/Guidgen.pm
@@ -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;
diff --git a/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm b/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm
new file mode 100644
index 0000000..463bbba
--- /dev/null
+++ b/lib/DBIx/Class/UUIDMaker/Win32API/GUID.pm
@@ -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;