Add support for table joins to SQL::Abstract select()

11-db-sql.t

#! perl

use strict;
use warnings;
use Test::More;
use MyTK::DB::SQL;

my $sql = MyTK::DB::SQL->new;

subtest '__build_from' => sub {
  my @test_cases = (
    { in    => [['table', 't']],
      out   => 'table t',
      descr => 'simple case, with ArrayRef',
    },
    { in    => [{ table => 'table', prefix => 't' }],
      out   => 'table t',
      descr => 'simple case, with ArrayRef',
    },
    { in => [
        ['table1', 't1'],
        { table => 'table2', prefix => 't2', where => { 't2.fk' => \'t1.k' } },
        ['table3', 't3', { 't3.fk' => \'t2.k' }],
        { type => 'left', table => 'table4', prefix => 't4', where => { 't4.fk' => \'t1.k', 't4.type' => 'type' } },
      ],
      out => 'table1 t1'
        . ' JOIN table2 t2 ON (t2.fk=t1.k)'
        . ' JOIN table3 t3 ON (t3.fk=t2.k)'
        . ' LEFT JOIN table4 t4 ON (t4.fk=t1.k AND t4.type="type")',
      descr => 'multi-table join',
    },
  );

  is(${ $sql->__build_from($_->{in}) }, $_->{out}, $_->{descr}) for @test_cases;
};


subtest 'select' => sub {
  my @test_cases = (
    { in => {
        table =>
          [['table1', 't1'], { type => 'left', table => 'table4', prefix => 't4', where => { 't4.fk' => \'t1.k' } },],
        fields => ['t1.a t1_a', 't4.k t4_k'],
        where => { 't1.l' => { '>' => 5 } },
      },
      out => 'SELECT t1.a t1_a, t4.k t4_k FROM table1 t1 LEFT JOIN table4 t4 ON (t4.fk=t1.k) WHERE ( t1.l > ? )',
    },
  );

  is(scalar($sql->select($_->{in}{table}, $_->{in}{fields}, $_->{in}{where})), $_->{out}) for @test_cases;
};


done_testing();

SQL.pm

package MyTK::DB::SQL;

use strict;
use warnings;
use parent 'SQL::Abstract';

sub _table {
  my ($self, $table) = @_;

  $table = $self->__build_from($table) if ref($table) eq 'ARRAY';

  return $self->SUPER::_table($table);
}

sub __build_from {
  my ($self, $table) = @_;

  # Table specs:
  #   ARRAY
  #     [$table, $prefix] => '$table $prefix'  ## only first element of from
  #     [$table, $prefix, \%where] => 'JOIN $table $prefix ON (\%where)'
  #   HASH
  #     {table => $table, prefix => $prefix}  ## only first element of from
  #     {table => $table, (type => 'left',)? prefix => $prefix, where => \%where}

  my @sql;
  push @sql, $self->__build_join_term($_, scalar(@sql)) for @$table;

  my $sql = join(' ', @sql);
  return \$sql;
}

sub __build_join_term {
  my ($self, $term, $not_first) = @_;
  my $need_join = $not_first;
  my $join_type = 'JOIN';

  my $ref = ref($term);
  my $sql = '';

  if ($ref eq 'HASH') {
    $sql = "$term->{table} $term->{prefix}";
    $sql .= " ON (" . $self->__build_where($term->{where}) . ")" if exists $term->{where};
    $join_type = join(' ', uc($term->{type}), $join_type) if exists $term->{type};
  }
  elsif ($ref eq 'ARRAY') {
    $sql = "$term->[0] $term->[1]";
    $sql .= " ON (" . $self->__build_where($term->[2]) . ")" if $term->[2];
  }

  $sql = "$join_type $sql" if $need_join;

  return $sql;
}

sub __build_where {
  my ($self, $where) = @_;

  my @cond;
  for my $k (sort keys %$where) {
    my $v = $where->{$k};
    $v = ref($v) ? $$v : '"' . $self->_quote($v) . '"';
    push @cond, "$k=$v";
  }

  return join(' AND ', @cond);
}

1;