From: CL Kao Date: Mon, 10 Oct 2005 17:43:03 +0000 (+0000) Subject: Add a DBIx::UUIDColumns plugin. X-Git-Tag: v0.05005~202 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7da9cd47db7689a09f1b836692c2dd2fddabee84;p=dbsrgits%2FDBIx-Class.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 component resambles the behaviour of +L, 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 + +=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;