Fold column_info() into columns_info()
Peter Rabbitson [Mon, 6 Jun 2016 12:34:55 +0000 (14:34 +0200)]
Not sure how I never noticed the utter code duplication.

lib/DBIx/Class/FilterColumn.pm
lib/DBIx/Class/InflateColumn.pm
lib/DBIx/Class/InflateColumn/File.pm
lib/DBIx/Class/Relationship/HasOne.pm
lib/DBIx/Class/ResultSource.pm
lib/DBIx/Class/ResultSourceProxy.pm
lib/DBIx/Class/Row.pm
lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
lib/SQL/Translator/Parser/DBIx/Class.pm
t/86might_have.t

index 18f99a8..c280b47 100644 (file)
@@ -9,14 +9,11 @@ use namespace::clean;
 sub filter_column {
   my ($self, $col, $attrs) = @_;
 
-  my $colinfo = $self->result_source_instance->column_info($col);
+  my $colinfo = $self->result_source->columns_info([$col])->{$col};
 
   $self->throw_exception("FilterColumn can not be used on a column with a declared InflateColumn inflator")
     if defined $colinfo->{_inflate_info} and $self->isa('DBIx::Class::InflateColumn');
 
-  $self->throw_exception("No such column $col to filter")
-    unless $self->result_source_instance->has_column($col);
-
   $self->throw_exception('filter_column expects a hashref of filter specifications')
     unless ref $attrs eq 'HASH';
 
@@ -34,8 +31,7 @@ sub _column_from_storage {
 
   return $value if is_literal_value($value);
 
-  my $info = $self->result_source->column_info($col)
-    or $self->throw_exception("No column info for $col");
+  my $info = $self->result_source->columns_info([$col])->{$col};
 
   return $value unless exists $info->{_filter_info};
 
@@ -49,8 +45,7 @@ sub _column_to_storage {
 
   return $value if is_literal_value($value);
 
-  my $info = $self->result_source->column_info($col) or
-    $self->throw_exception("No column info for $col");
+  my $info = $self->result_source->columns_info([$col])->{$col};
 
   return $value unless exists $info->{_filter_info};
 
@@ -63,7 +58,7 @@ sub get_filtered_column {
   my ($self, $col) = @_;
 
   $self->throw_exception("$col is not a filtered column")
-    unless exists $self->result_source->column_info($col)->{_filter_info};
+    unless exists $self->result_source->columns_info->{$col}{_filter_info};
 
   return $self->{_filtered_column}{$col}
     if exists $self->{_filtered_column}{$col};
index 08b1b54..39d36f5 100644 (file)
@@ -87,7 +87,7 @@ L<DBIx::Class::DateTime::Epoch>
 sub inflate_column {
   my ($self, $col, $attrs) = @_;
 
-  my $colinfo = $self->result_source_instance->column_info($col);
+  my $colinfo = $self->result_source->columns_info([$col])->{$col};
 
   $self->throw_exception("InflateColumn can not be used on a column with a declared FilterColumn filter")
     if defined $colinfo->{_filter_info} and $self->isa('DBIx::Class::FilterColumn');
@@ -111,8 +111,7 @@ sub _inflated_column {
     is_literal_value($value) #that would be a not-yet-reloaded literal update
   );
 
-  my $info = $self->result_source->column_info($col)
-    or $self->throw_exception("No column info for $col");
+  my $info = $self->result_source->columns_info([$col])->{$col};
 
   return $value unless exists $info->{_inflate_info};
 
@@ -133,8 +132,7 @@ sub _deflated_column {
     is_literal_value($value)
   );
 
-  my $info = $self->result_source->column_info($col) or
-    $self->throw_exception("No column info for $col");
+  my $info = $self->result_source->columns_info([$col])->{$col};
 
   return $value unless exists $info->{_inflate_info};
 
@@ -160,7 +158,7 @@ sub get_inflated_column {
   my ($self, $col) = @_;
 
   $self->throw_exception("$col is not an inflated column")
-    unless exists $self->result_source->column_info($col)->{_inflate_info};
+    unless exists $self->result_source->columns_info->{$col}{_inflate_info};
 
   # we take care of keeping things in sync
   return $self->{_inflated_column}{$col}
index 08a1a31..34db2ed 100644 (file)
@@ -49,7 +49,7 @@ sub register_column {
 sub _file_column_file {
     my ($self, $column, $filename) = @_;
 
-    my $column_info = $self->result_source->column_info($column);
+    my $column_info = $self->result_source->columns_info->{$column};
 
     return unless $column_info->{is_file_column};
 
index 665d131..46e18e3 100644 (file)
@@ -97,12 +97,18 @@ sub _validate_has_one_condition {
     return unless $self_id =~ /^self\.(.*)$/;
 
     my $key = $1;
-    $class->throw_exception("Defining rel on ${class} that includes '$key' but no such column defined here yet")
-        unless $class->result_source_instance->has_column($key);
-    my $column_info = $class->result_source_instance->column_info($key);
-    if ( $column_info->{is_nullable} ) {
-      carp(qq'"might_have/has_one" must not be on columns with is_nullable set to true ($class/$key). This might indicate an incorrect use of those relationship helpers instead of belongs_to.');
-    }
+
+    my $column_info = $class->result_source->columns_info->{$key}
+      or $class->throw_exception(
+        "Defining rel on ${class} that includes '$key' "
+      . 'but no such column defined there yet'
+      );
+
+    carp(
+      "'might_have'/'has_one' must not be used on columns with is_nullable "
+    . "set to true ($class/$key). This almost certainly indicates an "
+    . "incorrect use of these relationship helpers instead of 'belongs_to'"
+    ) if $column_info->{is_nullable};
   }
 }
 
index 0a5d1fc..a8da52e 100644 (file)
@@ -445,13 +445,19 @@ sub add_columns {
   my ($self, @cols) = @_;
   $self->_ordered_columns(\@cols) unless $self->_ordered_columns;
 
-  my @added;
+  my ( @added, $colinfos );
   my $columns = $self->_columns;
+
   while (my $col = shift @cols) {
-    my $column_info = {};
-    if ($col =~ s/^\+//) {
-      $column_info = $self->column_info($col);
-    }
+    my $column_info =
+      (
+        $col =~ s/^\+//
+          and
+        ( $colinfos ||= $self->columns_info )->{$col}
+      )
+        ||
+      {}
+    ;
 
     # If next entry is { ... } use that for the column info, if not
     # use an empty hashref
@@ -462,6 +468,7 @@ sub add_columns {
     push(@added, $col) unless exists $columns->{$col};
     $columns->{$col} = $column_info;
   }
+
   push @{ $self->_ordered_columns }, @added;
   return $self;
 }
@@ -511,35 +518,10 @@ contents of the hashref.
 =cut
 
 sub column_info {
-  my ($self, $column) = @_;
-  $self->throw_exception("No such column $column")
-    unless exists $self->_columns->{$column};
-
-  if ( ! $self->_columns->{$column}{data_type}
-       and ! $self->{_columns_info_loaded}
-       and $self->column_info_from_storage
-       and my $stor = dbic_internal_try { $self->schema->storage } )
-  {
-    $self->{_columns_info_loaded}++;
-
-    # try for the case of storage without table
-    dbic_internal_try {
-      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} },
-          %{ $info->{$col} || $lc_info->{lc $col} || {} }
-        };
-      }
-    };
-  }
+  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
 
-  return $self->_columns->{$column};
+  #my ($self, $column) = @_;
+  $_[0]->columns_info([ $_[1] ])->{$_[1]};
 }
 
 =head2 columns
@@ -634,6 +616,8 @@ sub columns_info {
     }
   }
   else {
+    # the shallow copy is crucial - there are exists() checks within
+    # the wider codebase
     %ret = %$colinfo;
   }
 
@@ -1857,14 +1841,17 @@ sub _pk_depends_on {
   # auto-increment
   my $rel_source = $self->related_source($rel_name);
 
+  my $colinfos;
+
   foreach my $p ($self->primary_columns) {
-    if (exists $keyhash->{$p}) {
-      unless (defined($rel_data->{$keyhash->{$p}})
-              || $rel_source->column_info($keyhash->{$p})
-                            ->{is_auto_increment}) {
-        return 0;
-      }
-    }
+    return 0 if (
+      exists $keyhash->{$p}
+        and
+      ! defined( $rel_data->{$keyhash->{$p}} )
+        and
+      ! ( $colinfos ||= $rel_source->columns_info )
+         ->{$keyhash->{$p}}{is_auto_increment}
+    )
   }
 
   return 1;
index 5f4bbe3..70de112 100644 (file)
@@ -25,11 +25,16 @@ sub add_columns {
   my ($class, @cols) = @_;
   my $source = $class->result_source_instance;
   $source->add_columns(@cols);
+
+  my $colinfos;
   foreach my $c (grep { !ref } @cols) {
     # If this is an augment definition get the real colname.
     $c =~ s/^\+//;
 
-    $class->register_column($c => $source->column_info($c));
+    $class->register_column(
+      $c,
+      ( $colinfos ||= $source->columns_info )->{$c}
+    );
   }
 }
 
index 6d1b341..b0542cb 100644 (file)
@@ -196,7 +196,7 @@ sub new {
       @{$new->{_ignore_at_insert}={}}{@$col_from_rel} = ();
     }
 
-    my ($related,$inflated);
+    my( $related, $inflated, $colinfos );
 
     foreach my $key (keys %$attrs) {
       if (ref $attrs->{$key} and ! is_literal_value($attrs->{$key}) ) {
@@ -258,9 +258,8 @@ sub new {
           next;
         }
         elsif (
-          $rsrc->has_column($key)
-            and
-          $rsrc->column_info($key)->{_inflate_info}
+          ( $colinfos ||= $rsrc->columns_info )
+           ->{$key}{_inflate_info}
         ) {
           $inflated->{$key} = $attrs->{$key};
           next;
@@ -902,7 +901,7 @@ sub _is_column_numeric {
     return undef
       unless ( $rsrc = $self->result_source )->has_column($column);
 
-    my $colinfo = $rsrc->column_info ($column);
+    my $colinfo = $rsrc->columns_info->{$column};
 
     # cache for speed (the object may *not* have a resultsource instance)
     if (
@@ -1099,7 +1098,9 @@ See also L<DBIx::Class::Relationship::Base/set_from_related>.
 
 sub set_inflated_columns {
   my ( $self, $upd ) = @_;
-  my $rsrc;
+
+  my ($rsrc, $colinfos);
+
   foreach my $key (keys %$upd) {
     if (ref $upd->{$key}) {
       $rsrc ||= $self->result_source;
@@ -1117,9 +1118,11 @@ sub set_inflated_columns {
         );
       }
       elsif (
-        $rsrc->has_column($key)
-          and
-        exists $rsrc->column_info($key)->{_inflate_info}
+        exists( (
+          ( $colinfos ||= $rsrc->columns_info )->{$key}
+            ||
+          {}
+        )->{_inflate_info} )
       ) {
         $self->set_inflated_column($key, delete $upd->{$key});
       }
index 61767ba..336070a 100644 (file)
@@ -117,8 +117,9 @@ sub deployment_statements {
 sub _dbh_last_insert_id {
   my ($self, $dbh, $source, @columns) = @_;
   my @ids = ();
+  my $ci = $source->columns_info(\@columns);
   foreach my $col (@columns) {
-    my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
+    my $seq = ( $ci->{$col}{sequence} ||= $self->get_autoinc_seq($source,$col));
     my $id = $self->_sequence_fetch( 'CURRVAL', $seq );
     push @ids, $id;
   }
index 017709c..5282b7f 100644 (file)
@@ -247,7 +247,9 @@ sub connect_call_blob_setup {
 sub _is_lob_column {
   my ($self, $source, $column) = @_;
 
-  return $self->_is_lob_type($source->column_info($column)->{data_type});
+  return $self->_is_lob_type(
+    $source->columns_info([$column])->{$column}{data_type}
+  );
 }
 
 sub _prep_for_execute {
@@ -357,15 +359,28 @@ sub insert {
   # try to insert explicit 'DEFAULT's instead (except for identity, timestamp
   # and computed columns)
   if (not %$to_insert) {
+
+    my $ci;
+    # same order as add_columns
     for my $col ($source->columns) {
       next if $col eq $identity_col;
 
-      my $info = $source->column_info($col);
-
-      next if ref $info->{default_value} eq 'SCALAR'
-        || (exists $info->{data_type} && (not defined $info->{data_type}));
-
-      next if $info->{data_type} && $info->{data_type} =~ /^timestamp\z/i;
+      my $info = ( $ci ||= $source->columns_info )->{$col};
+
+      next if (
+        ref $info->{default_value} eq 'SCALAR'
+          or
+        (
+          exists $info->{data_type}
+            and
+          ! defined $info->{data_type}
+        )
+          or
+        (
+          ( $info->{data_type} || '' )
+            =~ /^timestamp\z/i
+        )
+      );
 
       $to_insert->{$col} = \'DEFAULT';
     }
index 4cc21f0..4ca3f93 100644 (file)
@@ -127,6 +127,10 @@ sub parse {
                                        name => $table_name,
                                        type => 'TABLE',
                                        );
+
+        my $ci = $source->columns_info;
+
+        # same order as add_columns
         foreach my $col ($source->columns)
         {
             # assuming column_info in dbic is the same as DBI (?)
@@ -137,7 +141,7 @@ sub parse {
               is_auto_increment => 0,
               is_foreign_key => 0,
               is_nullable => 0,
-              %{$source->column_info($col)}
+              %{$ci->{$col} || {}}
             );
             if ($colinfo{is_nullable}) {
               $colinfo{default} = '' unless exists $colinfo{default};
index 62655e0..f656802 100644 (file)
@@ -40,7 +40,7 @@ warning_like {
     { "foreign.id" => "self.link" },
   );
 }
-  qr{"might_have/has_one" must not be on columns with is_nullable set to true},
+  qr{'might_have'/'has_one' must not be used on columns with is_nullable set to true},
   'might_have should warn if the self.id column is nullable';
 
 {