Add automatic naming of unique constraints

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSource.pm

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 17e1bf0..a5da754 100644 (file)
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -176,13 +176,15 @@ sub column_info {
   {
     $self->{_columns_info_loaded}++;
     my $info;
+    my $lc_info;
     # eval for the case of storage without table
-    eval { $info = $self->storage->columns_info_for($self->from) };
+    eval { $info = $self->storage->columns_info_for( $self->from, keys %{$self->_columns} ) };
     unless ($@) {
+      for my $realcol ( keys %{$info} ) {
+        $lc_info->{lc $realcol} = $info->{$realcol};
+      }
       foreach my $col ( keys %{$self->_columns} ) {
-        foreach my $i ( keys %{$info->{$col}} ) {
-            $self->_columns->{$col}{$i} = $info->{$col}{$i};
-        }
+        $self->_columns->{$col} = $info->{$col} || $lc_info->{lc $col};
       }
     }
   }
@@ -290,13 +292,24 @@ constraint.
     constraint_name => [ qw/column1 column2/ ],
   );
 
+Alternatively, you can specify only the columns:
+
+  __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
+
+This will result in a unique constraint named C<table_column1_column2>, where
+C<table> is replaced with the table name.
+
 Unique constraints are used, for example, when you call
 L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
 
 =cut
 
 sub add_unique_constraint {
-  my ($self, $name, $cols) = @_;
+  my $self = shift;
+  my $cols = pop @_;
+  my $name = shift;
+
+  $name ||= $self->name_unique_constraint($cols);
 
   foreach my $col (@$cols) {
     $self->throw_exception("No such column $col on table " . $self->name)
@@ -308,6 +321,22 @@ sub add_unique_constraint {
   $self->_unique_constraints(\%unique_constraints);
 }
 
+=head2
+
+Return a name for a unique constraint containing the specified columns. These
+names consist of the table name and each column name, separated by underscores.
+
+For example, a constraint on a table named C<cd> containing the columns
+C<artist> and C<title> would result in a constraint name of C<cd_artist_title>.
+
+=cut
+
+sub name_unique_constraint {
+  my ($self, $cols) = @_;
+
+  return join '_', $self->name, @$cols;
+}
+
 =head2 unique_constraints
 
 Read-only accessor which returns the list of unique constraints on this source.
@@ -318,13 +347,48 @@ sub unique_constraints {
   return %{shift->_unique_constraints||{}};
 }
 
+=head2 unique_constraint_names
+
+Returns the list of unique constraint names defined on this source.
+
+=cut
+
+sub unique_constraint_names {
+  my ($self) = @_;
+
+  my %unique_constraints = $self->unique_constraints;
+
+  return keys %unique_constraints;
+}
+
+=head2 unique_constraint_columns
+
+Returns the list of columns that make up the specified unique constraint.
+
+=cut
+
+sub unique_constraint_columns {
+  my ($self, $constraint_name) = @_;
+
+  my %unique_constraints = $self->unique_constraints;
+
+  $self->throw_exception(
+    "Unknown unique constraint $constraint_name on '" . $self->name . "'"
+  ) unless exists $unique_constraints{$constraint_name};
+
+  return @{ $unique_constraints{$constraint_name} };
+}
+
 =head2 from
 
 Returns an expression of the source to be supplied to storage to specify
 retrieval from this source. In the case of a database, the required FROM
 clause contents.
 
-=cut
+=head2 schema
+
+Returns the L<DBIx::Class::Schema> object that this result source 
+belongs too.
 
 =head2 storage
 
@@ -419,10 +483,7 @@ sub add_relationship {
 
   my $f_source = $self->schema->source($f_source_name);
   unless ($f_source) {
-    eval "require $f_source_name;";
-    if ($@) {
-      die $@ unless $@ =~ /Can't locate/;
-    }
+    $self->ensure_class_loaded($f_source_name);
     $f_source = $f_source_name->result_source;
     #my $s_class = ref($self->schema);
     #$f_source_name =~ m/^${s_class}::(.*)$/;
@@ -651,7 +712,8 @@ sub resolve_condition {
   #warn %$cond;
   if (ref $cond eq 'HASH') {
     my %ret;
-    while (my ($k, $v) = each %{$cond}) {
+    foreach my $k (keys %{$cond}) {
+      my $v = $cond->{$k};
       # XXX should probably check these are valid columns
       $k =~ s/^foreign\.// ||
         $self->throw_exception("Invalid rel cond key ${k}");
@@ -661,8 +723,12 @@ sub resolve_condition {
         #warn "$self $k $for $v";
         $ret{$k} = $for->get_column($v);
         #warn %ret;
+      } elsif (!defined $for) { # undef, i.e. "no object"
+        $ret{$k} = undef;
       } elsif (ref $as) { # reverse object
         $ret{$v} = $as->get_column($k);
+      } elsif (!defined $as) { # undef, i.e. "no reverse object"
+        $ret{$v} = undef;
       } else {
         $ret{"${as}.${k}"} = "${for}.${v}";
       }
@@ -847,9 +913,14 @@ sub resultset {
     'resultset does not take any arguments. If you want another resultset, '.
     'call it on the schema instead.'
   ) if scalar @_;
-  return $self->{_resultset}
-    if ref $self->{_resultset} eq $self->resultset_class;
-  return $self->{_resultset} = $self->resultset_class->new(
+
+  # disabled until we can figure out a way to do it without consistency issues
+  #
+  #return $self->{_resultset}
+  #  if ref $self->{_resultset} eq $self->resultset_class;
+  #return $self->{_resultset} =
+
+  return $self->resultset_class->new(
     $self, $self->{resultset_attributes}
   );
 }