DELETE en Perl

Eliminar datos de MySQL desde Perl requiere las mismas precauciones que en cualquier otro lenguaje: siempre usar sentencias preparadas con placeholders, incluir una cláusula WHERE y verificar el resultado de la operación. DBI facilita estas operaciones con su API consistente y su soporte para transacciones. En este artículo aprenderás a eliminar registros de forma segura y a manejar los efectos en cascada.

Requisitos previos

Necesitas una conexión DBI configurada y tablas con datos de prueba. Si no las tienes, consulta los artículos anteriores para crearlas y poblarlas.

Código completo

Este ejemplo elimina un producto por su ID y verifica el resultado:

#!/usr/bin/perl
use strict;
use warnings;
use DBI;
 
my $dbh = DBI->connect(
    "DBI:mysql:database=tienda;host=localhost",
    "root", "tu_contraseña",
    { RaiseError => 1, AutoCommit => 1, mysql_enable_utf8mb4 => 1 }
);
 
my $producto_id = 5;
my $filas = $dbh->do(
    "DELETE FROM productos WHERE id = ?",
    undef, $producto_id
);
 
if ($filas > 0) {
    print "Producto con ID $producto_id eliminado correctamente\n";
    print "Filas eliminadas: $filas\n";
} else {
    print "No se encontró el producto con ID $producto_id\n";
}
 
$dbh->disconnect();

Salida esperada:

Producto con ID 5 eliminado correctamente
Filas eliminadas: 1

Explicación paso a paso

El método do() es la forma más directa de ejecutar un DELETE en DBI. Devuelve el número de filas afectadas, o "0E0" si no se eliminó ninguna fila (que es verdadero en contexto booleano pero cero en contexto numérico). El método rows() del statement handle también funciona si usas prepare/execute.

Eliminar con prepare/execute

Para mayor control, puedes usar el patrón prepare/execute:

my $sth = $dbh->prepare("DELETE FROM productos WHERE id = ?");
$sth->execute(3);
 
print "Filas eliminadas: ", $sth->rows(), "\n";
$sth->finish();

Eliminar con verificación previa

sub eliminar_con_verificacion {
    my ($dbh, $producto_id) = @_;
 
    # Verificar que existe
    my $producto = $dbh->selectrow_hashref(
        "SELECT id, nombre, precio FROM productos WHERE id = ?",
        undef, $producto_id
    );
 
    unless ($producto) {
        print "Producto no encontrado\n";
        return 0;
    }
 
    print "Eliminando: $producto->{nombre} (\$$producto->{precio})\n";
 
    my $filas = $dbh->do("DELETE FROM productos WHERE id = ?", undef, $producto_id);
    print "Producto eliminado correctamente\n";
    return $filas;
}
 
eliminar_con_verificacion($dbh, 4);

Eliminar múltiples registros

sub eliminar_por_ids {
    my ($dbh, @ids) = @_;
    return 0 unless @ids;
 
    my $placeholders = join(',', ('?') x scalar(@ids));
    my $filas = $dbh->do(
        "DELETE FROM productos WHERE id IN ($placeholders)",
        undef, @ids
    );
 
    print "$filas productos eliminados de ", scalar(@ids), " solicitados\n";
    return $filas;
}
 
eliminar_por_ids($dbh, 4, 5, 6);

Eliminar por condición

sub eliminar_por_categoria {
    my ($dbh, $categoria) = @_;
 
    # Contar antes de eliminar
    my ($total) = $dbh->selectrow_array(
        "SELECT COUNT(*) FROM productos WHERE categoria = ?",
        undef, $categoria
    );
 
    if ($total == 0) {
        print "No hay productos en la categoría '$categoria'\n";
        return 0;
    }
 
    my $filas = $dbh->do(
        "DELETE FROM productos WHERE categoria = ?",
        undef, $categoria
    );
 
    print "$filas productos eliminados de la categoría '$categoria'\n";
    return $filas;
}

