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;