Hi,
I read that someone on this list was looking for Oracle 8 support in
DBIx::Class. I have needed the same thing, and ended up writing it. It is
attached.
It does not have a test suite, so you'll have to just use it, and hope it
works out for you. Anyone is welcome to write and contribute test code for
it.
#include
<standard-disclaimer-about-not-knowing-dbic-internals-very-well-and-the-possibility-of-this-code-being-completely-wrong.h>
To use it, in your base module, after:
use base qw( DBIx::Class::Schema );
Put:
__PACKAGE__->storage_type('DBIx::Class::Storage::DBI::Oracle8');
It should just work after that.
Justinpackage DBIx::Class::Storage::DBI::Oracle8;
use base qw( DBIx::Class::Storage::DBI::Oracle );
use strict;
use warnings;
BEGIN {
package DBIC::SQL::Abstract::Oracle8;
use base qw( DBIC::SQL::Abstract );
sub select {
my ($self, $table, $fields, $where, $order, @rest) = @_;
$self->_oracle_joins($where, @{ $table });
return $self->SUPER::select($table, $fields, $where, $order, @rest);
}
sub _recurse_from {
my ($self, $from, @join) = @_;
my @sqlf = $self->_make_as($from);
foreach my $j (@join) {
my ($to, $on) = @{ $j };
if (ref $to eq 'ARRAY') {
push (@sqlf, $self->_recurse_from(@{ $to }));
}
else {
push (@sqlf, $self->_make_as($to));
}
}
return join q{, }, @sqlf;
}
sub _oracle_joins {
my ($self, $where, $from, @join) = @_;
foreach my $j (@join) {
my ($to, $on) = @{ $j };
if (ref $to eq 'ARRAY') {
$self->_oracle_joins($where, @{ $to });
}
my $to_jt = ref $to eq 'ARRAY' ? $to->[0] : $to;
my $left_join = q{};
my $right_join = q{};
if (ref $to_jt eq 'HASH' and exists $to_jt->{-join_type}) {
#TODO: Support full outer joins -- this would happen much earlier in
#the sequence since oracle 8's full outer join syntax is best
#described as INSANE.
die "Can't handle full outer joins in Oracle 8 yet!\n"
if $to_jt->{-join_type} =~ /full/i;
$left_join = q{(+)} if $to_jt->{-join_type} =~ /right/i
&& $to_jt->{-join_type} !~ /inner/i;
$right_join = q{(+)} if $to_jt->{-join_type} =~ /left/i
&& $to_jt->{-join_type} !~ /inner/i;
}
foreach my $lhs (keys %{ $on }) {
$where->{$lhs . $left_join} = \" = $on->{ $lhs }$right_join";
}
}
}
}
sub sql_maker {
my ($self) = @_;
unless ($self->_sql_maker) {
$self->_sql_maker(
new DBIC::SQL::Abstract::Oracle8( $self->_sql_maker_args )
);
}
return $self->_sql_maker;
}
1;
__END__
=pod
=head1 DBIx::Class::Storage::DBI::Oracle8
=head2 Purpose
This module's purpose is to provide DBIx::Class with some (rudimentary)
Oracle 8 support, as Oracle does not support:
SELECT x FROM y JOIN z ON y.id = z.id
Oracle requires the query by written as:
SELECT x FROM y, z WHERE y.id = z.id
This module attempts to support that. It should properly support left joins,
and right joins. Full outer joins are not possible due to the fact that
Oracle 8 requires the entire query be written to union the results of a left
and right join, and by the time this module is called to create the where
query and table definition part of the sql query, it's already too late.
=head2 Synopsis
When initialising your code in the base DBIx module, simply tell DBIx to use
this as a storage class, and you're set:
use base qw( DBIx::Class::Schema );
__PACKAGE__->storage_type('DBIx::Class::Storage::DBI::Oracle8');
__PACKAGE__->load_classes();
... continue as normal.
=head2 Methods
This module replaces a subroutine contained in DBIC::SQL::Abstract:
=over
=item sql_maker
=back
It also creates a new module in its BEGIN { } block called
DBIC::SQL::Abstract::Oracle8 which has the following methods:
=over
=item select ([EMAIL PROTECTED];$$@)
Replaces DBIC::SQL::Abstract's select() method, which calls _oracle_joins()
to modify the column and table list before calling SUPER::select().
=item _recurse_from ($$\@)
Recursive subroutine that builds the table list.
=item _oracle_joins ($$$@)
Creates the left/right relationship in the where query.
=back
=head2 Bugs
Does not support full outer joins.
Probably lots more.
=head2 See Also
=over
=item L<DBIC::SQL::Abstract>
=item L<DBIx::Class>
=back
=head2 Author
Justin Wheeler <[EMAIL PROTECTED]>
=head2 Licence
This module is licensed under the same terms as Perl itself.
=cut
_______________________________________________
List: http://lists.rawmode.org/cgi-bin/mailman/listinfo/dbix-class
Wiki: http://dbix-class.shadowcatsystems.co.uk/
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/trunk/DBIx-Class/
Searchable Archive: http://www.mail-archive.com/[email protected]/
