Added Justin Wheeler's Oracle 8 support
David Jack Olrik [Wed, 24 Jan 2007 09:38:54 +0000 (09:38 +0000)]
lib/DBIx/Class.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBI/Oracle.pm
lib/DBIx/Class/Storage/DBI/Oracle/8.pm [new file with mode: 0644]
lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm [new file with mode: 0644]

index efd0727..5645d6d 100644 (file)
@@ -199,6 +199,8 @@ claco: Christopher H. Laco
 
 clkao: CL Kao
 
+da5id: David Jack Olrik <djoƶ@cpan.org>
+
 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
 
 draven: Marcus Ramberg <mramberg@cpan.org>
index 04dd140..d39b3a7 100644 (file)
@@ -701,6 +701,16 @@ sub _populate_dbh {
     $self->debugobj->query_end($sql_statement) if $self->debug();
   }
 
+  # Rebless after we connect to the database, so we can take advantage of
+  # values in get_info
+  if(ref $self eq 'DBIx::Class::Storage::DBI') {
+    my $driver = $self->_dbh->{Driver}->{Name};
+    if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
+      bless $self, "DBIx::Class::Storage::DBI::${driver}";
+      $self->_rebless() if $self->can('_rebless');
+    }
+  }
+
   $self->_conn_pid($$);
   $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
 }
index 77cedf3..2b28247 100644 (file)
@@ -1,54 +1,27 @@
 package DBIx::Class::Storage::DBI::Oracle;
-
 use strict;
 use warnings;
 
-use Carp::Clan qw/^DBIx::Class/;
-
-use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
+use base qw/DBIx::Class::Storage::DBI/;
 
-# __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 _rebless {
+    my ($self) = @_;
 
-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); };
+    unless ( $@ ) {
+        my ($major,$minor,$patchlevel) = split(/\./,$version);
 
-sub get_autoinc_seq {
-  my ($self, $source, $col) = @_;
-    
-  $self->dbh_do($self->can('_dbh_get_autoinc_seq'), $source, $col);
-}
+        # Default driver
+        my $class = "DBIx::Class::Storage::DBI::Oracle::Generic";
 
-sub columns_info_for {
-  my ($self, $table) = @_;
+        # Version specific drivers
+        $class = "DBIx::Class::Storage::DBI::Oracle::8"
+            if $major == 8;
 
-  $self->next::method(uc($table));
+        # Load and rebless
+        eval "require $class";
+        bless $self, $class unless $@;
+    }
 }
 
 
@@ -56,24 +29,22 @@ sub columns_info_for {
 
 =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@hybridized.org>
+=head1 AUTHORS
 
-Scott Connelly <scottsweep@yahoo.com>
+David Jack Olrik C<< <djo@cpan.org> >>
 
 =head1 LICENSE
 
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/8.pm b/lib/DBIx/Class/Storage/DBI/Oracle/8.pm
new file mode 100644 (file)
index 0000000..407c5bd
--- /dev/null
@@ -0,0 +1,181 @@
+package DBIx::Class::Storage::DBI::Oracle::8;
+
+use base qw( DBIx::Class::Storage::DBI::Oracle::Generic );
+
+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 NAME
+
+DBIx::Class::Storage::DBI::Oracle::8
+
+=head1 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__->load_classes();
+
+=head1 DESCRIPTION
+
+This class implements support specific to Oracle 8, 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.
+
+=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::Oracle8 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>
+
+=back
+
+=head1 AUTHOR
+
+Justin Wheeler C<< <justin.wheeler@caledoncard.com> >>
+
+=head1 CONTRIBUTORS
+
+David Jack Olrik C<< <djo@cpan.org> >>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
new file mode 100644 (file)
index 0000000..6f0693b
--- /dev/null
@@ -0,0 +1,82 @@
+package DBIx::Class::Storage::DBI::Oracle::Generic;
+
+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@hybridized.org>
+
+Scott Connelly <scottsweep@yahoo.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut