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