/usr/share/perl5/DBIx/Class/SQLMaker/MySQL.pm is in libdbix-class-perl 0.082840-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | 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";
}
1;
|