Unset collapse in even more cases
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / SQLMaker / MySQL.pm
CommitLineData
87aa29e2 1package # Hide from PAUSE
d5dedbd6 2 DBIx::Class::SQLMaker::MySQL;
87aa29e2 3
45150bc4 4use warnings;
5use strict;
6
d5dedbd6 7use base qw( DBIx::Class::SQLMaker );
87aa29e2 8
9#
10# MySQL does not understand the standard INSERT INTO $table DEFAULT VALUES
11# Adjust SQL here instead
12#
13sub insert {
14 my $self = shift;
15
87aa29e2 16 if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
70551c3d 17 my $table = $self->_quote($_[0]);
87aa29e2 18 return "INSERT INTO ${table} () VALUES ()"
19 }
20
70551c3d 21 return $self->next::method (@_);
87aa29e2 22}
23
b8391c87 24# Allow STRAIGHT_JOIN's
25sub _generate_join_clause {
26 my ($self, $join_type) = @_;
27
28 if( $join_type && $join_type =~ /^STRAIGHT\z/i ) {
29 return ' STRAIGHT_JOIN '
30 }
31
70551c3d 32 return $self->next::method($join_type);
b8391c87 33}
4e0a89e4 34
45150bc4 35my $force_double_subq;
36$force_double_subq = sub {
37 my ($self, $sql) = @_;
38
39 require Text::Balanced;
40 my $new_sql;
41 while (1) {
42
43 my ($prefix, $parenthesized);
44
45 ($parenthesized, $sql, $prefix) = do {
46 # idiotic design - writes to $@ but *DOES NOT* throw exceptions
47 local $@;
48 Text::Balanced::extract_bracketed( $sql, '()', qr/[^\(]*/ );
49 };
50
51 # this is how an error is indicated, in addition to crapping in $@
52 last unless $parenthesized;
53
54 if ($parenthesized =~ $self->{_modification_target_referenced_re}) {
55 # is this a select subquery?
56 if ( $parenthesized =~ /^ \( \s* SELECT \s+ /xi ) {
57 $parenthesized = "( SELECT * FROM $parenthesized `_forced_double_subquery` )";
58 }
59 # then drill down until we find it (if at all)
60 else {
61 $parenthesized =~ s/^ \( (.+) \) $/$1/x;
62 $parenthesized = join ' ', '(', $self->$force_double_subq( $parenthesized ), ')';
63 }
64 }
65
66 $new_sql .= $prefix . $parenthesized;
67 }
68
69 return $new_sql . $sql;
70};
71
72sub update {
73 my $self = shift;
74
75 # short-circuit unless understood identifier
76 return $self->next::method(@_) unless $self->{_modification_target_referenced_re};
77
78 my ($sql, @bind) = $self->next::method(@_);
79
80 $sql = $self->$force_double_subq($sql)
81 if $sql =~ $self->{_modification_target_referenced_re};
82
83 return ($sql, @bind);
84}
85
86sub delete {
87 my $self = shift;
88
89 # short-circuit unless understood identifier
90 return $self->next::method(@_) unless $self->{_modification_target_referenced_re};
91
92 my ($sql, @bind) = $self->next::method(@_);
93
94 $sql = $self->$force_double_subq($sql)
95 if $sql =~ $self->{_modification_target_referenced_re};
96
97 return ($sql, @bind);
98}
99
4e0a89e4 100# LOCK IN SHARE MODE
101my $for_syntax = {
102 update => 'FOR UPDATE',
103 shared => 'LOCK IN SHARE MODE'
104};
105
106sub _lock_select {
107 my ($self, $type) = @_;
108
70c28808 109 my $sql = $for_syntax->{$type}
110 || $self->throw_exception("Unknown SELECT .. FOR type '$type' requested");
4e0a89e4 111
112 return " $sql";
113}
114
87aa29e2 1151;