lib/DBIx/Class/SQLAHacks/OracleJoins.pm

   1 package # Hide from PAUSE
   2   DBIx::Class::SQLAHacks::OracleJoins;
   3
   4 use base qw( DBIx::Class::SQLAHacks );
   5 use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
   6
   7 sub select {
   8   my ($self, $table, $fields, $where, $order, @rest) = @_;
   9
  10   if (ref($table) eq 'ARRAY') {
  11     $where = $self->_oracle_joins($where, @{ $table });
  12   }
  13
  14   return $self->SUPER::select($table, $fields, $where, $order, @rest);
  15 }
  16
  17 sub _recurse_from {
  18   my ($self, $from, @join) = @_;
  19
  20   my @sqlf = $self->_make_as($from);
  21
  22   foreach my $j (@join) {
  23     my ($to, $on) = @{ $j };
  24
  25     if (ref $to eq 'ARRAY') {
  26       push (@sqlf, $self->_recurse_from(@{ $to }));
  27     }
  28     else {
  29       push (@sqlf, $self->_make_as($to));
  30     }
  31   }
  32
  33   return join q{, }, @sqlf;
  34 }
  35
  36 sub _oracle_joins {
  37   my ($self, $where, $from, @join) = @_;
  38   my $join_where = {};
  39   $self->_recurse_oracle_joins($join_where, $from, @join);
  40   if (keys %$join_where) {
  41     if (!defined($where)) {
  42       $where = $join_where;
  43     } else {
  44       if (ref($where) eq 'ARRAY') {
  45         $where = { -or => $where };
  46       }
  47       $where = { -and => [ $join_where, $where ] };
  48     }
  49   }
  50   return $where;
  51 }
  52
  53 sub _recurse_oracle_joins {
  54   my ($self, $where, $from, @join) = @_;
  55
  56   foreach my $j (@join) {
  57     my ($to, $on) = @{ $j };
  58
  59     if (ref $to eq 'ARRAY') {
  60       $self->_recurse_oracle_joins($where, @{ $to });
  61     }
  62
  63     my $to_jt      = ref $to eq 'ARRAY' ? $to->[0] : $to;
  64     my $left_join  = q{};
  65     my $right_join = q{};
  66
  67     if (ref $to_jt eq 'HASH' and exists $to_jt->{-join_type}) {
  68       #TODO: Support full outer joins -- this would happen much earlier in
  69       #the sequence since oracle 8's full outer join syntax is best
  70       #described as INSANE.
  71       croak "Can't handle full outer joins in Oracle 8 yet!\n"
  72         if $to_jt->{-join_type} =~ /full/i;
  73
  74       $left_join  = q{(+)} if $to_jt->{-join_type} =~ /left/i
  75         && $to_jt->{-join_type} !~ /inner/i;
  76
  77       $right_join = q{(+)} if $to_jt->{-join_type} =~ /right/i
  78         && $to_jt->{-join_type} !~ /inner/i;
  79     }
  80
  81     foreach my $lhs (keys %{ $on }) {
  82       $where->{$lhs . $left_join} = \"= $on->{ $lhs }$right_join";
  83     }
  84   }
  85 }
  86
  87 1;
  88
  89 =pod
  90
  91 =head1 NAME
  92
  93 DBIx::Class::SQLAHacks::OracleJoins - Pre-ANSI Joins-via-Where-Clause Syntax
  94
  95 =head1 PURPOSE
  96
  97 This module was originally written to support Oracle < 9i where ANSI joins
  98 weren't supported at all, but became the module for Oracle >= 8 because
  99 Oracle's optimising of ANSI joins is horrible.
 100
 101 =head1 SYNOPSIS
 102
 103 Not intended for use directly; used as the sql_maker_class for schemas and components.
 104
 105 =head1 DESCRIPTION
 106
 107 Implements pre-ANSI joins specified in the where clause.  Instead of:
 108
 109     SELECT x FROM y JOIN z ON y.id = z.id
 110
 111 It will write:
 112
 113     SELECT x FROM y, z WHERE y.id = z.id
 114
 115 It should properly support left joins, and right joins.  Full outer joins are
 116 not possible due to the fact that Oracle requires the entire query be written
 117 to union the results of a left and right join, and by the time this module is
 118 called to create the where query and table definition part of the sql query,
 119 it's already too late.
 120
 121 =head1 METHODS
 122
 123 =over
 124
 125 =item select ($\@$;$$@)
 126
 127 Replaces DBIx::Class::SQLAHacks's select() method, which calls _oracle_joins()
 128 to modify the column and table list before calling SUPER::select().
 129
 130 =item _recurse_from ($$\@)
 131
 132 Recursive subroutine that builds the table list.
 133
 134 =item _oracle_joins ($$$@)
 135
 136 Creates the left/right relationship in the where query.
 137
 138 =back
 139
 140 =head1 BUGS
 141
 142 Does not support full outer joins.
 143 Probably lots more.
 144
 145 =head1 SEE ALSO
 146
 147 =over
 148
 149 =item L<DBIx::Class::Storage::DBI::Oracle::WhereJoins> - Storage class using this
 150
 151 =item L<DBIx::Class::SQLAHacks> - Parent module
 152
 153 =item L<DBIx::Class> - Duh
 154
 155 =back
 156
 157 =head1 AUTHOR
 158
 159 Justin Wheeler C<< <jwheeler@datademons.com> >>
 160
 161 =head1 CONTRIBUTORS
 162
 163 David Jack Olrik C<< <djo@cpan.org> >>
 164
 165 =head1 LICENSE
 166
 167 This module is licensed under the same terms as Perl itself.
 168
 169 =cut
 170