view release on metacpan or  search on metacpan

IO/Table.pm  view on Meta::CPAN

=cut
sub delete
{
    my ($self) = @_;
    my $rv = $self->{io}->delete_all($self->{fetch_key});
    unless ($rv)
    {
        return $rv;
    }
    delete $self->{exist_rec};
    delete $self->{new_rec};
    return $rv;
}

=pod

=item C<delete_all>

 $rv = $table->delete_all($id_hash);

Delete all rows that satisfy $id_hash, where $id_hash
is a hash of COLUMN_NAME => value pairs that will be AND'ed together for the
WHERE clause of the DELETE statement.

Returns the number of rows deleted or false if error (0 is represented as '0E0' which is true).
Return -1 if $id_hash is empty or not a reference.

=cut
sub delete_all
{
    my ($self,$id_hash) = @_;
    my $rv = $self->{io}->delete_all($id_hash);
    unless ($rv)
    {
        return $rv;
    }
    return $rv;
}

=pod

=item C<update>

 $success = $table->update([$update],[$persist])

Update the object's exist_rec to new_rec. If $update is defined, its
COLUMN_NAME => value pairs will be added to new_rec via add_values() (explained elsewhere).
$persist: if true, the updated record will be retrieved for further work,
otherwise this object's exist_rec and new_rec values will be undef'ed.

Only a delta of column values that differ between exist_rec and new_rec are updated.
__update__<COLUMN_NAME>($new_val) is called for each column in the delta.
Its up to you to make sure the current record was fetched via a
unique key, otherwise unexpected results can occur.

Return the number of rows updated or false if error (0 is represented as '0E0' which is true).
Return -1 if there was no data to update.
Return -2 if persistence is desired and the updated row could not be fetched.

=cut
sub update
{
    my ($self,$update,$persist) = @_;
    $self->add_values($update) || ($self->{io}->_alert("Can't add values from \$update"), return undef) if ref($update);
    my $delta;
    my $rt;
    unless ($delta = $self->_prepare_update())
    {
        return undef;
    }
    unless ($rt = $self->{io}->update_hash($delta,$self->{fetch_key}))
    {
        return undef;
    }
    my $id = $self->id();
    delete $self->{exist_rec};
    delete $self->{new_rec};
    $self->persist() || $persist || return $rt;
    $self->fetch($id) || return -2;
    return $rt;
}

sub _prepare_update
{
    my $self = shift;
    ref($self) || ($self->{io}->_alert("Method must be called by an object"), return undef);
    my $new_rec = $self->new_record() || {};
    my $exist_rec = $self->exist_record() || {};
    my $column_attrs = $self->column_types();
    my ($field,$new_val,%ret);
    while (($field,$new_val) = each %$new_rec)
    {
        # No attempt is made to find numerical equivalents because new_rec is set to exist_rec from fetch()
        if ($new_val ne $exist_rec->{$field})
        {
            defined(eval("\$self->__update__${field}(\$new_val)")) ||
                ($self->{io}->_alert("pre-update routine failed for $field: $new_val"), return undef);
            $ret{$field} = $new_val;
        }
    }
    return (\%ret);
}

=pod

=item C<insert>

 $pk = $table->insert([$insert],[$persist]);

Insert the current record, if $insert is defined, its
COLUMN_NAME => value pairs will be added via add_values() (explained elsewhere) before the insert.
$persist: if true, the inserted record will be retrieved for further work.
This only works if a key column was discovered in the constructor.
Otherwise this object's exist_record and new_record values will be undef'ed.

Return the generated pk ID value or -1.2 if there wasn't a value generated (e.g. if the table has a multi-column pk)
If there was no data to insert, -1.1 is returned.
Return -1.3 if persistence is desired and the new row could not be fetched.
Return -1.4 if a unique key violation occurred.
Return undef if error.