lib/DBIx/Class/SQLMaker/SQLStatement.pm

   1 package # Hide from PAUSE
   2    DBIx::Class::SQLMaker::SQLStatement;
   3
   4 use parent 'DBIx::Class::SQLMaker';
   5
   6 # SQL::Statement does not understand
   7 # INSERT INTO $table DEFAULT VALUES
   8 # Adjust SQL here instead
   9 sub insert {  # basically just a copy of the MySQL version...
  10    my $self = shift;
  11
  12    if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
  13       my $table = $self->_quote($_[0]);
  14       return "INSERT INTO ${table} (1) VALUES (1)"
  15    }
  16
  17    return $self->next::method (@_);
  18 }
  19
  20 # SQL::Statement does not understand
  21 # SELECT ... FOR UPDATE
  22 # Disable it here
  23 sub _lock_select () { '' };
  24
  25 # SQL::Statement hates LIMIT ?, ?
  26 # Change it to a non-bind version
  27 sub _LimitXY {
  28    my ( $self, $sql, $rs_attrs, $rows, $offset ) = @_;
  29    $sql .= $self->_parse_rs_attrs( $rs_attrs ) . " LIMIT ";
  30    $sql .= "$offset, " if +$offset;
  31    $sql .= $rows;
  32    return $sql;
  33 }
  34
  35 # SQL::Statement can't handle more than
  36 # one ANSI join, so just convert them all
  37 # to Oracle 8i-style WHERE-clause joins
  38
  39 # (As such, we are stealing globs of code from OracleJoins.pm...)
  40
  41 sub select {
  42    my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_;
  43
  44    if (ref $table eq 'ARRAY') {
  45       # count tables accurately
  46       my ($cnt, @node) = (0, @$table);
  47       while (my $tbl = shift @node) {
  48          my $r = ref $tbl;
  49          if    ($r eq 'ARRAY') { push(@node, @$tbl); }
  50          elsif ($r eq 'HASH')  { $cnt++ if ($tbl->{'-rsrc'}); }
  51       }
  52
  53       # pull out all join conds as regular WHEREs from all extra tables
  54       # (but only if we're joining more than 2 tables)
  55       if ($cnt > 2) {
  56          $where = $self->_where_joins($where, @{ $table }[ 1 .. $#$table ]);
  57       }
  58    }
  59
  60    return $self->next::method($table, $fields, $where, $rs_attrs, @rest);
  61 }
  62
  63 sub _recurse_from {
  64    my ($self, $from, @join) = @_;
  65
  66    # check for a single JOIN
  67    unless (@join > 1) {
  68       my $sql = $self->next::method($from, @join);
  69
  70       # S:S still doesn't like the JOIN X ON ( Y ) syntax with the parens
  71       $sql =~ s/JOIN (.+) ON \( (.+) \)/JOIN $1 ON $2/;
  72       return $sql;
  73    }
  74
  75    my @sqlf = $self->_from_chunk_to_sql($from);
  76
  77    for (@join) {
  78       my ($to, $on) = @$_;
  79
  80       push (@sqlf, (ref $to eq 'ARRAY') ?
  81          $self->_recurse_from(@$to) :
  82          $self->_from_chunk_to_sql($to)
  83       );
  84    }
  85
  86    return join q{, }, @sqlf;
  87 }
  88
  89 sub _where_joins {
  90    my ($self, $where, @join) = @_;
  91    my $join_where = $self->_recurse_where_joins(@join);
  92
  93    if (keys %$join_where) {
  94       unless (defined $where) { $where = $join_where; }
  95       else {
  96          $where = { -or  => $where } if (ref $where eq 'ARRAY');
  97          $where = { -and => [ $join_where, $where ] };
  98       }
  99    }
 100    return $where;
 101 }
 102
 103 sub _recurse_where_joins {
 104    my $self = shift;
 105
 106    my @where;
 107    foreach my $j (@_) {
 108       my ($to, $on) = @$j;
 109
 110       push @where, $self->_recurse_where_joins(@$to) if (ref $to eq 'ARRAY');
 111
 112       my $join_opts = ref $to eq 'ARRAY' ? $to->[0] : $to;
 113       if (ref $join_opts eq 'HASH' and my $jt = $join_opts->{-join_type}) {
 114          # TODO: Figure out a weird way to support ANSI joins and WHERE joins at the same time.
 115          # (Though, time would be better spent just fixing SQL::Parser to not require this stuff.)
 116
 117          $self->throw_exception("Can't handle non-inner, non-ANSI joins in SQL::Statement SQL yet!\n")
 118             if $jt =~ /NATURAL|LEFT|RIGHT|FULL|CROSS|UNION/i;
 119       }
 120
 121       # sadly SQLA treats where($scalar) as literal, so we need to jump some hoops
 122       push @where, map { \sprintf ('%s = %s',
 123          ref $_        ? $self->_recurse_where($_)        : $self->_quote($_),
 124          ref $on->{$_} ? $self->_recurse_where($on->{$_}) : $self->_quote($on->{$_}),
 125       ) } keys %$on;
 126    }
 127
 128    return { -and => \@where };
 129 }
 130
 131 1;