From: Norbert Buchmuller <norbi@nix.hu>
Date: Wed, 23 Jun 2010 12:34:02 +0000 (+0200)
Subject: Implemented "add_unique_constraints".
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=034d0be414a18cf3730c1e6e260acf6e70df476c;p=dbsrgits%2FDBIx-Class-Historic.git

Implemented "add_unique_constraints".

Also "add_unique_constraint" exception if called with multiple constraint
definitions.
---

diff --git a/Changes b/Changes
index 3b1dd41..1f7e9a5 100644
--- a/Changes
+++ b/Changes
@@ -4,6 +4,10 @@ Revision history for DBIx::Class
         - Fixed rels ending with me breaking subqueried limit realiasing
         - Oracle sequence detection now *really* works across schemas
           (fixed some ommissions from 0.08123)
+        - add_unique_constraint() now throws if called with multiple constraint
+          definitions
+        - Implemented add_unique_constraints() which delegates to
+          add_unique_constraint() as appropriate
 
     * Misc
         - Makefile.PL no longer imports GetOptions() to interoperate better
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 25fda37..ef1559a 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -573,8 +573,22 @@ the result source.
 
 sub add_unique_constraint {
   my $self = shift;
+
+  if (@_ > 2) {
+    $self->throw_exception(
+        'add_unique_constraint() does not accept multiple constraints, use '
+      . 'add_unique_constraints() instead'
+    );
+  }
+
   my $cols = pop @_;
-  my $name = shift;
+  if (ref $cols ne 'ARRAY') {
+    $self->throw_exception (
+      'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
+    );
+  }
+
+  my $name = shift @_;
 
   $name ||= $self->name_unique_constraint($cols);
 
@@ -588,6 +602,58 @@ sub add_unique_constraint {
   $self->_unique_constraints(\%unique_constraints);
 }
 
+=head2 add_unique_constraints
+
+=over 4
+
+=item Arguments: @constraints
+
+=item Return value: undefined
+
+=back
+
+Declare multiple unique constraints on this source.
+
+  __PACKAGE__->add_unique_constraints(
+    constraint_name1 => [ qw/column1 column2/ ],
+    constraint_name2 => [ qw/column2 column3/ ],
+  );
+
+Alternatively, you can specify only the columns:
+
+  __PACKAGE__->add_unique_constraints(
+    [ qw/column1 column2/ ],
+    [ qw/column3 column4/ ]
+  );
+
+This will result in unique constraints named C<table_column1_column2> and
+C<table_column3_column4>, where C<table> is replaced with the table name.
+
+Throws an error if any of the given column names do not yet exist on
+the result source.
+
+See also L</add_unique_constraint>.
+
+=cut
+
+sub add_unique_constraints {
+  my $self = shift;
+  my @constraints = @_;
+
+  if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
+    # with constraint name
+    while (my ($name, $constraint) = splice @constraints, 0, 2) {
+      $self->add_unique_constraint($name => $constraint);
+    }
+  }
+  else {
+    # no constraint name
+    foreach my $constraint (@constraints) {
+      $self->add_unique_constraint($constraint);
+    }
+  }
+}
+
 =head2 name_unique_constraint
 
 =over 4
diff --git a/lib/DBIx/Class/ResultSourceProxy.pm b/lib/DBIx/Class/ResultSourceProxy.pm
index feb0a59..9975540 100644
--- a/lib/DBIx/Class/ResultSourceProxy.pm
+++ b/lib/DBIx/Class/ResultSourceProxy.pm
@@ -86,6 +86,10 @@ sub add_unique_constraint {
   shift->result_source_instance->add_unique_constraint(@_);
 }
 
+sub add_unique_constraints {
+  shift->result_source_instance->add_unique_constraints(@_);
+}
+
 sub unique_constraints {
   shift->result_source_instance->unique_constraints(@_);
 }
diff --git a/t/80unique.t b/t/80unique.t
index 0e4108b..dfd7819 100644
--- a/t/80unique.t
+++ b/t/80unique.t
@@ -2,6 +2,7 @@ use strict;
 use warnings;
 
 use Test::More;
+use Test::Exception;
 use lib qw(t/lib);
 use DBICTest;
 use DBIC::SqlMakerTest;
@@ -25,6 +26,11 @@ is_deeply(
   [ qw/primary track_cd_position track_cd_title/ ],
   'Track source has three unique constraints'
 );
+is_deeply(
+  [ sort $schema->source('Tag')->unique_constraint_names ],
+  [ qw/primary tagid_cd tagid_cd_tag tags_tagid_tag tags_tagid_tag_cd/ ],
+  'Tag source has five unique constraints (from add_unique_constraings)'
+);
 
 my $artistid = 1;
 my $title    = 'UNIQUE Constraint';
@@ -232,4 +238,29 @@ is($row->baz, 3, 'baz is correct');
   $schema->storage->debugobj(undef);
 }
 
+{
+  throws_ok {
+    eval <<'MOD' or die $@;
+      package # hide from PAUSE
+        DBICTest::Schema::UniqueConstraintWarningTest;
+
+      use base qw/DBIx::Class::Core/;
+
+      __PACKAGE__->table('dummy');
+
+      __PACKAGE__->add_column(qw/ foo bar /);
+
+      __PACKAGE__->add_unique_constraint(
+        constraint1 => [qw/ foo /],
+        constraint2 => [qw/ bar /],
+      );
+
+      1;
+MOD
+  } qr/\Qadd_unique_constraint() does not accept multiple constraints, use add_unique_constraints() instead\E/,
+    'add_unique_constraint throws when more than one constraint specified';
+}
+
+
 done_testing;
+
diff --git a/t/lib/DBICTest/Schema/Tag.pm b/t/lib/DBICTest/Schema/Tag.pm
index 796616e..03c8142 100644
--- a/t/lib/DBICTest/Schema/Tag.pm
+++ b/t/lib/DBICTest/Schema/Tag.pm
@@ -19,6 +19,15 @@ __PACKAGE__->add_columns(
 );
 __PACKAGE__->set_primary_key('tagid');
 
+__PACKAGE__->add_unique_constraints(  # do not remove, part of a test
+  tagid_cd     => [qw/ tagid cd /],
+  tagid_cd_tag => [qw/ tagid cd tag /],
+);
+__PACKAGE__->add_unique_constraints(  # do not remove, part of a test
+  [qw/ tagid tag /],
+  [qw/ tagid tag cd /],
+);
+
 __PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD' );
 
 1;