BioPerl-DB

 view release on metacpan or  search on metacpan

lib/Bio/DB/BioSQL/Oracle/SpeciesAdaptorDriver.pm  view on Meta::CPAN

			     $ncbi_taxid || "<NULL>", $node->[1] || "<NULL>",
			     $setid,
			     2*($maxsetid+scalar(@clf))-$setid+1),
			"\" (parent_taxon,ncbi_taxid,node_rank,left,right)\n");
	}
	$rv = $sth_t->execute($pk,$ncbi_taxid,$node->[1],
			      $setid, 2*($maxsetid+scalar(@clf))-$setid+1);
	$setid++;
	last unless $rv;
	# we need the newly assigned primary key
	$pk = $adp->dbcontext->dbi->last_id_value($dbh,
					    $self->sequence_name($node_table));
	# now insert name of node into the taxon name table
	if($adp->verbose > 0) {
	    $adp->debug(substr(ref($adp),rindex(ref($adp),"::")+2).
			"::insert: ".
			"binding columns 1;2;3 to \"",
			join(";",$pk,$node->[0],"scientific name"),
			"\" ($fkname, name, name_class)\n");
	}
	$rv = $sth_tn->execute($pk, $node->[0], "scientific name");
	last unless $rv;
    }
    # upon exit the value of $pk is the primary key for the node that got
    # the NCBI taxon ID assigned - which is exactly what we need as the
    # foreign key of the species for subsequent reference

    # if defined insert common_name into the taxon name table
    if($rv && $obj->common_name) {
	if($adp->verbose > 0) {
	    $adp->debug(substr(ref($adp),rindex(ref($adp),"::")+2).
			"::insert: ".
			"binding columns 1;2;3 to \"",
			join(";",$pk,$obj->common_name,"common name"),
			"\" ($fkname, name, name_class)\n");
	}
	$rv = $sth_tn->execute($pk, $obj->common_name(), "common name");
    }
    # done, return
    return $rv ? $pk : undef;
}

=head2 update_object

 Title   : update_object
 Usage   :
 Function:
 Example :
 Returns : The number of updated rows
 Args    : A Bio::DB::BioSQL::BasePersistenceAdaptor derived object
           (basically, it needs to implement dbh(), sth($key, $sth),
	    dbcontext(), and get_persistent_slots()).
	   The object to be updated.
           A reference to an array of foreign key objects; if any of those
           foreign key values is NULL (some foreign keys may be nullable),
           then give the class name.


=cut

sub update_object{
    my ($self,$adp,$obj,$fkobjs) = @_;

    $self->throw_not_implemented();

}

=head2 _build_select_list

 Title   : _build_select_list
 Usage   :
 Function: Builds and returns the select list for an object query. The list
           contains those columns, in the right order, that are necessary to
           populate the object.
 Example :
 Returns : An array of strings (column names, not prefixed)
 Args    : The calling persistence adaptor.
           A reference to an array of foreign key entities (objects, class
           names, or adaptors) the object must attach.
           A reference to a hash table mapping entity names to aliases (if
           omitted, aliases will not be used, and SELECT columns can only be
           from one table)


=cut

sub _build_select_list{
    my ($self,$adp,$fkobjs,$entitymap) = @_;

    my @attrs = $self->SUPER::_build_select_list($adp,$fkobjs,$entitymap);
    # we need to massage the attribute list ...
    for(my $i = 0; $i < @attrs; $i++) {
	if($attrs[$i] =~ /ncbi_taxon_id/i) {
	    my $name_table = $self->table_name("Bio::Species");
	    my $node_table = $self->table_name("TaxonNode");
	    $attrs[$i] =~ s/$name_table/$node_table/;
	}
    }
    return @attrs;
}

=head2 get_classification

 Title   : get_classification
 Usage   :
 Function: Returns the classification array for a taxon as identified by
           its primary key.
 Example :
 Returns : a reference to an array of two-element arrays, where the first
           element contains the name of the node and the second element
           denotes its rank
 Args    : the calling adaptor, the primary key of the taxon


=cut

sub get_classification{
    my ($self,$adp,$pk) = @_;
    my @clf = ();

    # try to obtain statement handle from cache



( run in 0.456 second using v1.01-cache-2.11-cpan-39bf76dae61 )