Commit | Line | Data |
9382ad07 |
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 | |
95ba7ee4 |
8 | __PACKAGE__->sql_maker_class('DBIC::SQL::Abstract::Oracle'); |
9 | |
9382ad07 |
10 | BEGIN { |
a89c6fc0 |
11 | package # Hide from PAUSE |
12 | DBIC::SQL::Abstract::Oracle; |
9382ad07 |
13 | |
14 | use base qw( DBIC::SQL::Abstract ); |
15 | |
16 | sub select { |
17 | my ($self, $table, $fields, $where, $order, @rest) = @_; |
18 | |
67bdc1ef |
19 | if (ref($table) eq 'ARRAY') { |
20 | $where = $self->_oracle_joins($where, @{ $table }); |
21 | } |
9382ad07 |
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) = @_; |
67bdc1ef |
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) = @_; |
9382ad07 |
64 | |
65 | foreach my $j (@join) { |
66 | my ($to, $on) = @{ $j }; |
67 | |
68 | if (ref $to eq 'ARRAY') { |
67bdc1ef |
69 | $self->_recurse_oracle_joins($where, @{ $to }); |
9382ad07 |
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 | |
4a90cd56 |
83 | $left_join = q{(+)} if $to_jt->{-join_type} =~ /left/i |
9382ad07 |
84 | && $to_jt->{-join_type} !~ /inner/i; |
85 | |
4a90cd56 |
86 | $right_join = q{(+)} if $to_jt->{-join_type} =~ /right/i |
9382ad07 |
87 | && $to_jt->{-join_type} !~ /inner/i; |
88 | } |
89 | |
90 | foreach my $lhs (keys %{ $on }) { |
67bdc1ef |
91 | $where->{$lhs . $left_join} = \"= $on->{ $lhs }$right_join"; |
9382ad07 |
92 | } |
93 | } |
94 | } |
95 | } |
96 | |
9382ad07 |
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 |