Introduce columns_info, switch a large portion of the code over

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

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index ef1559a..e7ab22d 100644 (file)
--- 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
@@ -1544,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;
 
-                : (defined $rel_info->{attrs}{order_by}
-                       ? ($rel_info->{attrs}{order_by})
-                       : ()));
-      push(@$order, map { "${as}.$_" } (@key, @ord));
+      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;
+
+        # 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}.$_", ] }