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