From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sun, 7 Nov 2010 23:20:11 +0000 (+0100)
Subject: Introduce columns_info, switch a large portion of the code over
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=52416317;p=dbsrgits%2FDBIx-Class-Historic.git

Introduce columns_info, switch a large portion of the code over

(saves on repeated method calls)
---

diff --git a/Changes b/Changes
index a82659f..93ba746 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
 Revision history for DBIx::Class
 
     * New Features / Changes
+        - New method ResultSource columns_info method, returning multiple
+          pairs of column name/info at once
         - NULL is now supplied unquoted to all debug-objects, in order to
           differentiate between a real NULL and the string 'NULL'
 
diff --git a/lib/DBIx/Class/FilterColumn.pm b/lib/DBIx/Class/FilterColumn.pm
index 196b3ee..feef4f1 100644
--- a/lib/DBIx/Class/FilterColumn.pm
+++ b/lib/DBIx/Class/FilterColumn.pm
@@ -7,9 +7,11 @@ use base qw/DBIx::Class::Row/;
 sub filter_column {
   my ($self, $col, $attrs) = @_;
 
+  my $colinfo = $self->column_info($col);
+
   $self->throw_exception('FilterColumn does not work with InflateColumn')
     if $self->isa('DBIx::Class::InflateColumn') &&
-      defined $self->column_info($col)->{_inflate_info};
+      defined $colinfo->{_inflate_info};
 
   $self->throw_exception("No such column $col to filter")
     unless $self->has_column($col);
@@ -20,8 +22,8 @@ sub filter_column {
   $self->throw_exception('An invocation of filter_column() must specify either a filter_from_storage or filter_to_storage')
     unless $attrs->{filter_from_storage} || $attrs->{filter_to_storage};
 
-  $self->column_info($col)->{_filter_info} = $attrs;
-  my $acc = $self->column_info($col)->{accessor};
+  $colinfo->{_filter_info} = $attrs;
+  my $acc = $colinfo->{accessor};
   $self->mk_group_accessors(filtered_column => [ (defined $acc ? $acc : $col), $col]);
   return 1;
 }
diff --git a/lib/DBIx/Class/InflateColumn.pm b/lib/DBIx/Class/InflateColumn.pm
index 292cabe..e9de5da 100644
--- a/lib/DBIx/Class/InflateColumn.pm
+++ b/lib/DBIx/Class/InflateColumn.pm
@@ -75,16 +75,18 @@ used in the database layer.
 sub inflate_column {
   my ($self, $col, $attrs) = @_;
 
+  my $colinfo = $self->column_info($col);
+
   $self->throw_exception("InflateColumn does not work with FilterColumn")
     if $self->isa('DBIx::Class::FilterColumn') &&
-      defined $self->column_info($col)->{_filter_info};
+      defined $colinfo->{_filter_info};
 
   $self->throw_exception("No such column $col to inflate")
     unless $self->has_column($col);
   $self->throw_exception("inflate_column needs attr hashref")
     unless ref $attrs eq 'HASH';
-  $self->column_info($col)->{_inflate_info} = $attrs;
-  my $acc = $self->column_info($col)->{accessor};
+  $colinfo->{_inflate_info} = $attrs;
+  my $acc = $colinfo->{accessor};
   $self->mk_group_accessors('inflated_column' => [ (defined $acc ? $acc : $col), $col]);
   return 1;
 }
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 824e6d6..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
@@ -554,10 +631,14 @@ will be applied to the L</column_info> of each L<primary_key|/set_primary_key>
 =cut
 
 sub sequence {
-    my ($self,$seq) = @_;
-    foreach my $pri ($self->primary_columns) {
-        $self->column_info($pri)->{sequence} = $seq;
-    }
+  my ($self,$seq) = @_;
+
+  my $rsrc = $self->result_source;
+  my @pks = $rsrc->primary_columns
+    or next;
+
+  $_->{sequence} = $seq
+    for values %{ $rsrc->columns_info (\@pks) };
 }
 
 
diff --git a/lib/DBIx/Class/ResultSourceProxy.pm b/lib/DBIx/Class/ResultSourceProxy.pm
index dcbc276..1f74eea 100644
--- a/lib/DBIx/Class/ResultSourceProxy.pm
+++ b/lib/DBIx/Class/ResultSourceProxy.pm
@@ -62,6 +62,7 @@ for my $method_to_proxy (qw/
   remove_columns
 
   column_info
+  columns_info
   column_info_from_storage
 
   set_primary_key
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index af0f881..1b66e35 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -798,15 +798,14 @@ See L<DBIx::Class::InflateColumn> for how to setup inflation.
 sub get_inflated_columns {
   my $self = shift;
 
-  my %loaded_colinfo = (map
-    { $_ => $self->column_info($_) }
-    (grep { $self->has_column_loaded($_) } $self->columns)
-  );
+  my $loaded_colinfo = $self->columns_info ([
+    grep { $self->has_column_loaded($_) } $self->columns
+  ]);
 
   my %inflated;
-  for my $col (keys %loaded_colinfo) {
-    if (exists $loaded_colinfo{$col}{accessor}) {
-      my $acc = $loaded_colinfo{$col}{accessor};
+  for my $col (keys %$loaded_colinfo) {
+    if (exists $loaded_colinfo->{$col}{accessor}) {
+      my $acc = $loaded_colinfo->{$col}{accessor};
       $inflated{$col} = $self->$acc if defined $acc;
     }
     else {
@@ -1025,9 +1024,11 @@ sub copy {
   my ($self, $changes) = @_;
   $changes ||= {};
   my $col_data = { %{$self->{_column_data}} };
+
+  my $colinfo = $self->columns_info([ keys %$col_data ]);
   foreach my $col (keys %$col_data) {
     delete $col_data->{$col}
-      if $self->result_source->column_info($col)->{is_auto_increment};
+      if $colinfo->{$col}{is_auto_increment};
   }
 
   my $new = { _column_data => $col_data };
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 5818e53..b091e64 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -2103,11 +2103,13 @@ sub source_bind_attributes {
   my ($self, $source) = @_;
 
   my $bind_attributes;
-  foreach my $column ($source->columns) {
 
-    my $data_type = $source->column_info($column)->{data_type} || '';
-    $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
-     if $data_type;
+  my $colinfo = $source->columns_info;
+
+  for my $col (keys %$colinfo) {
+    if (my $dt = $colinfo->{$col}{data_type} ) {
+      $bind_attributes->{$col} = $self->bind_attribute_by_data_type($dt)
+    }
   }
 
   return $bind_attributes;
diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
index 5d14612..77b0996 100644
--- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
@@ -50,7 +50,10 @@ sub insert_bulk {
   my ($source, $cols, $data) = @_;
 
   my $is_identity_insert =
-    (first { $source->column_info ($_)->{is_auto_increment} } @{$cols}) ? 1 : 0;
+    (first { $_->{is_auto_increment} } values %{ $source->columns_info($cols) } )
+      ? 1
+      : 0
+  ;
 
   if ($is_identity_insert) {
      $self->_set_identity_insert ($source->name);
@@ -93,11 +96,15 @@ sub _prep_for_execute {
   if ($op eq 'insert' || $op eq 'update') {
     my $fields = $args->[0];
 
+    my $colinfo = $ident->columns_info([keys %$fields]);
+
     for my $col (keys %$fields) {
       # $ident is a result source object with INSERT/UPDATE ops
-      if ($ident->column_info ($col)->{data_type}
-         &&
-         $ident->column_info ($col)->{data_type} =~ /^money\z/i) {
+      if (
+        $colinfo->{$col}{data_type}
+          &&
+        $colinfo->{$col}{data_type} =~ /^money\z/i
+      ) {
         my $val = $fields->{$col};
         $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
       }
diff --git a/lib/DBIx/Class/Storage/DBI/Pg.pm b/lib/DBIx/Class/Storage/DBI/Pg.pm
index e5eaff2..50a1112 100644
--- a/lib/DBIx/Class/Storage/DBI/Pg.pm
+++ b/lib/DBIx/Class/Storage/DBI/Pg.pm
@@ -46,8 +46,10 @@ sub last_insert_id {
 
   my @values;
 
+  my $col_info = $source->columns_info(\@cols);
+
   for my $col (@cols) {
-    my $seq = ( $source->column_info($col)->{sequence} ||= $self->dbh_do('_dbh_get_autoinc_seq', $source, $col) )
+    my $seq = ( $col_info->{$col}{sequence} ||= $self->dbh_do('_dbh_get_autoinc_seq', $source, $col) )
       or $self->throw_exception( sprintf(
         'could not determine sequence for column %s.%s, please consider adding a schema-qualified sequence to its column info',
           $source->name,
diff --git a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
index e2efa13..df301d2 100644
--- a/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
+++ b/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
@@ -41,15 +41,21 @@ sub insert {
   my $self = shift;
   my ($source, $to_insert) = @_;
 
+  my $colinfo = $source->columns_info;
+
   my $identity_col =
-    first { $source->column_info($_)->{is_auto_increment} } $source->columns;
+    first { $_->{is_auto_increment} } values %$colinfo;
 
 # user might have an identity PK without is_auto_increment
   if (not $identity_col) {
     foreach my $pk_col ($source->primary_columns) {
-      if (not exists $to_insert->{$pk_col} &&
-          $source->column_info($pk_col)->{data_type} !~ /^uniqueidentifier/i)
-      {
+      if (
+        ! exists $to_insert->{$pk_col}
+          and
+        $colinfo->{$pk_col}{data_type}
+          and
+        $colinfo->{$pk_col}{data_type} !~ /^uniqueidentifier/i
+      ) {
         $identity_col = $pk_col;
         last;
       }
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
index 0496634..dbbee6f 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
@@ -262,7 +262,7 @@ sub _prep_for_execute {
   ;
   my $identity_col =
     blessed $ident &&
-    first { $ident->column_info($_)->{is_auto_increment} } $ident->columns
+    first { $_->{is_auto_increment} } values %{ $ident->columns_info }
   ;
 
   if (($op eq 'insert' && $bound_identity_col) ||
@@ -351,7 +351,7 @@ sub insert {
   my ($source, $to_insert) = @_;
 
   my $identity_col =
-    (first { $source->column_info($_)->{is_auto_increment} } $source->columns)
+    (first { $_->{is_auto_increment} } values %{ $source->columns_info } )
     || '';
 
   # check for empty insert
@@ -436,7 +436,7 @@ sub update {
   my $table = $source->name;
 
   my $identity_col =
-    first { $source->column_info($_)->{is_auto_increment} } $source->columns;
+    first { $_->{is_auto_increment} } values %{ $source->columns_info };
 
   my $is_identity_update = $identity_col && defined $fields->{$identity_col};
 
@@ -486,7 +486,7 @@ sub insert_bulk {
   my ($source, $cols, $data) = @_;
 
   my $identity_col =
-    first { $source->column_info($_)->{is_auto_increment} } $source->columns;
+    first { $_->{is_auto_increment} } values %{ $source->columns_info };
 
   my $is_identity_insert = (first { $_ eq $identity_col } @{$cols}) ? 1 : 0;
 
diff --git a/lib/DBIx/Class/Storage/DBI/UniqueIdentifier.pm b/lib/DBIx/Class/Storage/DBI/UniqueIdentifier.pm
index 6a70662..a748994 100644
--- a/lib/DBIx/Class/Storage/DBI/UniqueIdentifier.pm
+++ b/lib/DBIx/Class/Storage/DBI/UniqueIdentifier.pm
@@ -34,7 +34,7 @@ sub insert {
   my $self = shift;
   my ($source, $to_insert) = @_;
 
-  my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
+  my $col_info = $source->columns_info;
 
   my %guid_cols;
   my @pk_cols = $source->primary_columns;
@@ -42,17 +42,17 @@ sub insert {
   @pk_cols{@pk_cols} = ();
 
   my @pk_guids = grep {
-    $source->column_info($_)->{data_type}
+    $col_info->{$_}{data_type}
     &&
-    $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
+    $col_info->{$_}{data_type} =~ /^uniqueidentifier/i
   } @pk_cols;
 
   my @auto_guids = grep {
-    $source->column_info($_)->{data_type}
+    $col_info->{$_}{data_type}
     &&
-    $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
+    $col_info->{$_}{data_type} =~ /^uniqueidentifier/i
     &&
-    $source->column_info($_)->{auto_nextval}
+    $col_info->{$_}{auto_nextval}
   } grep { not exists $pk_cols{$_} } $source->columns;
 
   my @get_guids_for =
diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index f5a03c9..07fa550 100644
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -411,7 +411,7 @@ sub _resolve_column_info {
   my ($self, $ident, $colnames) = @_;
   my ($alias2src, $root_alias) = $self->_resolve_ident_sources($ident);
 
-  my (%return, %seen_cols, @auto_colnames);
+  my (%seen_cols, @auto_colnames);
 
   # compile a global list of column names, to be able to properly
   # disambiguate unqualified column names (if at all possible)
@@ -428,25 +428,23 @@ sub _resolve_column_info {
     grep { @{$seen_cols{$_}} == 1 } (keys %seen_cols),
   ];
 
-  COLUMN:
+  my (%return, $colinfos);
   foreach my $col (@$colnames) {
-    my ($alias, $colname) = $col =~ m/^ (?: ([^\.]+) \. )? (.+) $/x;
+    my ($source_alias, $colname) = $col =~ m/^ (?: ([^\.]+) \. )? (.+) $/x;
 
-    unless ($alias) {
-      # see if the column was seen exactly once (so we know which rsrc it came from)
-      if ($seen_cols{$colname} and @{$seen_cols{$colname}} == 1) {
-        $alias = $seen_cols{$colname}[0];
-      }
-      else {
-        next COLUMN;
-      }
-    }
+    # if the column was seen exactly once - we know which rsrc it came from
+    $source_alias ||= $seen_cols{$colname}[0]
+      if ($seen_cols{$colname} and @{$seen_cols{$colname}} == 1);
 
-    my $rsrc = $alias2src->{$alias};
-    $return{$col} = $rsrc && {
-      %{$rsrc->column_info($colname)},
+    next unless $source_alias;
+
+    my $rsrc = $alias2src->{$source_alias}
+      or next;
+
+    $return{$col} = {
+      %{ ( $colinfos->{$source_alias} ||= $rsrc->columns_info )->{$colname} },
       -result_source => $rsrc,
-      -source_alias => $alias,
+      -source_alias => $source_alias,
     };
   }
 
diff --git a/t/60core.t b/t/60core.t
index f063cb3..5ec889c 100644
--- a/t/60core.t
+++ b/t/60core.t
@@ -347,7 +347,67 @@ lives_ok (sub { my $newlink = $newbook->link}, "stringify to false value doesn't
   my $typeinfo = $schema->source("Artist")->column_info('artistid');
   is($typeinfo->{data_type}, 'INTEGER', 'column_info ok');
   $schema->source("Artist")->column_info('artistid');
-  ok($schema->source("Artist")->{_columns_info_loaded} == 1, 'Columns info flag set');
+  ok($schema->source("Artist")->{_columns_info_loaded} == 1, 'Columns info loaded flag set');
+}
+
+# test columns_info
+{
+  $schema->source("Artist")->{_columns}{'artistid'} = {};
+  $schema->source("Artist")->column_info_from_storage(1);
+  $schema->source("Artist")->{_columns_info_loaded} = 0;
+
+  is_deeply (
+    $schema->source('Artist')->columns_info,
+    {
+      artistid => {
+        data_type => "INTEGER",
+        default_value => undef,
+        is_nullable => 0,
+        size => undef
+      },
+      charfield => {
+        data_type => "char",
+        default_value => undef,
+        is_nullable => 1,
+        size => 10
+      },
+      name => {
+        data_type => "varchar",
+        default_value => undef,
+        is_nullable => 1,
+        is_numeric => 0,
+        size => 100
+      },
+      rank => {
+        data_type => "integer",
+        default_value => 13,
+        is_nullable => 0,
+        size => undef
+      },
+    },
+    'columns_info works',
+  );
+
+  ok($schema->source("Artist")->{_columns_info_loaded} == 1, 'Columns info loaded flag set');
+
+  is_deeply (
+    $schema->source('Artist')->columns_info([qw/artistid rank/]),
+    {
+      artistid => {
+        data_type => "INTEGER",
+        default_value => undef,
+        is_nullable => 0,
+        size => undef
+      },
+      rank => {
+        data_type => "integer",
+        default_value => 13,
+        is_nullable => 0,
+        size => undef
+      },
+    },
+    'limited columns_info works',
+  );
 }
 
 # test source_info