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

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