From: Peter Rabbitson Date: Thu, 16 Jun 2011 08:26:59 +0000 (+0200) Subject: Yet another SQL munging atrocity (shadow needs it) X-Git-Tag: v0.08193~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ea5c75092e8ce0b58d0c9951a73cf1338c62f68c;p=dbsrgits%2FDBIx-Class.git Yet another SQL munging atrocity (shadow needs it) --- diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm index d9a97fc..35276d4 100644 --- a/lib/DBIx/Class/Storage/DBIHacks.pm +++ b/lib/DBIx/Class/Storage/DBIHacks.pm @@ -15,6 +15,7 @@ use mro 'c3'; use List::Util 'first'; use Scalar::Util 'blessed'; +use Sub::Name 'subname'; use namespace::clean; # @@ -591,6 +592,61 @@ sub _inner_join_to_node { return \@new_from; } +# 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 { + $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); + + } + + $smic_class->new(); + }; + + $sql_maker->_recurse_where($cond); + + return [ sort keys %{$sql_maker->_get_captured_idents} ]; +} + sub _extract_order_criteria { my ($self, $order_by, $sql_maker) = @_;