[Bast-commits] r3212 - in branches/DBIx-Class-current: . lib/DBIx
lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/Oracle
dnm at dev.catalyst.perl.org
dnm at dev.catalyst.perl.org
Thu Apr 26 17:09:30 GMT 2007
Author: dnm
Date: 2007-04-26 17:09:29 +0100 (Thu, 26 Apr 2007)
New Revision: 3212
Added:
branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/
branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm
Removed:
branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
Modified:
branches/DBIx-Class-current/
branches/DBIx-Class-current/lib/DBIx/Class.pm
branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle.pm
Log:
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.
Property changes on: branches/DBIx-Class-current
___________________________________________________________________
Name: svk:merge
- 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
78d5d833-3a7e-474d-aed6-cfba645156b5:/local/DBIx-Class.current:29201
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/column_info_from_storage:2596
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/load_namespaces:2725
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/param_bind:3015
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/source-handle:2975
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/storage_exceptions:2617
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/versioning:2930
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:2994
+ 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
78d5d833-3a7e-474d-aed6-cfba645156b5:/local/DBIx-Class.current:29201
78d5d833-3a7e-474d-aed6-cfba645156b5:/local/DBIx-Class.oracle8:29250
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:3122
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/column_info_from_storage:2596
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/load_namespaces:2725
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/param_bind:3015
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/source-handle:2975
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/storage_exceptions:2617
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/versioning:2930
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:2994
Copied: branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle (from rev 3211, branches/DBIx-Class/oracle8/lib/DBIx/Class/Storage/DBI/Oracle)
Deleted: branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- branches/DBIx-Class/oracle8/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2007-04-26 01:30:12 UTC (rev 3211)
+++ branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2007-04-26 16:09:29 UTC (rev 3212)
@@ -1,83 +0,0 @@
-package DBIx::Class::Storage::DBI::Oracle::Generic;
-# -*- mode: cperl; cperl-indent-level: 2 -*-
-
-use strict;
-use warnings;
-
-use Carp::Clan qw/^DBIx::Class/;
-
-use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
-
-# __PACKAGE__->load_components(qw/PK::Auto/);
-
-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;
-}
-
-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 . "'.";
-}
-
-sub get_autoinc_seq {
- my ($self, $source, $col) = @_;
-
- $self->dbh_do($self->can('_dbh_get_autoinc_seq'), $source, $col);
-}
-
-sub columns_info_for {
- my ($self, $table) = @_;
-
- $self->next::method(uc($table));
-}
-
-
-1;
-
-=head1 NAME
-
-DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle
-
-=head1 SYNOPSIS
-
- # In your table classes
- __PACKAGE__->load_components(qw/PK::Auto Core/);
- __PACKAGE__->set_primary_key('id');
- __PACKAGE__->sequence('mysequence');
-
-=head1 DESCRIPTION
-
-This class implements autoincrements for Oracle.
-
-=head1 AUTHORS
-
-Andy Grundman <andy at hybridized.org>
-
-Scott Connelly <scottsweep at yahoo.com>
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
Copied: branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm (from rev 3211, branches/DBIx-Class/oracle8/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm)
===================================================================
--- branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm (rev 0)
+++ branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2007-04-26 16:09:29 UTC (rev 3212)
@@ -0,0 +1,83 @@
+package DBIx::Class::Storage::DBI::Oracle::Generic;
+# -*- mode: cperl; cperl-indent-level: 2 -*-
+
+use strict;
+use warnings;
+
+use Carp::Clan qw/^DBIx::Class/;
+
+use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
+
+# __PACKAGE__->load_components(qw/PK::Auto/);
+
+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;
+}
+
+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 . "'.";
+}
+
+sub get_autoinc_seq {
+ my ($self, $source, $col) = @_;
+
+ $self->dbh_do($self->can('_dbh_get_autoinc_seq'), $source, $col);
+}
+
+sub columns_info_for {
+ my ($self, $table) = @_;
+
+ $self->next::method(uc($table));
+}
+
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle
+
+=head1 SYNOPSIS
+
+ # In your table classes
+ __PACKAGE__->load_components(qw/PK::Auto Core/);
+ __PACKAGE__->set_primary_key('id');
+ __PACKAGE__->sequence('mysequence');
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for Oracle.
+
+=head1 AUTHORS
+
+Andy Grundman <andy at hybridized.org>
+
+Scott Connelly <scottsweep at yahoo.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
Added: branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm
===================================================================
--- branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm (rev 0)
+++ branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm 2007-04-26 16:09:29 UTC (rev 3212)
@@ -0,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<DBIC::SQL::Abstract>
+
+=item L<DBIx::Class::Storage::DBI::Oracle::Generic>
+
+=item L<DBIx::Class>
+
+=back
+
+=head1 AUTHOR
+
+Justin Wheeler C<< <jwheeler at datademons.com> >>
+
+=head1 CONTRIBUTORS
+
+David Jack Olrik C<< <djo at cpan.org> >>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.
+
+=cut
Modified: branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle.pm
===================================================================
--- branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle.pm 2007-04-26 01:30:12 UTC (rev 3211)
+++ branches/DBIx-Class-current/lib/DBIx/Class/Storage/DBI/Oracle.pm 2007-04-26 16:09:29 UTC (rev 3212)
@@ -3,52 +3,33 @@
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) = @_;
-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) = @_;
+ my $version = eval { $self->_dbh->get_info(18); };
- # 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'
- };
+ if ( !$@ ) {
+ my ($major, $minor, $patchlevel) = split(/\./, $version);
- # trigger_body is a LONG
- $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
+ # Default driver
+ my $class = $major >= 8
+ ? 'DBIx::Class::Storage::DBI::Oracle::WhereJoins'
+ : 'DBIx::Class::Storage::DBI::Oracle::Generic';
- 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 . "'.";
-}
+ print STDERR "Class: $class\n";
-sub get_autoinc_seq {
- my ($self, $source, $col) = @_;
-
- $self->dbh_do($self->can('_dbh_get_autoinc_seq'), $source, $col);
-}
+ # Load and rebless
+ eval "require $class";
-sub columns_info_for {
- my ($self, $table) = @_;
-
- $self->next::method(uc($table));
+ print STDERR "\$@: $@\n";
+ bless $self, $class unless $@;
+ }
}
@@ -56,25 +37,23 @@
=head1 NAME
-DBIx::Class::Storage::DBI::Oracle - Automatic primary key class for Oracle
+DBIx::Class::Storage::DBI::Oracle - Base class for Oracle driver
=head1 SYNOPSIS
# In your table classes
- __PACKAGE__->load_components(qw/PK::Auto Core/);
- __PACKAGE__->set_primary_key('id');
- __PACKAGE__->sequence('mysequence');
+ __PACKAGE__->load_components(qw/Core/);
=head1 DESCRIPTION
-This class implements autoincrements for Oracle.
+This class simply provides a mechanism for discovering and loading a sub-class
+for a specific version Oracle backend. It should be transparent to the user.
+
=head1 AUTHORS
-Andy Grundman <andy at hybridized.org>
+David Jack Olrik C<< <djo at cpan.org> >>
-Scott Connelly <scottsweep at yahoo.com>
-
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.
Modified: branches/DBIx-Class-current/lib/DBIx/Class.pm
===================================================================
--- branches/DBIx-Class-current/lib/DBIx/Class.pm 2007-04-26 01:30:12 UTC (rev 3211)
+++ branches/DBIx-Class-current/lib/DBIx/Class.pm 2007-04-26 16:09:29 UTC (rev 3212)
@@ -199,8 +199,12 @@
clkao: CL Kao
+da5id: David Jack Olrik <djo at cpan.org>
+
dkubb: Dan Kubb <dan.kubb-cpan at onautopilot.com>
+dnm: Justin Wheeler <jwheeler at datademons.com>
+
draven: Marcus Ramberg <mramberg at cpan.org>
dwc: Daniel Westermann-Clark <danieltwc at cpan.org>
More information about the Bast-commits
mailing list