X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSQLMaker%2FMySQL.pm;h=34ee05445ddba83a1fc88cd3920e3ef0bd925d55;hb=e04535201f33f1d9c6222106a218944cf9eb3dbe;hp=16e47e7b7e7cde3af481b47fd7df2fe17520daf5;hpb=d5dedbd62928f65a9071b4d9b6d56c6b663a073b;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/SQLMaker/MySQL.pm b/lib/DBIx/Class/SQLMaker/MySQL.pm
index 16e47e7..34ee054 100644
--- a/lib/DBIx/Class/SQLMaker/MySQL.pm
+++ b/lib/DBIx/Class/SQLMaker/MySQL.pm
@@ -1,8 +1,10 @@
 package # Hide from PAUSE
   DBIx::Class::SQLMaker::MySQL;
 
+use warnings;
+use strict;
+
 use base qw( DBIx::Class::SQLMaker );
-use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
 
 #
 # MySQL does not understand the standard INSERT INTO $table DEFAULT VALUES
@@ -11,14 +13,12 @@ use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
 sub insert {
   my $self = shift;
 
-  my $table = $_[0];
-  $table = $self->_quote($table);
-
   if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
+    my $table = $self->_quote($_[0]);
     return "INSERT INTO ${table} () VALUES ()"
   }
 
-  return $self->SUPER::insert (@_);
+  return $self->next::method (@_);
 }
 
 # Allow STRAIGHT_JOIN's
@@ -29,6 +29,87 @@ sub _generate_join_clause {
         return ' STRAIGHT_JOIN '
     }
 
-    return $self->SUPER::_generate_join_clause( $join_type );
+    return $self->next::method($join_type);
+}
+
+my $force_double_subq;
+$force_double_subq = sub {
+  my ($self, $sql) = @_;
+
+  require Text::Balanced;
+  my $new_sql;
+  while (1) {
+
+    my ($prefix, $parenthesized);
+
+    ($parenthesized, $sql, $prefix) = do {
+      # idiotic design - writes to $@ but *DOES NOT* throw exceptions
+      local $@;
+      Text::Balanced::extract_bracketed( $sql, '()', qr/[^\(]*/ );
+    };
+
+    # this is how an error is indicated, in addition to crapping in $@
+    last unless $parenthesized;
+
+    if ($parenthesized =~ $self->{_modification_target_referenced_re}) {
+      # is this a select subquery?
+      if ( $parenthesized =~ /^ \( \s* SELECT \s+ /xi ) {
+        $parenthesized = "( SELECT * FROM $parenthesized `_forced_double_subquery` )";
+      }
+      # then drill down until we find it (if at all)
+      else {
+        $parenthesized =~ s/^ \( (.+) \) $/$1/x;
+        $parenthesized = join ' ', '(', $self->$force_double_subq( $parenthesized ), ')';
+      }
+    }
+
+    $new_sql .= $prefix . $parenthesized;
+  }
+
+  return $new_sql . $sql;
+};
+
+sub update {
+  my $self = shift;
+
+  # short-circuit unless understood identifier
+  return $self->next::method(@_) unless $self->{_modification_target_referenced_re};
+
+  my ($sql, @bind) = $self->next::method(@_);
+
+  $sql = $self->$force_double_subq($sql)
+    if $sql =~ $self->{_modification_target_referenced_re};
+
+  return ($sql, @bind);
+}
+
+sub delete {
+  my $self = shift;
+
+  # short-circuit unless understood identifier
+  return $self->next::method(@_) unless $self->{_modification_target_referenced_re};
+
+  my ($sql, @bind) = $self->next::method(@_);
+
+  $sql = $self->$force_double_subq($sql)
+    if $sql =~ $self->{_modification_target_referenced_re};
+
+  return ($sql, @bind);
+}
+
+# LOCK IN SHARE MODE
+my $for_syntax = {
+   update => 'FOR UPDATE',
+   shared => 'LOCK IN SHARE MODE'
+};
+
+sub _lock_select {
+   my ($self, $type) = @_;
+
+   my $sql = $for_syntax->{$type}
+    || $self->throw_exception("Unknown SELECT .. FOR type '$type' requested");
+
+   return " $sql";
 }
+
 1;