From: Peter Rabbitson <ribasushi@cpan.org>
Date: Mon, 28 Sep 2015 13:34:12 +0000 (+0200)
Subject: A little more golfing - this time ::DBIHacks::_resolve_column_info
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=229401a04e99e27e256fdcd24b3c34087c9c2bc1;p=dbsrgits%2FDBIx-Class-Historic.git

A little more golfing - this time ::DBIHacks::_resolve_column_info

More surprising stuff showing up on the profiles...
---

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index c80ffc4..a123f41 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -13,7 +13,6 @@ use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
 use SQL::Abstract 'is_literal_value';
 use Devel::GlobalDestruction;
 use Try::Tiny;
-use List::Util 'first';
 use Scalar::Util qw/blessed weaken isweak/;
 
 use namespace::clean;
@@ -476,12 +475,12 @@ sub columns_info {
   my $colinfo = $self->_columns;
 
   if (
-    first { ! $_->{data_type} } values %$colinfo
-      and
     ! $self->{_columns_info_loaded}
       and
     $self->column_info_from_storage
       and
+    grep { ! $_->{data_type} } values %$colinfo
+      and
     my $stor = try { $self->storage }
   ) {
     $self->{_columns_info_loaded}++;
@@ -803,7 +802,7 @@ sub add_unique_constraints {
   my $self = shift;
   my @constraints = @_;
 
-  if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
+  if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
     # with constraint name
     while (my ($name, $constraint) = splice @constraints, 0, 2) {
       $self->add_unique_constraint($name => $constraint);
@@ -1708,9 +1707,11 @@ sub _resolve_join {
                 ,
                -join_path => [@$jpath, { $join => $as } ],
                -is_single => (
-                  (! $rel_info->{attrs}{accessor})
+                  ! $rel_info->{attrs}{accessor}
+                    or
+                  $rel_info->{attrs}{accessor} eq 'single'
                     or
-                  first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
+                  $rel_info->{attrs}{accessor} eq 'filter'
                 ),
                -alias => $as,
                -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm
index 937f771..7da10cc 100644
--- a/lib/DBIx/Class/Storage/DBIHacks.pm
+++ b/lib/DBIx/Class/Storage/DBIHacks.pm
@@ -719,53 +719,63 @@ sub _resolve_column_info {
 
   return {} if $colnames and ! @$colnames;
 
-  my $alias2src = $self->_resolve_ident_sources($ident);
+  my $sources = $self->_resolve_ident_sources($ident);
+
+  $_ = { rsrc => $_, colinfos => $_->columns_info }
+    for values %$sources;
 
   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)
-  for my $alias (keys %$alias2src) {
-    my $rsrc = $alias2src->{$alias};
-    for my $colname ($rsrc->columns) {
-      push @{$seen_cols{$colname}}, $alias;
-      push @auto_colnames, "$alias.$colname" unless $colnames;
-    }
+  for my $alias (keys %$sources) {
+    (
+      ++$seen_cols{$_}{$alias}
+        and
+      ! $colnames
+        and
+      push @auto_colnames, "$alias.$_"
+    ) for keys %{ $sources->{$alias}{colinfos} };
   }
 
   $colnames ||= [
     @auto_colnames,
-    grep { @{$seen_cols{$_}} == 1 } (keys %seen_cols),
+    ( grep { keys %{$seen_cols{$_}} == 1 } keys %seen_cols ),
   ];
 
-  my (%return, $colinfos);
-  foreach my $col (@$colnames) {
-    my ($source_alias, $colname) = $col =~ m/^ (?: ([^\.]+) \. )? (.+) $/x;
-
-    # 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 %return;
+  for (@$colnames) {
+    my ($colname, $source_alias) = reverse split /\./, $_;
 
-    next unless $source_alias;
+    my $assumed_alias =
+      $source_alias
+        ||
+      # if the column was seen exactly once - we know which rsrc it came from
+      (
+        $seen_cols{$colname}
+          and
+        keys %{$seen_cols{$colname}} == 1
+          and
+        ( %{$seen_cols{$colname}} )[0]
+      )
+        ||
+      next
+    ;
 
-    my $rsrc = $alias2src->{$source_alias}
-      or next;
+    $self->throw_exception(
+      "No such column '$colname' on source " . $sources->{$assumed_alias}{rsrc}->source_name
+    ) unless $seen_cols{$colname}{$assumed_alias};
 
-    $return{$col} = {
-      %{
-          ( $colinfos->{$source_alias} ||= $rsrc->columns_info )->{$colname}
-            ||
-          $self->throw_exception(
-            "No such column '$colname' on source " . $rsrc->source_name
-          );
-      },
-      -result_source => $rsrc,
-      -source_alias => $source_alias,
-      -fq_colname => $col eq $colname ? "$source_alias.$col" : $col,
+    $return{$_} = {
+      %{ $sources->{$assumed_alias}{colinfos}{$colname} },
+      -result_source => $sources->{$assumed_alias}{rsrc},
+      -source_alias => $assumed_alias,
+      -fq_colname => "$assumed_alias.$colname",
       -colname => $colname,
     };
 
-    $return{"$source_alias.$colname"} = $return{$col} if $col eq $colname;
+    $return{"$assumed_alias.$colname"} = $return{$_}
+      unless $source_alias;
   }
 
   return \%return;