lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm

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