-package DBIx::Class::Storage::DBIHacks;
+package #hide from PAUSE
+ DBIx::Class::Storage::DBIHacks;
#
# This module contains code that should never have seen the light of day,
# returns { $column_name => \%column_info, ... }
# also note: this adds -result_source => $rsrc to the column info
#
-# usage:
-# my $col_sources = $self->_resolve_column_info($ident, @column_names);
+# If no columns_names are supplied returns info about *all* columns
+# for all sources
sub _resolve_column_info {
my ($self, $ident, $colnames) = @_;
my ($alias2src, $root_alias) = $self->_resolve_ident_sources($ident);
my $sep = $self->_sql_maker_opts->{name_sep} || '.';
- $sep = "\Q$sep\E";
+ my $qsep = quotemeta $sep;
- my (%return, %seen_cols);
+ my (%return, %seen_cols, @auto_colnames);
# compile a global list of column names, to be able to properly
# disambiguate unqualified column names (if at all possible)
my $rsrc = $alias2src->{$alias};
for my $colname ($rsrc->columns) {
push @{$seen_cols{$colname}}, $alias;
+ push @auto_colnames, "$alias$sep$colname" unless $colnames;
}
}
+ $colnames ||= [
+ @auto_colnames,
+ grep { @{$seen_cols{$_}} == 1 } (keys %seen_cols),
+ ];
+
COLUMN:
foreach my $col (@$colnames) {
- my ($alias, $colname) = $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x;
+ my ($alias, $colname) = $col =~ m/^ (?: ([^$qsep]+) $qsep)? (.+) $/x;
unless ($alias) {
# see if the column was seen exactly once (so we know which rsrc it came from)
return \@new_from;
}
+# Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
+# a condition containing 'me' or other table prefixes will not work
+# at all. What this code tries to do (badly) is introspect the condition
+# and remove all column qualifiers. If it bails out early (returns undef)
+# the calling code should try another approach (e.g. a subquery)
+sub _strip_cond_qualifiers {
+ my ($self, $where) = @_;
+
+ my $cond = {};
+
+ # No-op. No condition, we're updating/deleting everything
+ return $cond unless $where;
+
+ if (ref $where eq 'ARRAY') {
+ $cond = [
+ map {
+ my %hash;
+ foreach my $key (keys %{$_}) {
+ $key =~ /([^.]+)$/;
+ $hash{$1} = $_->{$key};
+ }
+ \%hash;
+ } @$where
+ ];
+ }
+ elsif (ref $where eq 'HASH') {
+ if ( (keys %$where) == 1 && ( (keys %{$where})[0] eq '-and' )) {
+ $cond->{-and} = [];
+ my @cond = @{$where->{-and}};
+ for (my $i = 0; $i < @cond; $i++) {
+ my $entry = $cond[$i];
+ my $hash;
+ if (ref $entry eq 'HASH') {
+ $hash = $self->_strip_cond_qualifiers($entry);
+ }
+ else {
+ $entry =~ /([^.]+)$/;
+ $hash->{$1} = $cond[++$i];
+ }
+ push @{$cond->{-and}}, $hash;
+ }
+ }
+ else {
+ foreach my $key (keys %$where) {
+ $key =~ /([^.]+)$/;
+ $cond->{$1} = $where->{$key};
+ }
+ }
+ }
+ else {
+ return undef;
+ }
+
+ return $cond;
+}
+
+
1;