X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSource.pm;h=e7ab22d80cf2d6de18987fe5627ab50c7c122f93;hb=8f4b5c084378a4c457c8893404aded4398c1d811;hp=25fda373af4b8067e7d2b4604dc95d43a5aba850;hpb=6515609bb769fc957052afa939d725d7a8f819f7;p=dbsrgits%2FDBIx-Class-Historic.git

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 25fda37..e7ab22d 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -361,22 +361,22 @@ sub column_info {
   my ($self, $column) = @_;
   $self->throw_exception("No such column $column")
     unless exists $self->_columns->{$column};
-  #warn $self->{_columns_info_loaded}, "\n";
+
   if ( ! $self->_columns->{$column}{data_type}
-       and $self->column_info_from_storage
        and ! $self->{_columns_info_loaded}
-       and $self->schema and $self->storage )
+       and $self->column_info_from_storage
+       and $self->schema and my $stor = $self->storage )
   {
     $self->{_columns_info_loaded}++;
-    my $info = {};
-    my $lc_info = {};
 
     # try for the case of storage without table
     try {
-      $info = $self->storage->columns_info_for( $self->from );
-      for my $realcol ( keys %{$info} ) {
-        $lc_info->{lc $realcol} = $info->{$realcol};
-      }
+      my $info = $stor->columns_info_for( $self->from );
+      my $lc_info = { map
+        { (lc $_) => $info->{$_} }
+        ( keys %$info )
+      };
+
       foreach my $col ( keys %{$self->_columns} ) {
         $self->_columns->{$col} = {
           %{ $self->_columns->{$col} },
@@ -385,6 +385,7 @@ sub column_info {
       }
     };
   }
+
   return $self->_columns->{$column};
 }
 
@@ -412,6 +413,82 @@ sub columns {
   return @{$self->{_ordered_columns}||[]};
 }
 
+=head2 columns_info
+
+=over
+
+=item Arguments: \@colnames ?
+
+=item Return value: Hashref of column name/info pairs
+
+=back
+
+  my $columns_info = $source->columns_info;
+
+Like L</column_info> but returns information for the requested columns. If
+the optional column-list arrayref is ommitted it returns info on all columns
+currently defined on the ResultSource via L</add_columns>.
+
+=cut
+
+sub columns_info {
+  my ($self, $columns) = @_;
+
+  my $colinfo = $self->_columns;
+
+  if (
+    first { ! $_->{data_type} } values %$colinfo
+      and
+    ! $self->{_columns_info_loaded}
+      and
+    $self->column_info_from_storage
+      and
+    $self->schema
+      and
+    my $stor = $self->storage
+  ) {
+    $self->{_columns_info_loaded}++;
+
+    # try for the case of storage without table
+    try {
+      my $info = $stor->columns_info_for( $self->from );
+      my $lc_info = { map
+        { (lc $_) => $info->{$_} }
+        ( keys %$info )
+      };
+
+      foreach my $col ( keys %$colinfo ) {
+        $colinfo->{$col} = {
+          %{ $colinfo->{$col} },
+          %{ $info->{$col} || $lc_info->{lc $col} || {} }
+        };
+      }
+    };
+  }
+
+  my %ret;
+
+  if ($columns) {
+    for (@$columns) {
+      if (my $inf = $colinfo->{$_}) {
+        $ret{$_} = $inf;
+      }
+      else {
+        $self->throw_exception( sprintf (
+          "No such column '%s' on source %s",
+          $_,
+          $self->source_name,
+        ));
+      }
+    }
+  }
+  else {
+    %ret = %$colinfo;
+  }
+
+  return \%ret;
+}
+
 =head2 remove_columns
 
 =over
@@ -531,11 +608,40 @@ sub _pri_cols {
   my @pcols = $self->primary_columns
     or $self->throw_exception (sprintf(
       "Operation requires a primary key to be declared on '%s' via set_primary_key",
-      $self->source_name,
+      # source_name is set only after schema-registration
+      $self->source_name || $self->result_class || $self->name || 'Unknown source...?',
     ));
   return @pcols;
 }
 
+=head2 sequence
+
+Manually define the correct sequence for your table, to avoid the overhead
+associated with looking up the sequence automatically. The supplied sequence
+will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
+
+=over 4
+
+=item Arguments: $sequence_name
+
+=item Return value: undefined
+
+=back
+
+=cut
+
+sub sequence {
+  my ($self,$seq) = @_;
+
+  my $rsrc = $self->result_source;
+  my @pks = $rsrc->primary_columns
+    or next;
+
+  $_->{sequence} = $seq
+    for values %{ $rsrc->columns_info (\@pks) };
+}
+
+
 =head2 add_unique_constraint
 
 =over 4
@@ -573,8 +679,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 +708,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
@@ -1478,13 +1650,33 @@ sub _resolve_prefetch {
         # in ResultSet->_collapse_result
       my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
                     keys %{$rel_info->{cond}};
-      my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
-                   ? @{$rel_info->{attrs}{order_by}}
+      push @$order, map { "${as}.$_" } @key;
+
+      if (my $rel_order = $rel_info->{attrs}{order_by}) {
+        # this is kludgy and incomplete, I am well aware
+        # but the parent method is going away entirely anyway
+        # so sod it
+        my $sql_maker = $self->storage->sql_maker;
+        my ($orig_ql, $orig_qr) = $sql_maker->_quote_chars;
+        my $sep = $sql_maker->name_sep;
 
-                : (defined $rel_info->{attrs}{order_by}
-                       ? ($rel_info->{attrs}{order_by})
-                       : ()));
-      push(@$order, map { "${as}.$_" } (@key, @ord));
+        # install our own quoter, so we can catch unqualified stuff
+        local $sql_maker->{quote_char} = ["\x00", "\xFF"];
+
+        my $quoted_prefix = "\x00${as}\xFF";
+
+        for my $chunk ( $sql_maker->_order_by_chunks ($rel_order) ) {
+          my @bind;
+          ($chunk, @bind) = @$chunk if ref $chunk;
+
+          $chunk = "${quoted_prefix}${sep}${chunk}"
+            unless $chunk =~ /\Q$sep/;
+
+          $chunk =~ s/\x00/$orig_ql/g;
+          $chunk =~ s/\xFF/$orig_qr/g;
+          push @$order, \[$chunk, @bind];
+        }
+      }
     }
 
     return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }