From: Alastair McGowan-Douglas <alastair.mcgowan@opusvl.com>
Date: Tue, 3 Nov 2015 13:20:49 +0000 (+0000)
Subject: Allow SQLT options to be passed to unique constraints
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5789527392dc08e5187dbbf4fccf9d87423de6a4;p=dbsrgits%2FDBIx-Class-Historic.git

Allow SQLT options to be passed to unique constraints
---

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index a123f41..23be5ea 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -19,7 +19,8 @@ use namespace::clean;
 
 __PACKAGE__->mk_group_accessors(simple => qw/
   source_name name source_info
-  _ordered_columns _columns _primaries _unique_constraints
+  _ordered_columns _columns _primaries 
+  _unique_constraints _unique_constraints_extra
   _relationships resultset_attributes
   column_info_from_storage
 /);
@@ -702,7 +703,7 @@ sub sequence {
 
 =over 4
 
-=item Arguments: $name?, \@colnames
+=item Arguments: $name?, \@colnames, \%options?
 
 =item Return Value: not defined
 
@@ -713,7 +714,8 @@ constraint.
 
   # For UNIQUE (column1, column2)
   __PACKAGE__->add_unique_constraint(
-    constraint_name => [ qw/column1 column2/ ],
+    constraint_name => [ qw/column1 column2/ ], 
+    { deferrable => 1 }
   );
 
 Alternatively, you can specify only the columns:
@@ -724,6 +726,11 @@ This will result in a unique constraint named
 C<table_column1_column2>, where C<table> is replaced with the table
 name.
 
+The options hashref will be passed to
+L<SQL::Translator::Schema::Constraint/new>; the intention being to
+allow the C<deferrable> flag to be set. You should avoid putting 
+C<name>, C<fields>, or C<type> in here.
+
 Unique constraints are used, for example, when you pass the constraint
 name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
 only columns in the constraint are searched.
@@ -736,14 +743,20 @@ the result source.
 sub add_unique_constraint {
   my $self = shift;
 
-  if (@_ > 2) {
+  if ((grep {ref $_ eq 'ARRAY'} @_) > 1) {
     $self->throw_exception(
         'add_unique_constraint() does not accept multiple constraints, use '
       . 'add_unique_constraints() instead'
     );
   }
 
+  my $opts;
   my $cols = pop @_;
+  if (ref $cols eq 'HASH') {
+    $opts = $cols;
+    $cols = pop @_;
+  }
+
   if (ref $cols ne 'ARRAY') {
     $self->throw_exception (
       'Expecting an arrayref of constraint columns, got ' . ($cols||'NOTHING')
@@ -760,8 +773,11 @@ sub add_unique_constraint {
   }
 
   my %unique_constraints = $self->unique_constraints;
+  my %unique_constraints_extra = $self->unique_constraints_extra;
   $unique_constraints{$name} = $cols;
+  $unique_constraints_extra{$name} = $opts;
   $self->_unique_constraints(\%unique_constraints);
+  $self->_unique_constraints_extra(\%unique_constraints_extra);
 }
 
 =head2 add_unique_constraints
@@ -877,6 +893,30 @@ sub unique_constraints {
   return %{shift->_unique_constraints||{}};
 }
 
+=head2 unique_constraints_extra
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: Hash of unique constraint \%options
+
+=back
+
+  my %uq_extras = $source->unique_constraints_extra();
+
+Read-only accessor which returns a hash of the options provided to
+unique constraints.
+
+The hash is keyed by constraint name, and the values are the options
+hashrefs as provided to L</add_unique_constraint>.
+
+=cut
+
+sub unique_constraints_extra {
+  return %{shift->_unique_constraints_extra||{}};
+}
+
 =head2 unique_constraint_names
 
 =over 4
diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm
index 59aec2a..7552496 100644
--- a/lib/SQL/Translator/Parser/DBIx/Class.pm
+++ b/lib/SQL/Translator/Parser/DBIx/Class.pm
@@ -150,12 +150,14 @@ sub parse {
         $table->primary_key(@primary) if @primary;
 
         my %unique_constraints = $source->unique_constraints;
+        my %unique_constraints_extra = $source->unique_constraints_extra;
         foreach my $uniq (sort keys %unique_constraints) {
             if (!$source->_compare_relationship_keys($unique_constraints{$uniq}, \@primary)) {
                 $table->add_constraint(
                             type             => 'unique',
                             name             => $uniq,
-                            fields           => $unique_constraints{$uniq}
+                            fields           => $unique_constraints{$uniq},
+                            %{ $unique_constraints_extra{$uniq} // {} },
                 );
             }
         }