From: Justin Wheeler Date: Thu, 26 Apr 2007 16:09:29 +0000 (+0000) Subject: Merge 'oracle8' into 'DBIx-Class-current' X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9382ad0721370b25b9b93d78c76ecab0b46cc74e;p=dbsrgits%2FDBIx-Class-Historic.git Merge 'oracle8' into 'DBIx-Class-current' Made Oracle/WhereJoins for using in Oracle 8 and higher because Oracle < 9i doesn't support ANSI joins, and Oracle >= 9i doesn't do ANSI joins worth a damn. --- 9382ad0721370b25b9b93d78c76ecab0b46cc74e diff --cc lib/DBIx/Class.pm index f18ccfe,b626bee..72eac66 --- a/lib/DBIx/Class.pm +++ b/lib/DBIx/Class.pm @@@ -199,8 -199,10 +199,12 @@@ claco: Christopher H. Lac clkao: CL Kao + da5id: David Jack Olrik + dkubb: Dan Kubb ++dnm: Justin Wheeler ++ draven: Marcus Ramberg dwc: Daniel Westermann-Clark diff --cc lib/DBIx/Class/Storage/DBI/Oracle.pm index 77cedf3,4d289af..ea956ba --- a/lib/DBIx/Class/Storage/DBI/Oracle.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm @@@ -3,52 -4,26 +3,33 @@@ package DBIx::Class::Storage::DBI::Orac use strict; use warnings; - use Carp::Clan qw/^DBIx::Class/; + use base qw/DBIx::Class::Storage::DBI/; - use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/; ++print STDERR "Oracle.pm got called.\n"; + - # __PACKAGE__->load_components(qw/PK::Auto/); + sub _rebless { - my ($self) = @_; ++ my ($self) = @_; + - sub _dbh_last_insert_id { - my ($self, $dbh, $source, $col) = @_; - my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col)); - my $sql = 'SELECT ' . $seq . '.currval FROM DUAL'; - my ($id) = $dbh->selectrow_array($sql); - return $id; - } ++ print STDERR "Rebless got called.\n"; + - sub _dbh_get_autoinc_seq { - my ($self, $dbh, $source, $col) = @_; - - # look up the correct sequence automatically - my $sql = q{ - SELECT trigger_body FROM ALL_TRIGGERS t - WHERE t.table_name = ? - AND t.triggering_event = 'INSERT' - AND t.status = 'ENABLED' - }; - - # trigger_body is a LONG - $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024); - - my $sth = $dbh->prepare($sql); - $sth->execute( uc($source->name) ); - while (my ($insert_trigger) = $sth->fetchrow_array) { - return uc($1) if $insert_trigger =~ m!(\w+)\.nextval!i; # col name goes here??? - } - croak "Unable to find a sequence INSERT trigger on table '" . $source->name . "'."; - } ++ my $version = eval { $self->_dbh->get_info(18); }; + - sub get_autoinc_seq { - my ($self, $source, $col) = @_; - - $self->dbh_do($self->can('_dbh_get_autoinc_seq'), $source, $col); - } ++ if ( !$@ ) { ++ my ($major, $minor, $patchlevel) = split(/\./, $version); + - my $version = eval { $self->_dbh->get_info(18); }; - unless ( $@ ) { - my ($major,$minor,$patchlevel) = split(/\./,$version); ++ # Default driver ++ my $class = $major >= 8 ++ ? 'DBIx::Class::Storage::DBI::Oracle::WhereJoins' ++ : 'DBIx::Class::Storage::DBI::Oracle::Generic'; - sub columns_info_for { - my ($self, $table) = @_; - # Default driver - my $class = "DBIx::Class::Storage::DBI::Oracle::Generic"; ++ print STDERR "Class: $class\n"; - $self->next::method(uc($table)); - # Version specific drivers - $class = "DBIx::Class::Storage::DBI::Oracle::8" - if $major == 8; ++ # Load and rebless ++ eval "require $class"; + - # Load and rebless - eval "require $class"; - bless $self, $class unless $@; - } ++ print STDERR "\$@: $@\n"; ++ bless $self, $class unless $@; ++ } } diff --cc lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm index 0000000,0000000..2ba6815 new file mode 100644 --- /dev/null +++ b/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm @@@ -1,0 -1,0 +1,185 @@@ ++package DBIx::Class::Storage::DBI::Oracle::WhereJoins; ++ ++use base qw( DBIx::Class::Storage::DBI::Oracle::Generic ); ++ ++use strict; ++use warnings; ++ ++BEGIN { ++ package DBIC::SQL::Abstract::Oracle; ++ ++ 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::Oracle( $self->_sql_maker_args ) ++ ); ++ } ++ ++ return $self->_sql_maker; ++} ++ ++1; ++ ++__END__ ++ ++=pod ++ ++=head1 NAME ++ ++DBIx::Class::Storage::DBI::Oracle::WhereJoins - Oracle joins in WHERE syntax ++support (instead of ANSI). ++ ++=head1 PURPOSE ++ ++This module was originally written to support Oracle < 9i where ANSI joins ++weren't supported at all, but became the module for Oracle >= 8 because ++Oracle's optimising of ANSI joins is horrible. (See: ++http://scsys.co.uk:8001/7495) ++ ++=head1 SYNOPSIS ++ ++DBIx::Class should automagically detect Oracle and use this module with no ++work from you. ++ ++=head1 DESCRIPTION ++ ++This class implements Oracle's WhereJoin support. Instead of: ++ ++ SELECT x FROM y JOIN z ON y.id = z.id ++ ++It will write: ++ ++ SELECT x FROM y, z WHERE y.id = z.id ++ ++It should properly support left joins, and right joins. Full outer joins are ++not possible due to the fact that Oracle 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. ++ ++=head1 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::Oracle which has the following methods: ++ ++=over ++ ++=item select ($\@$;$$@) ++ ++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 ++ ++=head1 BUGS ++ ++Does not support full outer joins. ++Probably lots more. ++ ++=head1 SEE ALSO ++ ++=over ++ ++=item L ++ ++=item L ++ ++=item L ++ ++=back ++ ++=head1 AUTHOR ++ ++Justin Wheeler C<< >> ++ ++=head1 CONTRIBUTORS ++ ++David Jack Olrik C<< >> ++ ++=head1 LICENSE ++ ++This module is licensed under the same terms as Perl itself. ++ ++=cut