view release on metacpan or  search on metacpan

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

	}
    }
    my $sql = "INSERT INTO " . $table . " (" .
	join(", ", @attrs) .
	") VALUES (" .
	join(", ", @plchlds) . ")";
    $adp->debug("preparing INSERT statement: $sql\n");
    return $self->prepare($adp->dbh, $sql);
}

=head2 prepare_update_sth

 Title   : prepare_update_sth
 Usage   :
 Function: Prepares a DBI statement handle suitable for updating 
           a row in a table where the row is identified by its
           primary key.
 Example :
 Returns : the DBI statement handle
 Args    : the calling adaptor (a Bio::DB::PersistenceAdaptorI object)
           a reference to an array of object slot names
           a reference to an array of foreign key objects (optional)


=cut

sub prepare_update_sth{
    my ($self,$adp,$slots,$fkobjs) = @_;

    # obtain the table name and corresponding slot map
    my $table = $self->table_name($adp);
    my $slotmap = $self->slot_attribute_map($table);
    $self->throw("no slot/attribute map for table $table") unless $slotmap;
    # construct UPDATE statement as straightforward SQL
    my @attrs = ();
    foreach my $slot (@$slots) {
	if(! exists($slotmap->{$slot})) {
	    $self->throw("no mapping for slot $_ in slot-attribute map");
	}
	# we don't add a column nor a placeholder for unmapped slots
	if($slotmap->{$slot} &&
	   (substr($slotmap->{$slot},0,2) ne '=>')) {
	    push(@attrs, $slotmap->{$slot});
	}
    }
    # foreign keys
    if($fkobjs) {
	foreach (@$fkobjs) {
	    my $fkattr = $self->foreign_key_name($_);
	    push(@attrs, $fkattr);
	}
    }
    my $ifnull = $adp->dbcontext->dbi->ifnull_sqlfunc();
    my $sql = "UPDATE $table SET " .
	join(", ", map {"$_ = $ifnull\(?,$_\)";} @attrs) .
	" WHERE " . $self->primary_key_name($table) . " = ?";
    $adp->debug("preparing UPDATE statement: $sql\n");
    return $self->prepare($adp->dbh(),$sql);
}

=head2 cascade_delete

 Title   : cascade_delete
 Usage   :
 Function: Removes all persistent objects dependent from the given persistent
           object from the database (foreign key integrity).

           This implementation assumes that the underlying schema and RDBMS
           support cascading deletes, and hence does nothing other than 
           returning TRUE.
 Example :
 Returns : TRUE on success, and FALSE otherwise
 Args    : The DBContextI implementing object for the database.
           The object for which the dependent rows shall be deleted. 
           Optionally, additional (named) arguments.


=cut

sub cascade_delete{
    # our default assumption is that the RDBMS does support cascading deletes
    return 1;
}

=head2 insert_object

 Title   : insert_object
 Usage   :
 Function:
 Example :
 Returns : The primary key of the newly inserted record.
 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 inserted.
           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 insert_object{
    my ($self,$adp,$obj,$fkobjs) = @_;
    
    # obtain the object's slots to be serialized
    my @slots = $adp->get_persistent_slots($obj);
    # get the INSERT statement 
    # is it cached?
    my $cache_key = 'INSERT '.ref($obj).' '.join(';',@slots);
    my $sth = $self->get_sth($adp,$obj,$fkobjs,$cache_key,'insert_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;
    # we'll need the db handle in any case
    my $dbh = $adp->dbh();
    # if not cached, create SQL and prepare statement
    if(! $sth) {
	$sth = $self->prepare_insert_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,'insert_object');
    }
    # the implementation here is a post-insert primary-key retrieval, so
    # just go ahead and bind the attributes, no a-priori pk retrieval
    my $slotvals = $adp->get_persistent_slot_values($obj, $fkobjs);
    if(@$slotvals != @slots) {
	$self->throw("number of slots must equal the number of values ".
		     "(slots: ".
		     join(";",@slots).") (values: \"".
		     join("\";\"",@$slotvals).")");
    }
    my $i = 0; # slots and slot values index
    my $j = 1; # column index
    while($i < @slots) {
	if($slotmap->{$slots[$i]} &&