From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 3 Nov 2013 23:34:35 +0000 (+0000)
Subject: identifier parsing to make mysql subselect wrapping work within literals
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e63932f36bad027fc4a355c244dd253817667cc0;p=dbsrgits%2FDBIx-Class.git

identifier parsing to make mysql subselect wrapping work within literals
---

diff --git a/lib/DBIx/Class/SQLMaker/Converter/MySQL.pm b/lib/DBIx/Class/SQLMaker/Converter/MySQL.pm
new file mode 100644
index 0000000..727eef5
--- /dev/null
+++ b/lib/DBIx/Class/SQLMaker/Converter/MySQL.pm
@@ -0,0 +1,83 @@
+package DBIx::Class::SQLMaker::Converter::MySQL;
+
+use Data::Query::ExprHelpers;
+use Moo;
+use namespace::clean;
+
+extends 'DBIx::Class::SQLMaker::Converter';
+
+foreach my $type (qw(update delete)) {
+  around "_${type}_to_dq" => sub {
+    my ($orig, $self) = (shift, shift);
+    $self->_mangle_mutation_dq($self->$orig(@_));
+  };
+}
+
+sub _mangle_mutation_dq {
+  my ($self, $dq) = @_;
+  my $target = $dq->{target};
+  my $target_name_re = do {
+    if (is_Identifier $target) {
+      join("\\.", map "(?:\`\Q$_\E\`|\Q$_\E)", @{$target->{elements}})
+    } elsif (
+      is_Literal $target
+      and $target->{literal}
+      and $target->{literal} =~ /^(?:\`([^`]+)\`|([\w\-]+))$/
+    ) {
+      map "\`\Q$_\E\`|\Q$_\E", (defined $1) ? $1 : $2;
+    } else {
+      undef
+    }
+  };
+  return $dq unless defined $target_name_re;
+  my $match_re = "SELECT(.*(?:FROM|JOIN)\\s+)${target_name_re}(.*)";
+  my $selectify = sub {
+    my ($before, $after, $values) = @_;
+    $before =~ s/FROM\s+(.*)//i;
+    my $from_before = $1;
+    return Select(
+      [ Literal('SQL' => $before) ],
+      Literal('SQL' => [
+        Literal('SQL' => $from_before),
+        $target,
+        Literal('SQL' => $after, $values)
+      ])
+    );
+  };
+  map_dq_tree {
+    if (is_Literal) {
+      if ($_->{literal} =~ /^${match_re}$/i) {
+        return \$selectify->($1, $2, $_->{values});
+      }
+      if ($_->{literal} =~ /\(\s*SELECT\s+/i) {
+        require Text::Balanced;
+        my $remain = $_->{literal};
+        my $before = '';
+        my @parts;
+        while ($remain =~ s/^(.*?)(\(\s*SELECT\s+.*)$/$2/i) {
+          $before .= $1;
+          (my ($select), $remain) = do {
+            # idiotic design - writes to $@ but *DOES NOT* throw exceptions
+            local $@;
+            Text::Balanced::extract_bracketed( $remain, '()', qr/[^\(]*/ );
+          };
+          return $_ unless $select; # balanced failed, give up
+          if ($select =~ /^\(\s*${match_re}\s*\)$/i) {
+            my $sel_dq = $selectify->($1, $2);
+            push @parts, Literal(SQL => "${before}("), $sel_dq;
+            $before = ')';
+          } else {
+            $before .= $select;
+          }
+        }
+        if (@parts) {
+          push @parts, Literal(SQL => $before.$remain, $_->{values});
+          return \Literal(SQL => \@parts);
+        }
+      }
+    }
+    $_
+  } $dq;
+};
+
+1;
diff --git a/lib/DBIx/Class/SQLMaker/MySQL.pm b/lib/DBIx/Class/SQLMaker/MySQL.pm
index 1b16ca8..d3af351 100644
--- a/lib/DBIx/Class/SQLMaker/MySQL.pm
+++ b/lib/DBIx/Class/SQLMaker/MySQL.pm
@@ -3,6 +3,10 @@ package # Hide from PAUSE
 
 use base qw( DBIx::Class::SQLMaker );
 
+sub _build_converter_class {
+  Module::Runtime::use_module('DBIx::Class::SQLMaker::Converter::MySQL');
+}
+
 sub _build_base_renderer_class {
   Module::Runtime::use_module('Data::Query::Renderer::SQL::MySQL');
 }