DBIx::Class::SQLMaker::SQLStatement.pm

package # Hide from PAUSE
   DBIx::Class::SQLMaker::SQLStatement;

use parent 'DBIx::Class::SQLMaker';

# SQL::Statement does not understand
# INSERT INTO $table DEFAULT VALUES
# Adjust SQL here instead
sub insert {  # basically just a copy of the MySQL version...
   my $self = shift;

   if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
      my $table = $self->_quote($_[0]);
      return "INSERT INTO ${table} () VALUES ()"
   }

   return $self->next::method (@_);
}

# SQL::Statement does not understand
# SELECT ... FOR UPDATE
# Disable it here
sub _lock_select () { '' };

1;

# SQL::Statement can't handle more than
# one ANSI join, so just convert them all
# to Oracle 8i-style WHERE-clause joins

# (As such, we are stealing globs of code from OracleJoins.pm...)

sub select {
   my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_;

   if (ref $table eq 'ARRAY') {
      # count tables accurately
      my ($cnt, @node) = (0, @$table);
      while (my $tbl = shift @node) {
         my $r = ref $tbl;
         if    ($r eq 'ARRAY') { push(@node, @$tbl); }
         elsif ($r eq 'HASH')  { $cnt++ if ($tbl->{'-rsrc'}); }
      }
      
      # pull out all join conds as regular WHEREs from all extra tables
      # (but only if we're joining more than 2 tables)
      if ($cnt > 2) {
         $where = $self->_where_joins($where, @{ $table }[ 1 .. $#$table ]);
      }
   }
   
   return $self->next::method($table, $fields, $where, $rs_attrs, @rest);
}

sub _recurse_from {
   my ($self, $from, @join) = @_;

   # check for a single JOIN
   unless (@join > 1) {
      my $sql = $self->next::method($from, @join);
      
      # S:S still doesn't like the JOIN X ON ( Y ) syntax with the parens
      $sql =~ s/JOIN (.+) ON \( (.+) \)/JOIN $1 ON $2/;
      return $sql;
   }
   
   my @sqlf = $self->_from_chunk_to_sql($from);

   for (@join) {
      my ($to, $on) = @$_;

      push (@sqlf, (ref $to eq 'ARRAY') ?
         $self->_recurse_from(@$to) :
         $self->_from_chunk_to_sql($to)
      );
   }

   return join q{, }, @sqlf;
}

sub _where_joins {
   my ($self, $where, @join) = @_;
   my $join_where = $self->_recurse_where_joins(@join);

   if (keys %$join_where) {
      unless (defined $where) { $where = $join_where; }
      else {
         $where = { -or  => $where } if (ref $where eq 'ARRAY');
         $where = { -and => [ $join_where, $where ] };
      }
   }
   return $where;
}

sub _recurse_where_joins {
   my $self = shift;

   my @where;
   foreach my $j (@_) {
      my ($to, $on) = @$j;

      push @where, $self->_recurse_where_joins(@$to) if (ref $to eq 'ARRAY');

      my $join_opts = ref $to eq 'ARRAY' ? $to->[0] : $to;
      if (ref $join_opts eq 'HASH' and my $jt = $join_opts->{-join_type}) {
         # TODO: Figure out a weird way to support ANSI joins and WHERE joins at the same time.
         # (Though, time would be better spent just fixing SQL::Parser to not require this stuff.)
         
         $self->throw_exception("Can't handle non-inner, non-ANSI joins in SQL::Statement SQL yet!\n")
            if $jt =~ /NATURAL|LEFT|RIGHT|FULL|CROSS|UNION/i;
      }

      # sadly SQLA treats where($scalar) as literal, so we need to jump some hoops
      push @where, map { \sprintf ('%s = %s',
         ref $_        ? $self->_recurse_where($_)        : $self->_quote($_),
         ref $on->{$_} ? $self->_recurse_where($on->{$_}) : $self->_quote($on->{$_}),
      ) } keys %$on;
   }

   return { -and => \@where };
}

1;

DBIx::Class::Storage::DBI::SQL::Statement.pm

package DBIx::Class::Storage::DBI::SQL::Statement;

use strict;
use base 'DBIx::Class::Storage::DBI';
use mro 'c3';
use namespace::clean;

__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::SQLStatement');
__PACKAGE__->sql_quote_char('"');
__PACKAGE__->sql_limit_dialect('LimitXY');

# Unsupported options
sub _determine_supports_insert_returning { 0 };

# Statement caching currently buggy with either S:S or DBD::AnyData (and/or possibly others)
# Disable it here and look into fixing it later on
sub _init {
   my $self = shift;
   $self->next::method(@_);
   $self->disable_sth_caching(1);
}

# No support for transactions; sorry...
sub txn_begin { (shift)->throw_exception('SQL::Statement-based drivers do not support transactions!'); }
sub svp_begin { (shift)->throw_exception('SQL::Statement-based drivers do not support savepoints!');   }

=head1 NAME

DBIx::Class::Storage::DBI::SQL::Statement - Base Class for SQL::Statement- / DBI::DBD::SqlEngine-based
DBD support in DBIx::Class

=head1 SYNOPSIS

This is the base class for DBDs that use L<SQL::Statement> and/or
L<DBI::DBD::SqlEngine|DBI::DBD::SqlEngine::Developers>.  This class is
used for:

=over
=item L<DBD::Sys>
=item L<DBD::AnyData>
=item L<DBD::TreeData>
=item L<DBD::SNMP>
=item L<DBD::PO>
=item L<DBD::CSV>
=item L<DBD::DBM>
=back

=head1 IMPLEMENTATION NOTES

=head2 Transactions

These drivers do not support transactions (and in fact, even the SQL syntax for
them).  Therefore, any attempts to use txn_* or svp_* methods will throw an
exception.

In a future release, they may be replaced with emulated functionality.  (Then
again, it would probably be added into L<SQL::Statement> instead.)

=head2 SELECT ... FOR UPDATE/SHARE

This also is not supported, but it will silently ignore these.

=head1 AUTHOR

See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.

=head1 LICENSE

You may distribute this code under the same terms as Perl itself.

=cut