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

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