Add a DBIx::UUIDColumns plugin.

diff --git a/Build.PL b/Build.PL
index abf93cf..0c22671 100644 (file)
--- 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 (file)
--- a/Changes
+++ b/Changes
@@ -3,6 +3,7 @@ Revision history for DBIx::Class
 0.03002\r
         - Minor bugfix to new (Row.pm)\r
         - Schema doesn't die if it can't load a class (Schema.pm)\r
+        - New UUID columns plugin (UUIDColumns.pm)\r
 \r
 0.03001 2005-09-23 14:00:00\r
         - Fixes to relationship helpers\r

diff --git a/lib/DBIx/Class/UUIDColumns.pm b/lib/DBIx/Class/UUIDColumns.pm
new file mode 100644 (file)
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 (file)
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 (file)
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;