Clarification cascade_* attribute defaults documentation
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / SQLAHacks / OracleJoins.pm
CommitLineData
6f4ddea1 1package # Hide from PAUSE
855c6fd0 2 DBIx::Class::SQLAHacks::OracleJoins;
6f4ddea1 3
4use base qw( DBIx::Class::SQLAHacks );
87aa29e2 5use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
6f4ddea1 6
7sub select {
a6b68a60 8 my ($self, $table, $fields, $where, $rs_attrs, @rest) = @_;
6f4ddea1 9
10 if (ref($table) eq 'ARRAY') {
11 $where = $self->_oracle_joins($where, @{ $table });
12 }
13
a6b68a60 14 return $self->SUPER::select($table, $fields, $where, $rs_attrs, @rest);
6f4ddea1 15}
16
17sub _recurse_from {
18 my ($self, $from, @join) = @_;
19
20 my @sqlf = $self->_make_as($from);
21
22 foreach my $j (@join) {
23 my ($to, $on) = @{ $j };
24
25 if (ref $to eq 'ARRAY') {
26 push (@sqlf, $self->_recurse_from(@{ $to }));
27 }
28 else {
29 push (@sqlf, $self->_make_as($to));
30 }
31 }
32
33 return join q{, }, @sqlf;
34}
35
36sub _oracle_joins {
37 my ($self, $where, $from, @join) = @_;
38 my $join_where = {};
39 $self->_recurse_oracle_joins($join_where, $from, @join);
40 if (keys %$join_where) {
41 if (!defined($where)) {
42 $where = $join_where;
43 } else {
44 if (ref($where) eq 'ARRAY') {
45 $where = { -or => $where };
46 }
47 $where = { -and => [ $join_where, $where ] };
48 }
49 }
50 return $where;
51}
52
53sub _recurse_oracle_joins {
54 my ($self, $where, $from, @join) = @_;
55
56 foreach my $j (@join) {
57 my ($to, $on) = @{ $j };
58
59 if (ref $to eq 'ARRAY') {
60 $self->_recurse_oracle_joins($where, @{ $to });
61 }
62
63 my $to_jt = ref $to eq 'ARRAY' ? $to->[0] : $to;
64 my $left_join = q{};
65 my $right_join = q{};
66
67 if (ref $to_jt eq 'HASH' and exists $to_jt->{-join_type}) {
68 #TODO: Support full outer joins -- this would happen much earlier in
69 #the sequence since oracle 8's full outer join syntax is best
70 #described as INSANE.
e8fcf76f 71 croak "Can't handle full outer joins in Oracle 8 yet!\n"
6f4ddea1 72 if $to_jt->{-join_type} =~ /full/i;
73
74 $left_join = q{(+)} if $to_jt->{-join_type} =~ /left/i
75 && $to_jt->{-join_type} !~ /inner/i;
76
77 $right_join = q{(+)} if $to_jt->{-join_type} =~ /right/i
78 && $to_jt->{-join_type} !~ /inner/i;
79 }
80
81 foreach my $lhs (keys %{ $on }) {
82 $where->{$lhs . $left_join} = \"= $on->{ $lhs }$right_join";
83 }
84 }
85}
86
871;
88
89=pod
90
91=head1 NAME
92
93DBIx::Class::SQLAHacks::OracleJoins - Pre-ANSI Joins-via-Where-Clause Syntax
94
95=head1 PURPOSE
96
97This module was originally written to support Oracle < 9i where ANSI joins
98weren't supported at all, but became the module for Oracle >= 8 because
48580715 99Oracle's optimising of ANSI joins is horrible.
6f4ddea1 100
101=head1 SYNOPSIS
102
103Not intended for use directly; used as the sql_maker_class for schemas and components.
104
105=head1 DESCRIPTION
106
107Implements pre-ANSI joins specified in the where clause. Instead of:
108
109 SELECT x FROM y JOIN z ON y.id = z.id
110
111It will write:
112
113 SELECT x FROM y, z WHERE y.id = z.id
114
115It should properly support left joins, and right joins. Full outer joins are
116not possible due to the fact that Oracle requires the entire query be written
117to union the results of a left and right join, and by the time this module is
118called to create the where query and table definition part of the sql query,
119it's already too late.
120
121=head1 METHODS
122
123=over
124
125=item select ($\@$;$$@)
126
127Replaces DBIx::Class::SQLAHacks's select() method, which calls _oracle_joins()
128to modify the column and table list before calling SUPER::select().
129
130=item _recurse_from ($$\@)
131
132Recursive subroutine that builds the table list.
133
134=item _oracle_joins ($$$@)
135
136Creates the left/right relationship in the where query.
137
138=back
139
140=head1 BUGS
141
142Does not support full outer joins.
143Probably lots more.
144
145=head1 SEE ALSO
146
147=over
148
149=item L<DBIx::Class::Storage::DBI::Oracle::WhereJoins> - Storage class using this
150
151=item L<DBIx::Class::SQLAHacks> - Parent module
152
153=item L<DBIx::Class> - Duh
154
155=back
156
157=head1 AUTHOR
158
159Justin Wheeler C<< <jwheeler@datademons.com> >>
160
161=head1 CONTRIBUTORS
162
163David Jack Olrik C<< <djo@cpan.org> >>
164
165=head1 LICENSE
166
167This module is licensed under the same terms as Perl itself.
168
169=cut
170