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=4eefc9d7b33f58938bf185f77118fd9ddf85cf37;hpb=9c1700e39e6ee002d9294c0d988882d1f0d7d86f;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/SQLMaker/MySQL.pm b/lib/DBIx/Class/SQLMaker/MySQL.pm index 4eefc9d..34ee054 100644 --- a/lib/DBIx/Class/SQLMaker/MySQL.pm +++ b/lib/DBIx/Class/SQLMaker/MySQL.pm @@ -1,9 +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/; -use namespace::clean; # # MySQL does not understand the standard INSERT INTO $table DEFAULT VALUES @@ -12,14 +13,12 @@ use namespace::clean; 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 @@ -30,7 +29,72 @@ 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 @@ -42,7 +106,8 @@ my $for_syntax = { sub _lock_select { my ($self, $type) = @_; - my $sql = $for_syntax->{$type} || croak "Unknown SELECT .. FOR type '$type' requested"; + my $sql = $for_syntax->{$type} + || $self->throw_exception("Unknown SELECT .. FOR type '$type' requested"); return " $sql"; }