From: CL Kao <clkao@clkao.org>
Date: Mon, 10 Oct 2005 17:43:03 +0000 (+0000)
Subject: Add a DBIx::UUIDColumns plugin.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7da9cd47db7689a09f1b836692c2dd2fddabee84;hp=d3dec6248835b18100141f00983a5e34d81d9a97;p=dbsrgits%2FDBIx-Class-Historic.git

Add a DBIx::UUIDColumns plugin.
---

diff --git a/Build.PL b/Build.PL
index abf93cf..0c22671 100644
--- a/Build.PL
+++ b/Build.PL
@@ -18,6 +18,9 @@ my %arguments = (
         'Storable'                  => 0,
         'Module::Find'              => 0,
     },
+    reommends          => {
+        'Data::UUID'                => 0,
+    },
     create_makefile_pl => 'passthrough',
     create_readme      => 1,
     test_files         => [ glob('t/*.t'), glob('t/*/*.t') ]
diff --git a/Changes b/Changes
index 8bb762e..803003c 100644
--- a/Changes
+++ b/Changes
@@ -3,6 +3,7 @@ Revision history for DBIx::Class
 0.03002
         - Minor bugfix to new (Row.pm)
         - Schema doesn't die if it can't load a class (Schema.pm)
+        - New UUID columns plugin (UUIDColumns.pm)
 
 0.03001 2005-09-23 14:00:00
         - Fixes to relationship helpers
diff --git a/lib/DBIx/Class/UUIDColumns.pm b/lib/DBIx/Class/UUIDColumns.pm
new file mode 100644
index 0000000..d45eac8
--- /dev/null
+++ b/lib/DBIx/Class/UUIDColumns.pm
@@ -0,0 +1,67 @@
+package DBIx::Class::UUIDColumns;
+use base qw/Class::Data::Inheritable/;
+
+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
+
+=over 4
+
+=item uuid_columns
+
+=cut
+
+# be compatible with Class::DBI::UUID
+sub uuid_columns {
+    my $self = shift;
+    for (@_) {
+	die "column $_ doesn't exist" unless exists $self->_columns->{$_};
+    }
+    $self->uuid_auto_columns(\@_);
+}
+
+sub insert {
+    my ($self) = @_;
+    for my $column (@{$self->uuid_auto_columns}) {
+	$self->$column( $self->get_uuid )
+	    unless defined $self->$column;
+    }
+    $self->NEXT::ACTUAL::insert;
+}
+
+sub get_uuid {
+    return Data::UUID->new->to_string(Data::UUID->new->create),
+}
+
+=back
+
+=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/t/helperrels/19uuid.t b/t/helperrels/19uuid.t
new file mode 100644
index 0000000..b718916
--- /dev/null
+++ b/t/helperrels/19uuid.t
@@ -0,0 +1,7 @@
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/19uuid.tl";
+run_tests();
diff --git a/t/run/19uuid.tl b/t/run/19uuid.tl
new file mode 100644
index 0000000..42c91a8
--- /dev/null
+++ b/t/run/19uuid.tl
@@ -0,0 +1,15 @@
+sub run_tests {
+
+eval 'use Data::UUID ; 1'
+  or plan skip_all, 'Install Data::UUID run this test';
+
+plan tests => 1;
+DBICTest::Artist->load_components('UUIDColumns');
+DBICTest::Artist->uuid_columns('name');
+
+my $artist = DBICTest::Artist->create( { artistid => 100 } );
+like $artist->name, qr/[\w-]{36}/, 'got something like uuid';
+
+}
+
+1;