Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
Role	[ DIR ]	drwxrwxrwx	2024-07-26 17:40
ACCESS.pm	742 B	-rw-rw-rw-	2018-04-30 13:43
ClassicExtensions.pm	34.83 KB	-rw-rw-rw-	2020-03-29 22:33
LimitDialects.pm	4.94 KB	-rw-rw-rw-	2020-03-29 22:33
MSSQL.pm	237 B	-rw-rw-rw-	2016-08-24 09:05
MySQL.pm	2.63 KB	-rw-rw-rw-	2016-08-24 09:05
Oracle.pm	6.17 KB	-rw-rw-rw-	2020-03-29 22:33
OracleJoins.pm	4.43 KB	-rw-rw-rw-	2020-03-29 22:33
SQLite.pm	229 B	-rw-rw-rw-	2019-10-27 21:16

Rename

package # Hide from PAUSE
  DBIx::Class::SQLMaker::MySQL;

use warnings;
use strict;

use base qw( DBIx::Class::SQLMaker );

#
# MySQL does not understand the standard INSERT INTO $table DEFAULT VALUES
# Adjust SQL here instead
#
sub insert {
  my $self = shift;

if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
    my $table = $self->_quote($_[0]);
    return "INSERT INTO ${table} () VALUES ()"
  }

return $self->next::method (@_);
}

# Allow STRAIGHT_JOIN's
sub _generate_join_clause {
    my ($self, $join_type) = @_;

if( $join_type && $join_type =~ /^STRAIGHT\z/i ) {
        return ' STRAIGHT_JOIN '
    }

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";
}