A little more golfing - this time ::DBIHacks::_resolve_column_info
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBIHacks.pm
index 33698c4..7da10cc 100644 (file)
@@ -469,70 +469,76 @@ sub _resolve_aliastypes_from_select_args {
   ) for keys %$to_scan;
 
 
-  # first see if we have any exact matches (qualified or unqualified)
+  # the actual scan, per type
   for my $type (keys %$to_scan) {
+
+    # first see if we have any exact matches (qualified or unqualified)
     for my $piece (@{$to_scan->{$type}}) {
       if ($colinfo->{$piece} and my $alias = $colinfo->{$piece}{-source_alias}) {
         $aliases_by_type->{$type}{$alias} ||= { -parents => $alias_list->{$alias}{-join_path}||[] };
         $aliases_by_type->{$type}{$alias}{-seen_columns}{$colinfo->{$piece}{-fq_colname}} = $piece;
       }
     }
-  }
 
-  # now loop through all fully qualified columns and get the corresponding
-  # alias (should work even if they are in scalarrefs)
-  for my $alias (keys %$alias_list) {
-    my $al_re = qr/
-      $lquote $alias $rquote $sep (?: $lquote ([^$rquote]+) $rquote )?
-        |
-      \b $alias \. ([^\s\)\($rquote]+)?
-    /x;
-
-    for my $type (keys %$to_scan) {
-      for my $piece (@{$to_scan->{$type}}) {
-        if (my @matches = $piece =~ /$al_re/g) {
-          $aliases_by_type->{$type}{$alias} ||= { -parents => $alias_list->{$alias}{-join_path}||[] };
-          $aliases_by_type->{$type}{$alias}{-seen_columns}{"$alias.$_"} = "$alias.$_"
-            for grep { defined $_ } @matches;
-        }
+    # we will be bulk-scanning anyway - pieces will not matter in that case
+    # (unlike in the direct-equivalence above)
+    my $scan_string = join ' ', @{$to_scan->{$type}};
+
+    # now loop through all fully qualified columns and get the corresponding
+    # alias (should work even if they are in scalarrefs)
+    for my $alias (keys %$alias_list) {
+      my $al_re = qr/
+        $lquote $alias $rquote $sep (?: $lquote ([^$rquote]+) $rquote )?
+          |
+        \b $alias \. ([^\s\)\($rquote]+)?
+      /x;
+
+      if (my @matches = $scan_string =~ /$al_re/g) {
+        $aliases_by_type->{$type}{$alias} ||= { -parents => $alias_list->{$alias}{-join_path}||[] };
+        $aliases_by_type->{$type}{$alias}{-seen_columns}{"$alias.$_"} = "$alias.$_"
+          for grep { defined $_ } @matches;
       }
     }
-  }
 
-  # now loop through unqualified column names, and try to locate them within
-  # the chunks
-  for my $col (keys %$colinfo) {
-    next if $col =~ / \. /x;   # if column is qualified it was caught by the above
+    # now loop through unqualified column names, and try to locate them within
+    # the chunks
+    for my $col (keys %$colinfo) {
+      next if $col =~ / \. /x;   # if column is qualified it was caught by the above
 
-    my $col_re = qr/ $lquote ($col) $rquote /x;
+      my $col_re = qr/ $lquote ($col) $rquote /x;
 
-    for my $type (keys %$to_scan) {
-      for my $piece (@{$to_scan->{$type}}) {
-        if ( my @matches = $piece =~ /$col_re/g) {
-          my $alias = $colinfo->{$col}{-source_alias};
-          $aliases_by_type->{$type}{$alias} ||= { -parents => $alias_list->{$alias}{-join_path}||[] };
-          $aliases_by_type->{$type}{$alias}{-seen_columns}{"$alias.$_"} = $_
-            for grep { defined $_ } @matches;
-        }
+      if ( my @matches = $scan_string =~ /$col_re/g) {
+        my $alias = $colinfo->{$col}{-source_alias};
+        $aliases_by_type->{$type}{$alias} ||= { -parents => $alias_list->{$alias}{-join_path}||[] };
+        $aliases_by_type->{$type}{$alias}{-seen_columns}{"$alias.$_"} = $_
+          for grep { defined $_ } @matches;
       }
     }
   }
 
   # Add any non-left joins to the restriction list (such joins are indeed restrictions)
-  for my $j (values %$alias_list) {
-    my $alias = $j->{-alias} or next;
-    $aliases_by_type->{restricting}{$alias} ||= { -parents => $j->{-join_path}||[] } if (
-      (not $j->{-join_type})
+  (
+    $_->{-alias}
+      and
+    ! $aliases_by_type->{restricting}{ $_->{-alias} }
+      and
+    (
+      not $_->{-join_type}
         or
-      ($j->{-join_type} !~ /^left (?: \s+ outer)? $/xi)
-    );
-  }
+      $_->{-join_type} !~ /^left (?: \s+ outer)? $/xi
+    )
+      and
+    $aliases_by_type->{restricting}{ $_->{-alias} } = { -parents => $_->{-join_path}||[] }
+  ) for values %$alias_list;
 
-  for (keys %$aliases_by_type) {
-    delete $aliases_by_type->{$_} unless keys %{$aliases_by_type->{$_}};
-  }
+  # final cleanup
+  (
+    keys %{$aliases_by_type->{$_}}
+      or
+    delete $aliases_by_type->{$_}
+  ) for keys %$aliases_by_type;
 
-  return $aliases_by_type;
+  $aliases_by_type;
 }
 
 # This is the engine behind { distinct => 1 } and the general
@@ -713,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;