File Coverage

blib/lib/DBIx/Class/SQLMaker/MySQL.pm
Criterion Covered Total %
statement 23 32 71.8
branch 6 12 50.0
condition 2 12 16.6
subroutine 6 8 75.0
pod 3 3 100.0
total 40 67 59.7


line stmt bran cond sub pod time code
1             package # Hide from PAUSE
2             DBIx::Class::SQLMaker::MySQL;
3              
4 3     3   578 use warnings;
  3         4  
  3         99  
5 3     3   13 use strict;
  3         3  
  3         74  
6              
7 3     3   14 use base qw( DBIx::Class::SQLMaker );
  3         4  
  3         1855  
8              
9             #
10             # MySQL does not understand the standard INSERT INTO $table DEFAULT VALUES
11             # Adjust SQL here instead
12             #
13             sub insert {
14 0     0 1 0 my $self = shift;
15              
16 0 0 0     0 if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
  0   0     0  
17 0         0 my $table = $self->_quote($_[0]);
18 0         0 return "INSERT INTO ${table} () VALUES ()"
19             }
20              
21 0         0 return $self->next::method (@_);
22             }
23              
24             # Allow STRAIGHT_JOIN's
25             sub _generate_join_clause {
26 9     9   14 my ($self, $join_type) = @_;
27              
28 9 100 66     57 if( $join_type && $join_type =~ /^STRAIGHT\z/i ) {
29 2         11 return ' STRAIGHT_JOIN '
30             }
31              
32 7         15 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 2     2 1 4 my $self = shift;
74              
75             # short-circuit unless understood identifier
76 2 50       6 return $self->next::method(@_) unless $self->{_modification_target_referenced_re};
77              
78 2         6 my ($sql, @bind) = $self->next::method(@_);
79              
80             $sql = $self->$force_double_subq($sql)
81 2 50       302 if $sql =~ $self->{_modification_target_referenced_re};
82              
83 2         12 return ($sql, @bind);
84             }
85              
86             sub delete {
87 2     2 1 5 my $self = shift;
88              
89             # short-circuit unless understood identifier
90 2 50       8 return $self->next::method(@_) unless $self->{_modification_target_referenced_re};
91              
92 2         7 my ($sql, @bind) = $self->next::method(@_);
93              
94             $sql = $self->$force_double_subq($sql)
95 2 50       662 if $sql =~ $self->{_modification_target_referenced_re};
96              
97 2         8 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 0     0     my ($self, $type) = @_;
108              
109 0   0       my $sql = $for_syntax->{$type}
110             || $self->throw_exception("Unknown SELECT .. FOR type '$type' requested");
111              
112 0           return " $sql";
113             }
114              
115             1;