X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBIHacks.pm;h=82724963b69552c9ac1834a3306921670045f0b9;hb=8273e845426f0187b4ad6c4a1b42286fa09a648f;hp=583045c45ace9e924699e5ea9434bb34b2a72c58;hpb=a4812caaab21149be7c3c65ad6c0388046430130;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm index 583045c..8272496 100644 --- a/lib/DBIx/Class/Storage/DBIHacks.pm +++ b/lib/DBIx/Class/Storage/DBIHacks.pm @@ -4,7 +4,7 @@ package #hide from PAUSE # # This module contains code that should never have seen the light of day, # does not belong in the Storage, or is otherwise unfit for public -# display. The arrival of SQLA2 should immediately oboslete 90% of this +# display. The arrival of SQLA2 should immediately obsolete 90% of this # use strict; @@ -15,6 +15,7 @@ use mro 'c3'; use List::Util 'first'; use Scalar::Util 'blessed'; +use Sub::Name 'subname'; use namespace::clean; # @@ -60,7 +61,7 @@ sub _prune_unused_joins { # # This is the code producing joined subqueries like: -# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ... +# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ... # sub _adjust_select_args_for_complex_prefetch { my ($self, $from, $select, $where, $attrs) = @_; @@ -568,7 +569,7 @@ sub _inner_join_to_node { # So it looks like we will have to switch some stuff around. # local() is useless here as we will be leaving the scope # anyway, and deep cloning is just too fucking expensive - # So replace the first hashref in the node arrayref manually + # So replace the first hashref in the node arrayref manually my @new_from = ($from->[0]); my $sw_idx = { map { (values %$_), 1 } @$switch_branch }; #there's one k/v per join-path @@ -591,64 +592,59 @@ sub _inner_join_to_node { 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_from_array { - my ($self, $where) = @_; - my @cond; - for (my $i = 0; $i < @$where; $i++) { - my $entry = $where->[$i]; - my $hash; - my $ref = ref $entry; - if ($ref eq 'HASH' or $ref eq 'ARRAY') { - $hash = $self->_strip_cond_qualifiers($entry); - } - elsif (! $ref) { - $entry =~ /([^.]+)$/; - $hash->{$1} = $where->[++$i]; - } - push @cond, $hash; - } - return \@cond; -} - -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 = $self->_strip_cond_qualifiers_from_array($where); - } - elsif (ref $where eq 'HASH') { - if ( (keys %$where) == 1 && ( (keys %{$where})[0] eq '-and' )) { - $cond->{-and} = - $self->_strip_cond_qualifiers_from_array($where->{-and}); - } - else { - foreach my $key (keys %$where) { - if ($key eq '-or' && ref $where->{$key} eq 'ARRAY') { - $cond->{$key} = $self->_strip_cond_qualifiers($where->{$key}); +# yet another atrocity: attempt to extract all columns from a +# where condition by hooking _quote +sub _extract_condition_columns { + my ($self, $cond, $sql_maker) = @_; + + return [] unless $cond; + + $sql_maker ||= $self->{_sql_ident_capturer} ||= do { + # FIXME - replace with a Moo trait + my $orig_sm_class = ref $self->sql_maker; + my $smic_class = "${orig_sm_class}::_IdentCapture_"; + + unless ($smic_class->isa('SQL::Abstract')) { + + no strict 'refs'; + *{"${smic_class}::_quote"} = subname "${smic_class}::_quote" => sub { + my ($self, $ident) = @_; + if (ref $ident eq 'SCALAR') { + $ident = $$ident; + my $storage_quotes = $self->sql_quote_char || '"'; + my ($ql, $qr) = map + { quotemeta $_ } + (ref $storage_quotes eq 'ARRAY' ? @$storage_quotes : ($storage_quotes) x 2 ) + ; + + while ($ident =~ / + $ql (\w+) $qr + | + ([\w\.]+) + /xg) { + $self->{_captured_idents}{$1||$2}++; + } } else { - $key =~ /([^.]+)$/; - $cond->{$1} = $where->{$key}; + $self->{_captured_idents}{$ident}++; } - } + return $ident; + }; + + *{"${smic_class}::_get_captured_idents"} = subname "${smic_class}::_get_captures" => sub { + (delete shift->{_captured_idents}) || {}; + }; + + $self->inject_base ($smic_class, $orig_sm_class); + } - } - else { - return undef; - } - return $cond; + $smic_class->new(); + }; + + $sql_maker->_recurse_where($cond); + + return [ sort keys %{$sql_maker->_get_captured_idents} ]; } sub _extract_order_criteria {