Fixed the Oracle driver. All tests pass except the one testing for the

unsupported DBLink::optional_id.

svn path=/bioperl-db/trunk/; revision=369

Bio/DB/BioSQL/Oracle/BasePersistenceAdaptorDriver.pm

@@ -80,6 +80,7 @@ Internal methods are usually preceded with a _
 package Bio::DB::BioSQL::Oracle::BasePersistenceAdaptorDriver;
 use vars qw(@ISA);
 use strict;
+use Data::Dumper;
 
 # Object preamble - inherits from Bio::Root::Root
 
@@ -163,7 +164,7 @@ my %slot_attribute_map = (
 	     "classification" => "full_lineage",
 	     "common_name"    => "common_name",
 	     "ncbi_taxid"     => "ncbi_taxon_id",
-	     "binomial"       => "binomial",
+	     "binomial"       => "name",
 	     "variant"        => "variant",
 	 },
 	 "BS_bioentry" => {
@@ -289,6 +290,31 @@ sub new {
     return $self;
 }
 
+=head2 insert_object
+
+ Title   : insert_object
+ Usage   :
+ Function: We override this here in order to set LongReadLen on the
+           database handle (in order to affect all statements created
+	   from it).
+ Example :
+ Returns : The primary key of the newly inserted record.
+ Args    : A Bio::DB::BioSQL::BasePersistenceAdaptor derived object
+           See L<Bio::DB::BioSQL::BaseDriver> for more arguments
+
+=cut
+
+sub insert_object{
+    my $self = shift;
+    my $adp = shift;
+    my $dbh = $adp->dbh();
+    # set LongReadLen in the database handle if not set already
+    if($dbh->{'LongReadLen'} < 0x1000) { # we want at least 4k
+	$dbh->{'LongReadLen'} = 0x20000; # if we got less we demand 128k
+    }
+    return $self->SUPER::insert_object($adp, @_);
+}
+
 =head2 primary_key_name
 
  Title   : primary_key_name
@@ -342,7 +368,7 @@ sub foreign_key_name{
     # default is to get the primary key of the respective table
     $table = $self->table_name($obj);
     if($table) {
-	$fk = $self->acronym_map($table) ."_oid";
+	$fk = $self->acronym_map->{$table} ."_oid";
     } elsif(! ref($obj)) {
 	my @comps = split(/::/, $obj);
 	my $slot = pop(@comps);
@@ -364,9 +390,6 @@ sub foreign_key_name{
  Function: Returns the name of the primary key generator (SQL sequence)
            for the given table.
 
-           In this implementation we always return the same name
-           regardless of table.
-
  Example :
  Returns : the name of the sequence (a string)
  Args    : The name of the table.
@@ -375,7 +398,8 @@ sub foreign_key_name{
 =cut
 
 sub sequence_name{
-    return shift->{'schema_sequence'};
+    my ($self,$table) = @_;
+    return $table . "_pk_seq";
 }
 
 =head2 acronym_map

Bio/DB/BioSQL/Oracle/BiosequenceAdaptorDriver.pm

@@ -165,7 +165,7 @@ sub update_object{
 
 sub get_biosequence{
     my ($self,$adp,$bioentryid,$start,$end) = @_;
-    my ($sth, $cache_key, $i, $row);
+    my ($sth, $cache_key, $row);
     my $seqstr;
 
     if(defined($start)) {
@@ -180,22 +180,26 @@ sub get_biosequence{
 		$self->throw("no mapping for column seq in table $table");
 	    }
 	    my $ukname = $self->foreign_key_name("Bio::PrimarySeqI");
-	    my $sql = "SELECT SUBSTRING($seqcol, ?" .
-		(defined($end) ? ", ?" : "") .
-		") FROM $table WHERE $ukname = ?";
+	    my $sql = "SELECT DBMS_LOB.SUBSTR($seqcol, ";
+	    if(defined($end)) {
+		$sql .= "?, ?";
+	    } else {
+		$sql .= "DBMS_LOB.GETLENGTH($seqcol) - ?, ?";
+	    }
+	    $sql .= ") FROM $table WHERE $ukname = ?";
 	    $adp->debug("preparing SELECT statement: $sql\n");
 	    $sth = $adp->dbh()->prepare($sql);
 	    # and cache it
 	    $adp->sth($cache_key, $sth);
 	}
 	# bind parameters
-	$sth->bind_param(1, $start);
-	$i = 2;
 	if(defined($end)) {
-	    $sth->bind_param(2, $end-$start+1);
-	    $i = 3;
+	    $sth->bind_param(1, $end-$start+1);
+	} else {
+	    $sth->bind_param(1, $start-1);
 	}
-	$sth->bind_param($i, $bioentryid);
+	$sth->bind_param(2, $start);
+	$sth->bind_param(3, $bioentryid);
     } else {
 	# statement cached?
 	$cache_key = "SELECT BIOSEQ ".$adp;

Bio/DB/BioSQL/PrimarySeqAdaptor.pm

@@ -132,9 +132,8 @@ sub get_persistent_slots{
 sub get_persistent_slot_values {
     my ($self,$obj,$fkobjs) = @_;
     my @vals = ($obj->display_id(),
-		($obj->primary_id() =~ /=(HASH|ARRAY)\(0x/) ||
-		($obj->primary_id() eq $obj->display_id()) ?
-		undef : $obj->primary_id(),
+		$obj->primary_id() =~ /=(HASH|ARRAY)\(0x/ ?
+		 "=".$obj->accession_number() : $obj->primary_id(),
 		$obj->accession_number(),
 		$obj->description(),
 		$obj->version() || 0);
@@ -323,7 +322,8 @@ sub populate_from_row{
     }
     if($rows && @$rows) {
 	$obj->display_id($rows->[1]) if $rows->[1];
-	$obj->primary_id($rows->[2]) if $rows->[2];
+	$obj->primary_id($rows->[2])
+	    if $rows->[2] && substr($rows->[2],0,1) != '=';
 	$obj->accession_number($rows->[3]) if $rows->[3];
 	$obj->desc($rows->[4]) if $rows->[4];
 	$obj->version($rows->[5]) if $rows->[5];

Bio/DB/BioSQL/SeqFeatureAdaptor.pm

@@ -149,7 +149,7 @@ sub get_persistent_slots{
 sub get_persistent_slot_values {
     my ($self,$obj,$fkobjs) = @_;
     my @vals = ($obj->display_name(),
-		$obj->can('rank') ? $obj->rank() : undef
+		$obj->can('rank') ? $obj->rank() || 0 : 0
 		);
     return \@vals;
 }
@@ -471,7 +471,9 @@ sub get_unique_key_query{
 		unless $sfkey->primary_key();
 	}
 	$uk_h->{'primary_tag'} = $sfkey ? $sfkey->primary_key() : undef;
-	$uk_h->{'rank'} = $obj->rank() if $obj->can('rank');
+	if($obj->can('rank') && defined($obj->rank())) {
+	    $uk_h->{'rank'} = $obj->rank();
+	}
     }
 
     return $uk_h;

Bio/DB/DBI/Oracle.pm

@@ -124,14 +124,14 @@ sub new {
 =cut
 
 sub next_id_value{
-    my ($self, $dbh) = @_;
+    my ($self, $dbh, $oraseq) = @_;
 
     if(! $dbh) {
 	$self->throw("no database handle supplied to last_id_value() --".
 		     "last_id and currval operations are connection-specific");
     }
     # we need to construct the sql statement
-    my $oraseq = shift || $self->sequence_name();
+    $oraseq = $self->sequence_name() unless $oraseq;
     my $row = $dbh->selectrow_arrayref("SELECT $oraseq.nextval FROM dual");
     my $dbid;
     if(! ($row && @$row && ($dbid = $row->[0]))) {
@@ -163,14 +163,15 @@ sub next_id_value{
 =cut
 
 sub last_id_value{
-    my ($self, $dbh) = @_;
+    my ($self, $dbh, $oraseq) = @_;
 
     if(! $dbh) {
 	$self->throw("no database handle supplied to last_id_value() --".
 		     "last_id and currval operations are connection-specific");
     }
     # we need to construct the sql statement
-    my $oraseq = shift || $self->sequence_name();
+    $oraseq = $self->sequence_name() unless $oraseq;
+    print "SELECT $oraseq.currval FROM dual\n";
     my $row = $dbh->selectrow_arrayref("SELECT $oraseq.currval FROM dual");
     my $dbid;
     if(! ($row && @$row && ($dbid = $row->[0]))) {
@@ -180,4 +181,29 @@ sub last_id_value{
     return $dbid;
 }
 
+=head2 build_dsn
+
+ Title   : build_dsn
+ Usage   :
+ Function: Constructs the DSN string from the DBContextI object. Since this
+           may be driver-specific, specific implementations may need to
+           override this method.
+ Example :
+ Returns : a string (the DSN)
+ Args    : a Bio::DB::DBContextI implementing object
+
+
+=cut
+
+sub build_dsn{
+    my ($self,$dbc) = @_;
+
+    my $dsn = "DBI:" . $dbc->driver() . ":";
+    $dsn .= "host=" . $dbc->host() if $dbc->host();
+    $dsn .= ";sid=" . $dbc->dbname();
+    $dsn .= ";port=" . $dbc->port() if $dbc->port();
+
+    return $dsn;
+}
+
 1;

Bio/DB/DBI/base.pm

@@ -70,7 +70,7 @@ Internal methods are usually preceded with a _
 
 =cut
 
-
+#'
 # Let the code begin...