Caso práctico

Veamos un sistema de borrado con papelera de reciclaje y purga programada:

#!/usr/bin/perl
use strict;
use warnings;
use DBI;
 
my $dbh = DBI->connect(
    "DBI:mysql:database=tienda;host=localhost",
    "root", "tu_contraseña",
    { RaiseError => 1, AutoCommit => 0, mysql_enable_utf8mb4 => 1 }
);
 
sub soft_delete {
    my ($dbh, $producto_id) = @_;
    my $filas = $dbh->do(
        "UPDATE productos SET activo = 0, eliminado_en = NOW() WHERE id = ? AND activo = 1",
        undef, $producto_id
    );
    $dbh->commit();
 
    if ($filas > 0) {
        print "Producto $producto_id movido a la papelera\n";
    } else {
        print "Producto $producto_id no encontrado o ya eliminado\n";
    }
    return $filas;
}
 
sub restaurar {
    my ($dbh, $producto_id) = @_;
    my $filas = $dbh->do(
        "UPDATE productos SET activo = 1, eliminado_en = NULL WHERE id = ? AND activo = 0",
        undef, $producto_id
    );
    $dbh->commit();
    return $filas;
}
 
sub purgar_papelera {
    my ($dbh, $dias_limite) = @_;
    $dias_limite ||= 30;
 
    eval {
        # Listar productos a purgar
        my $productos = $dbh->selectall_arrayref(
            "SELECT id, nombre, eliminado_en FROM productos
             WHERE activo = 0 AND eliminado_en < DATE_SUB(NOW(), INTERVAL ? DAY)",
            { Slice => {} }, $dias_limite
        );
 
        if (!@$productos) {
            print "No hay productos para purgar\n";
            return 0;
        }
 
        print "Purgando ", scalar(@$productos), " productos:\n";
        for my $p (@$productos) {
            print "  [$p->{id}] $p->{nombre} (eliminado: $p->{eliminado_en})\n";
        }
 
        my @ids = map { $_->{id} } @$productos;
        my $placeholders = join(',', ('?') x scalar(@ids));
 
        $dbh->do("DELETE FROM productos WHERE id IN ($placeholders)", undef, @ids);
        $dbh->commit();
 
        print scalar(@ids), " productos purgados permanentemente\n";
        return scalar(@ids);
    };
 
    if ($@) {
        $dbh->rollback();
        print "Error durante la purga: $@\n";
        return 0;
    }
}
 
# Uso
soft_delete($dbh, 3);
soft_delete($dbh, 4);
purgar_papelera($dbh, 0);  # Purgar todo inmediatamente (para demo)
 
$dbh->disconnect();

Manejo de errores

Los errores más comunes al eliminar registros:

sub eliminar_seguro {
    my ($dbh, $producto_id) = @_;
 
    my $filas;
    eval {
        $filas = $dbh->do("DELETE FROM productos WHERE id = ?", undef, $producto_id);
    };
 
    if ($@) {
        my $error = $@;
        if ($error =~ /foreign key constraint/) {
            return { error => 'REFERENCIA',
                     mensaje => 'No se puede eliminar: otros registros dependen de este' };
        } elsif ($error =~ /Lock wait timeout/) {
            return { error => 'TIMEOUT',
                     mensaje => 'El registro está bloqueado por otra operación' };
        } elsif ($error =~ /Deadlock/) {
            return { error => 'DEADLOCK',
                     mensaje => 'Se detectó un interbloqueo. Intenta de nuevo' };
        } else {
            return { error => 'INTERNO', mensaje => "Error: $error" };
        }
    }
 
    if ($filas == 0) {
        return { error => 'NOT_FOUND', mensaje => 'Registro no encontrado' };
    }
 
    return { exito => 1, eliminados => $filas };
}

Ahora que conoces las técnicas de eliminación, en el siguiente artículo aprenderás a manejar transacciones en MySQL desde Perl.

Escrito por Eduardo Lázaro