view release on metacpan or  search on metacpan

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

    }
    # bind foreign key values
    if($fkobjs) {
	foreach my $o (@$fkobjs) {
	    # If it's an object, the value to bind is the primary key.
	    # Otherwise bind undef.
	    my $fk = $o && ref($o) ? $o->primary_key() : undef;
	    if($adp->verbose > 0) {
		$adp->debug(substr(ref($adp),rindex(ref($adp),"::")+2).
			    "::insert: ".
			    "binding column $j to \"", $fk,
			    "\" (FK to ",
			    ($o ?
			     (ref($o) ? ref($o->obj()) : $o) : "<unknown>"),
			    ")\n");
	    }
	    $self->bind_param($sth, $j, $fk);
	    $j++;
	}
    }
    # execute
    my $rv = $sth->execute();
    my $pk;
    # Note: $rv may be 0E0 (evaluates to TRUE as a string) to indicate 
    # success, but zero rows affected, which means no row was inserted.
    # This may be (hopefully will be) due to an RDBMS having internally
    # (by means of triggers [Oracle, Pg] or rules [Pg]) encapsulated and
    # caught the already-exists condition.
    if($rv && ($rv != 0)) {
	# get the primary key that was just inserted
	$pk = $adp->dbcontext()->dbi()->last_id_value(
					   $dbh, $self->sequence_name($table));
    } elsif(! $rv) { # note this is *not* equivalent to $rv == 0 !
	# the statement failed
	$self->report_execute_failure(-sth => $sth, -adaptor => $adp,
				      -op => 'insert',
				      -vals => $slotvals, -fkobjs => $fkobjs);
    }
    # done, return
    return $pk;
}

=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) = @_;
    
    # obtain the object's slots to be serialized
    my @slots = $adp->get_persistent_slots($obj);
    # get the UPDATE statement 
    # is it cached?
    my $cache_key = 'UPDATE '.ref($adp).' '.join(';',@slots);
    my $sth = $self->get_sth($adp,$obj,$fkobjs,$cache_key,'update_object');
    # we need the slot map regardless of whether we need to construct the
    # SQL or not, because we need to know which slots do not map to a column
    # (indicated by them being mapped to undef)
    my $table = $self->table_name($adp);
    my $slotmap = $self->slot_attribute_map($table);
    $self->throw("no slot/attribute map for table $table") unless $slotmap;
    # if not cached, create SQL and prepare statement
    if(! $sth) {
	$sth = $self->prepare_update_sth($adp, \@slots, $fkobjs);
	# and cache
	$adp->sth($cache_key, $sth);
	# and give interceptors a chance to do their work
	$sth = $self->get_sth($adp,$obj,$fkobjs,$cache_key,'update_object');
    }
    # bind paramater values
    my $slotvals = $adp->get_persistent_slot_values($obj, $fkobjs);
    if(@$slotvals != @slots) {
	$self->throw("number of slots must equal the number of values");
    }
    my $i = 0; # slots and slot values index
    my $j = 1; # column index
    while($i < @slots) {
	if($slotmap->{$slots[$i]} &&
	   (substr($slotmap->{$slots[$i]},0,2) ne '=>')) {
	    if($adp->verbose > 0) {
		$adp->debug(sprintf("%s::update: binding column %d to \"%s\"(%s)\n",
                        substr(ref($adp),rindex(ref($adp),"::")+2),
                        $j,
                        $slotvals->[$i] || '',
                        ($slots[$i])));
	    }
	    $self->bind_param($sth, $j, $slotvals->[$i]);
	    $j++;
	}
	$i++;
    }
    # bind foreign key values
    if($fkobjs) {
	foreach my $o (@$fkobjs) {
	    # If it's an object, the value to bind is the primary key. If it's
	    # numeric, the value is the number. Otherwise bind undef.
	    my $fk = ref($o) ?
		$o->primary_key() :
		$o =~ /^\d+$/ ? $o : undef;
	    if($adp->verbose > 0) {
		$adp->debug(substr(ref($adp),rindex(ref($adp),"::")+2).
			    "::update: ".
			    "binding column $j to \"$fk\" (FK to ".
			    $self->table_name($o) . ")\n");
	    }
	    $self->bind_param($sth, $j, $fk);
	    $j++;