Slightly golf ::ResultSource::DESTROY and several weaken() calls
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / SQLMaker / MySQL.pm
1 package # Hide from PAUSE
2   DBIx::Class::SQLMaker::MySQL;
3
4 use warnings;
5 use strict;
6
7 use base qw( DBIx::Class::SQLMaker );
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
16   if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
17     my $table = $self->_quote($_[0]);
18     return "INSERT INTO ${table} () VALUES ()"
19   }
20
21   return $self->next::method (@_);
22 }
23
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
32     return $self->next::method($join_type);
33 }
34
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
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
109    my $sql = $for_syntax->{$type}
110     || $self->throw_exception("Unknown SELECT .. FOR type '$type' requested");
111
112    return " $sql";
113 }
114
115 1;