lib/DBIx/Class/ResultSource/FromSpec/Util.pm

   1 package   #hide from PAUSE
   2   DBIx::Class::ResultSource::FromSpec::Util;
   3
   4 use strict;
   5 use warnings;
   6
   7 use base 'Exporter';
   8 our @EXPORT_OK = qw(
   9   fromspec_columns_info
  10   find_join_path_to_alias
  11 );
  12
  13 use Scalar::Util 'blessed';
  14
  15 # Takes $fromspec, \@column_names
  16 #
  17 # returns { $column_name => \%column_info, ... } for fully qualified and
  18 # where possible also unqualified variants
  19 # also note: this adds -result_source => $rsrc to the column info
  20 #
  21 # If no columns_names are supplied returns info about *all* columns
  22 # for all sources
  23 sub fromspec_columns_info {
  24   my ($fromspec, $colnames) = @_;
  25
  26   return {} if $colnames and ! @$colnames;
  27
  28   my $sources = (
  29     # this is compat mode for insert/update/delete which do not deal with aliases
  30     (
  31       blessed($fromspec)
  32         and
  33       $fromspec->isa('DBIx::Class::ResultSource')
  34     )                                                 ? +{ me => $fromspec }
  35
  36     # not a known fromspec - no columns to resolve: return directly
  37   : ref($fromspec) ne 'ARRAY'                         ? return +{}
  38
  39                                                       : +{
  40     # otherwise decompose into alias/rsrc pairs
  41       map
  42         {
  43           ( $_->{-rsrc} and $_->{-alias} )
  44             ? ( @{$_}{qw( -alias -rsrc )} )
  45             : ()
  46         }
  47         map
  48           {
  49             ( ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH' ) ? $_->[0]
  50           : ( ref $_ eq 'HASH' )                            ? $_
  51                                                             : ()
  52           }
  53           @$fromspec
  54     }
  55   );
  56
  57   $_ = { rsrc => $_, colinfos => $_->columns_info }
  58     for values %$sources;
  59
  60   my (%seen_cols, @auto_colnames);
  61
  62   # compile a global list of column names, to be able to properly
  63   # disambiguate unqualified column names (if at all possible)
  64   for my $alias (keys %$sources) {
  65     (
  66       ++$seen_cols{$_}{$alias}
  67         and
  68       ! $colnames
  69         and
  70       push @auto_colnames, "$alias.$_"
  71     ) for keys %{ $sources->{$alias}{colinfos} };
  72   }
  73
  74   $colnames ||= [
  75     @auto_colnames,
  76     ( grep { keys %{$seen_cols{$_}} == 1 } keys %seen_cols ),
  77   ];
  78
  79   my %return;
  80   for (@$colnames) {
  81     my ($colname, $source_alias) = reverse split /\./, $_;
  82
  83     my $assumed_alias =
  84       $source_alias
  85         ||
  86       # if the column was seen exactly once - we know which rsrc it came from
  87       (
  88         $seen_cols{$colname}
  89           and
  90         keys %{$seen_cols{$colname}} == 1
  91           and
  92         ( %{$seen_cols{$colname}} )[0]
  93       )
  94         ||
  95       next
  96     ;
  97
  98     DBIx::Class::Exception->throw(
  99       "No such column '$colname' on source " . $sources->{$assumed_alias}{rsrc}->source_name
 100     ) unless $seen_cols{$colname}{$assumed_alias};
 101
 102     $return{$_} = {
 103       %{ $sources->{$assumed_alias}{colinfos}{$colname} },
 104       -result_source => $sources->{$assumed_alias}{rsrc},
 105       -source_alias => $assumed_alias,
 106       -fq_colname => "$assumed_alias.$colname",
 107       -colname => $colname,
 108     };
 109
 110     $return{"$assumed_alias.$colname"} = $return{$_}
 111       unless $source_alias;
 112   }
 113
 114   \%return;
 115 }
 116
 117 sub find_join_path_to_alias {
 118   my ($fromspec, $target_alias) = @_;
 119
 120   # subqueries and other oddness are naturally not supported
 121   return undef if (
 122     ref $fromspec ne 'ARRAY'
 123       ||
 124     ref $fromspec->[0] ne 'HASH'
 125       ||
 126     ! defined $fromspec->[0]{-alias}
 127   );
 128
 129   # no path - the head *is* the alias
 130   return [] if $fromspec->[0]{-alias} eq $target_alias;
 131
 132   for my $i (1 .. $#$fromspec) {
 133     return $fromspec->[$i][0]{-join_path} if ( ($fromspec->[$i][0]{-alias}||'') eq $target_alias );
 134   }
 135
 136   # something else went quite wrong
 137   return undef;
 138 }
 139
 140 1;