Commit | Line | Data |
87aa29e2 |
1 | package # Hide from PAUSE |
d5dedbd6 |
2 | DBIx::Class::SQLMaker::MySQL; |
87aa29e2 |
3 | |
45150bc4 |
4 | use warnings; |
5 | use strict; |
6 | |
d5dedbd6 |
7 | use 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 | # |
13 | sub 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 |
25 | sub _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 |
35 | my $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 | |
72 | sub 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 | |
86 | sub 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 |
101 | my $for_syntax = { |
102 | update => 'FOR UPDATE', |
103 | shared => 'LOCK IN SHARE MODE' |
104 | }; |
105 | |
106 | sub _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 |
115 | 1; |