File Coverage

blib/lib/DBIx/Class/SQLMaker/OracleJoins.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

package DBIx::Class::SQLMaker::OracleJoins;

use warnings;
use strict;

use base qw( DBIx::Class::SQLMaker::Oracle );

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

  # pull out all join conds as regular WHEREs from all extra tables
  if (ref($table) eq 'ARRAY') {
    $where = $self->_oracle_joins($where, @{ $table }[ 1 .. $#$table ]);
  }

  return $self->next::method($table, $fields, $where, $rs_attrs, @rest);
}

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

  my @sqlf = $self->_from_chunk_to_sql($from);

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

    if (ref $to eq 'ARRAY') {
      push (@sqlf, $self->_recurse_from(@{ $to }));
    }
    else {
      push (@sqlf, $self->_from_chunk_to_sql($to));
    }
  }

  return join q{, }, @sqlf;
}

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

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

sub _recurse_oracle_joins {
  my $self = shift;

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

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

    my $join_opts  = ref $to eq 'ARRAY' ? $to->[0] : $to;
    my $left_join  = q{};
    my $right_join = q{};

    if (ref $join_opts eq 'HASH' and my $jt = $join_opts->{-join_type}) {
      #TODO: Support full outer joins -- this would happen much earlier in
      #the sequence since oracle 8's full outer join syntax is best
      #described as INSANE.
      $self->throw_exception("Can't handle full outer joins in Oracle 8 yet!\n")
        if $jt =~ /full/i;

      $left_join  = q{(+)} if $jt =~ /left/i
        && $jt !~ /inner/i;

      $right_join = q{(+)} if $jt =~ /right/i
        && $jt !~ /inner/i;
    }

    # FIXME - the code below *UTTERLY* doesn't work with custom conds... sigh
    # for the time being do not do any processing with the likes of _collapse_cond
    # instead only unroll the -and hack if present
    $on = $on->{-and}[0] if (
      ref $on eq 'HASH'
        and
      keys %$on == 1
        and
      ref $on->{-and} eq 'ARRAY'
        and
      @{$on->{-and}} == 1
    );


    push @where, map { \do {
        my ($sql) = $self->_recurse_where({
          # FIXME - more borkage, more or less a copy of the kludge in ::SQLMaker::_join_condition()
          $_ => ( length ref $on->{$_}
            ? $on->{$_}
            : { -ident => $on->{$_} }
          )
        });

        $sql =~ s/\s*\=/$left_join =/
          if $left_join;

        "$sql$right_join";
      }
    } sort keys %$on;
  }

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

1;

__END__