HoRain云--Perl数据库连接完全指南

云夏之末

781人浏览 · 2026-04-29 09:45:00

云夏之末 · 2026-04-29 09:45:00 发布

🎬 HoRain云小助手：个人主页

🔥 个人专栏: 《Linux 系列教程》《c语言教程》

⛺️生活的理想，就是为了理想的生活!

⛳️ 推荐

前些天发现了一个超棒的服务器购买网站，性价比超高，大内存超划算！忍不住分享一下给大家。点击跳转到网站。

专栏介绍

专栏名称	专栏介绍
《C语言》	本专栏主要撰写C干货内容和编程技巧，让大家从底层了解C，把更多的知识由抽象到简单通俗易懂。
《网络协议》	本专栏主要是注重从底层来给大家一步步剖析网络协议的奥秘，一起解密网络协议在运行中协议的基本运行机制！
《docker容器精解篇》	全面深入解析 docker 容器，从基础到进阶，涵盖原理、操作、实践案例，助您精通 docker。
《linux系列》	本专栏主要撰写Linux干货内容，从基础到进阶，知识由抽象到简单通俗易懂，帮你从新手小白到扫地僧。
《python 系列》	本专栏着重撰写Python相关的干货内容与编程技巧，助力大家从底层去认识Python，将更多复杂的知识由抽象转化为简单易懂的内容。
《试题库》	本专栏主要是发布一些考试和练习题库（涵盖软考、HCIE、HRCE、CCNA等）

🎯 Perl 数据库连接完全指南

Perl 是数据库操作的强大语言，通过 DBI（Database Interface）模块提供了统一的数据库接口。让我们深入了解如何使用 Perl 连接和操作各种数据库。

#!/usr/bin/perl
use strict;
use warnings;

# ===================================================================
# 目录
# 1. 🎯 DBI 基础
# 2. 📦 安装和配置
# 3. 🔌 连接数据库
# 4. 🔍 查询数据
# 5. 📝 插入数据
# 6. ✏️ 更新数据
# 7. 🗑️ 删除数据
# 8. 🔄 事务处理
# 9. 📊 批量操作
# 10. 🎨 高级技巧
# 11. 🔧 错误处理
# 12. 📈 性能优化
# 13. 🏆 最佳实践
# 14. 📋 示例项目
# ===================================================================

1. 🎯 DBI 基础

1.1 什么是 DBI？

# DBI 是 Perl 的数据库接口
# 提供统一的方式来连接各种数据库
# 类似 Java 的 JDBC 或 Python 的 DB-API

# DBI 架构：
# 应用程序 -> DBI -> DBD（驱动程序） -> 数据库
# 支持：MySQL, PostgreSQL, Oracle, SQLite, SQL Server 等

1.2 核心模块

#!/usr/bin/perl
use strict;
use warnings;
use DBI;                     # 主模块
use DBD::mysql;              # MySQL 驱动
use DBD::Pg;                 # PostgreSQL 驱动
use DBD::SQLite;             # SQLite 驱动
use DBD::Oracle;             # Oracle 驱动
use Data::Dumper;            # 调试输出

2. 📦 安装和配置

2.1 安装 DBI

# 使用 CPAN
cpan
install DBI

# 或直接安装
cpan DBI

# 安装特定驱动
cpan DBD::mysql      # MySQL
cpan DBD::Pg         # PostgreSQL
cpan DBD::SQLite     # SQLite
cpan DBD::Oracle     # Oracle
cpan DBD::ODBC       # ODBC

# 使用 CPANM（推荐）
cpanm DBI
cpanm DBD::mysql
cpanm DBD::SQLite

2.2 检查安装

#!/usr/bin/perl
use strict;
use warnings;

# 检查 DBI 版本
print "DBI 版本: $DBI::VERSION\n";

# 列出已安装的驱动
my @drivers = DBI->available_drivers();
print "可用驱动: " . join(', ', @drivers) . "\n";

# 检查特定驱动
eval {
    require DBD::mysql;
    print "DBD::mysql 已安装\n";
};
if ($@) {
    print "DBD::mysql 未安装: $@\n";
}

3. 🔌 连接数据库

3.1 基本连接参数

#!/usr/bin/perl
use strict;
use warnings;
use DBI;

# 连接参数
my $host     = 'localhost';     # 主机名
my $port     = 3306;            # 端口
my $database = 'test_db';       # 数据库名
my $user     = 'username';      # 用户名
my $password = 'password';      # 密码
my $dsn;                        # 数据源名称
my $dbh;                        # 数据库句柄

3.2 连接各种数据库

#!/usr/bin/perl
use strict;
use warnings;
use DBI;

# MySQL 连接
sub connect_mysql {
    my $dsn = "DBI:mysql:database=test_db;host=localhost;port=3306";
    my $user = "username";
    my $password = "password";
    
    my $dbh = DBI->connect($dsn, $user, $password, {
        RaiseError => 1,     # 出错时抛出异常
        AutoCommit => 1,       # 自动提交
        mysql_enable_utf8 => 1, # 启用 UTF-8
    });
    
    return $dbh;
}

# PostgreSQL 连接
sub connect_postgresql {
    my $dsn = "DBI:Pg:dbname=test_db;host=localhost;port=5432";
    my $user = "username";
    my $password = "password";
    
    my $dbh = DBI->connect($dsn, $user, $password, {
        RaiseError => 1,
        AutoCommit => 1,
        pg_enable_utf8 => 1,
    });
    
    return $dbh;
}

# SQLite 连接
sub connect_sqlite {
    my $database = "test.db";
    
    my $dbh = DBI->connect("DBI:SQLite:dbname=$database", "", "", {
        RaiseError => 1,
        AutoCommit => 1,
        sqlite_unicode => 1,
    });
    
    return $dbh;
}

# Oracle 连接
sub connect_oracle {
    my $dsn = "DBI:Oracle:host=localhost;sid=ORCL;port=1521";
    my $user = "username";
    my $password = "password";
    
    my $dbh = DBI->connect($dsn, $user, $password, {
        RaiseError => 1,
        AutoCommit => 1,
        ora_charset => 'AL32UTF8',
    });
    
    return $dbh;
}

# SQL Server 连接 (通过 ODBC)
sub connect_sqlserver {
    my $dsn = "DBI:ODBC:Driver={SQL Server};Server=localhost;Database=test_db;Trusted_Connection=yes;";
    
    my $dbh = DBI->connect($dsn, "", "", {
        RaiseError => 1,
        AutoCommit => 1,
    });
    
    return $dbh;
}

3.3 连接选项

#!/usr/bin/perl
use strict;
use warnings;
use DBI;

# 完整的连接选项
my $dbh = DBI->connect($dsn, $user, $password, {
    # 错误处理
    RaiseError  => 1,      # 出错时抛出异常（生产环境推荐）
    PrintError  => 0,      # 不打印错误到 STDERR
    HandleError => sub {    # 自定义错误处理
        my ($msg, $dbh, $rc) = @_;
        die "数据库错误: $msg (代码: $rc)\n";
    },
    
    # 事务
    AutoCommit  => 1,      # 自动提交
    LongTruncOk => 1,       # 允许长数据截断
    
    # 性能
    AutoInactiveDestroy => 1,  # 自动销毁不活动连接
    mysql_auto_reconnect => 1, # MySQL 自动重连
    pg_auto_reconnect    => 1, # PostgreSQL 自动重连
    
    # 字符集
    mysql_enable_utf8    => 1,  # MySQL UTF-8
    pg_enable_utf8       => 1,  # PostgreSQL UTF-8
    sqlite_unicode      => 1,  # SQLite Unicode
    ora_charset         => 'AL32UTF8',  # Oracle UTF-8
    
    # 其他
    ShowErrorStatement  => 1,  # 显示错误语句
    TaintIn             => 1,  # 启用污点检查
    TaintOut            => 1,  # 输出污点检查
    
    # 超时设置
    mysql_connect_timeout => 10,  # MySQL 连接超时
    pg_connect_timeout   => 10,  # PostgreSQL 连接超时
});

# 检查连接
unless ($dbh) {
    die "连接失败: $DBI::errstr";
}

print "连接成功！\n";
print "驱动程序: " . $dbh->{Driver}->{Name} . "\n";
print "数据库: " . $dbh->{Name} . "\n";

4. 🔍 查询数据

4.1 基本查询

#!/usr/bin/perl
use strict;
use warnings;
use DBI;
use Data::Dumper;

# 连接数据库
my $dbh = connect_mysql();

# 1. 简单查询
sub simple_select {
    my $sql = "SELECT id, name, email FROM users";
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    
    while (my $row = $sth->fetchrow_hashref) {
        print "ID: $row->{id}, Name: $row->{name}, Email: $row->{email}\n";
    }
    
    $sth->finish;
}

# 2. 带条件的查询
sub select_with_condition {
    my $id = 1;
    my $sql = "SELECT * FROM users WHERE id = ?";
    my $sth = $dbh->prepare($sql);
    $sth->execute($id);
    
    if (my $row = $sth->fetchrow_hashref) {
        print Dumper($row);
    } else {
        print "没有找到记录\n";
    }
    
    $sth->finish;
}

# 3. 多条件查询
sub select_with_multiple_conditions {
    my ($min_age, $city) = (18, '北京');
    my $sql = "SELECT * FROM users WHERE age > ? AND city = ?";
    my $sth = $dbh->prepare($sql);
    $sth->execute($min_age, $city);
    
    while (my $row = $sth->fetchrow_hashref) {
        print "姓名: $row->{name}, 年龄: $row->{age}, 城市: $row->{city}\n";
    }
    
    $sth->finish;
}

4.2 获取数据的不同方法

# 1. fetchrow_hashref (最常用)
sub fetch_hashref {
    my $sql = "SELECT id, name, email FROM users";
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    
    while (my $row = $sth->fetchrow_hashref) {
        print "ID: $row->{id}, Name: $row->{name}\n";
    }
    
    $sth->finish;
}

# 2. fetchrow_arrayref
sub fetch_arrayref {
    my $sql = "SELECT id, name, email FROM users";
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    
    while (my $row = $sth->fetchrow_arrayref) {
        print "ID: $row->[0], Name: $row->[1], Email: $row->[2]\n";
    }
    
    $sth->finish;
}

# 3. fetchrow_array
sub fetch_array {
    my $sql = "SELECT id, name, email FROM users";
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    
    while (my ($id, $name, $email) = $sth->fetchrow_array) {
        print "ID: $id, Name: $name, Email: $email\n";
    }
    
    $sth->finish;
}

# 4. fetchall_arrayref
sub fetchall_arrayref {
    my $sql = "SELECT id, name, email FROM users";
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    
    my $results = $sth->fetchall_arrayref({});
    $sth->finish;
    
    foreach my $row (@$results) {
        print "ID: $row->{id}, Name: $row->{name}\n";
    }
}

# 5. selectall_arrayref
sub selectall {
    my $sql = "SELECT id, name, email FROM users WHERE age > ?";
    my $results = $dbh->selectall_arrayref($sql, { Slice => {} }, 18);
    
    foreach my $row (@$results) {
        print "ID: $row->{id}, Name: $row->{name}\n";
    }
}

# 6. selectrow_hashref
sub selectrow {
    my $sql = "SELECT * FROM users WHERE id = ?";
    my $row = $dbh->selectrow_hashref($sql, undef, 1);
    
    if ($row) {
        print "姓名: $row->{name}, 邮箱: $row->{email}\n";
    }
}

4.3 高级查询

# 1. 分页查询
sub pagination {
    my ($page, $page_size) = (1, 10);
    my $offset = ($page - 1) * $page_size;
    
    my $sql = "SELECT * FROM users ORDER BY id LIMIT ? OFFSET ?";
    my $sth = $dbh->prepare($sql);
    $sth->execute($page_size, $offset);
    
    my $results = $sth->fetchall_arrayref({});
    $sth->finish;
    
    return $results;
}

# 2. 排序查询
sub sorted_query {
    my ($sort_field, $sort_order) = @_;
    $sort_order = lc($sort_order) eq 'desc' ? 'DESC' : 'ASC';
    
    my $sql = "SELECT * FROM users ORDER BY $sort_field $sort_order";
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    
    my $results = $sth->fetchall_arrayref({});
    $sth->finish;
    
    return $results;
}

# 3. 模糊查询
sub fuzzy_search {
    my $keyword = shift;
    
    my $sql = "SELECT * FROM users WHERE name LIKE ? OR email LIKE ?";
    my $sth = $dbh->prepare($sql);
    $sth->execute("%$keyword%", "%$keyword%");
    
    my $results = $sth->fetchall_arrayref({});
    $sth->finish;
    
    return $results;
}

# 4. 连接查询
sub join_query {
    my $sql = "
        SELECT 
            u.id, 
            u.name, 
            u.email,
            o.order_id,
            o.order_date,
            o.total_amount
        FROM users u
        LEFT JOIN orders o ON u.id = o.user_id
        WHERE u.status = 'active'
        ORDER BY o.order_date DESC
    ";
    
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    
    my $results = $sth->fetchall_arrayref({});
    $sth->finish;
    
    return $results;
}

# 5. 聚合查询
sub aggregate_query {
    my $sql = "
        SELECT 
            COUNT(*) as total_users,
            AVG(age) as avg_age,
            MIN(age) as min_age,
            MAX(age) as max_age,
            city
        FROM users
        GROUP BY city
        HAVING COUNT(*) > 1
        ORDER BY total_users DESC
    ";
    
    my $sth = $dbh->prepare($sql);
    $sth->execute();
    
    my $results = $sth->fetchall_arrayref({});
    $sth->finish;
    
    return $results;
}

5. 📝 插入数据

5.1 基本插入

# 1. 单条插入
sub insert_single {
    my ($name, $email, $age) = @_;
    
    my $sql = "INSERT INTO users (name, email, age) VALUES (?, ?, ?)";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute($name, $email, $age);
        my $new_id = $dbh->{mysql_insertid} || $dbh->last_insert_id(undef, undef, undef, undef);
        print "插入成功，新ID: $new_id\n";
        $sth->finish;
        return $new_id;
    };
    
    if ($@) {
        print "插入失败: $@\n";
        return undef;
    }
}

# 2. 使用命名占位符
sub insert_with_named_placeholder {
    my $data = {
        name  => '张三',
        email => 'zhangsan@example.com',
        age   => 25,
        city  => '北京'
    };
    
    my $sql = "INSERT INTO users (name, email, age, city) VALUES (:name, :email, :age, :city)";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute($data);
        my $new_id = $dbh->last_insert_id(undef, undef, undef, undef);
        print "插入成功，新ID: $new_id\n";
        $sth->finish;
        return $new_id;
    };
    
    if ($@) {
        print "插入失败: $@\n";
        return undef;
    }
}

5.2 批量插入

# 1. 循环插入（不推荐，效率低）
sub insert_multiple_slow {
    my @users = (
        { name => '张三', email => 'zhangsan@example.com', age => 25 },
        { name => '李四', email => 'lisi@example.com', age => 30 },
        { name => '王五', email => 'wangwu@example.com', age => 28 }
    );
    
    my $sql = "INSERT INTO users (name, email, age) VALUES (?, ?, ?)";
    my $sth = $dbh->prepare($sql);
    
    foreach my $user (@users) {
        eval {
            $sth->execute($user->{name}, $user->{email}, $user->{age});
        };
        
        if ($@) {
            print "插入失败: $@\n";
        }
    }
    
    $sth->finish;
}

# 2. 使用事务批量插入
sub insert_multiple_with_transaction {
    my @users = (
        { name => '张三', email => 'zhangsan@example.com', age => 25 },
        { name => '李四', email => 'lisi@example.com', age => 30 },
        { name => '王五', email => 'wangwu@example.com', age => 28 }
    );
    
    my $sql = "INSERT INTO users (name, email, age) VALUES (?, ?, ?)";
    my $sth = $dbh->prepare($sql);
    
    # 开始事务
    $dbh->begin_work;
    
    eval {
        foreach my $user (@users) {
            $sth->execute($user->{name}, $user->{email}, $user->{age});
        }
        
        # 提交事务
        $dbh->commit;
        print "批量插入成功\n";
    };
    
    if ($@) {
        # 回滚事务
        $dbh->rollback;
        print "批量插入失败: $@\n";
    }
    
    $sth->finish;
}

# 3. 使用批量插入语句（数据库特定）
sub insert_multiple_fast {
    my @users = (
        { name => '张三', email => 'zhangsan@example.com', age => 25 },
        { name => '李四', email => 'lisi@example.com', age => 30 },
        { name => '王五', email => 'wangwu@example.com', age => 28 }
    );
    
    # MySQL 批量插入语法
    my $sql = "INSERT INTO users (name, email, age) VALUES ";
    my @values;
    my @bind_params;
    
    foreach my $user (@users) {
        push @values, "(?, ?, ?)";
        push @bind_params, $user->{name}, $user->{email}, $user->{age};
    }
    
    $sql .= join(', ', @values);
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute(@bind_params);
        print "批量插入成功，影响行数: " . $sth->rows . "\n";
        $sth->finish;
    };
    
    if ($@) {
        print "批量插入失败: $@\n";
    }
}

5.3 插入或更新

# 1. 如果存在则更新
sub insert_or_update {
    my $data = {
        name  => '张三',
        email => 'zhangsan@example.com',
        age   => 26,  # 更新年龄
        city  => '上海'
    };
    
    # MySQL: INSERT ... ON DUPLICATE KEY UPDATE
    my $sql = "
        INSERT INTO users (name, email, age, city) 
        VALUES (?, ?, ?, ?)
        ON DUPLICATE KEY UPDATE
            age = VALUES(age),
            city = VALUES(city)
    ";
    
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute($data->{name}, $data->{email}, $data->{age}, $data->{city});
        print "插入或更新成功\n";
        $sth->finish;
    };
    
    if ($@) {
        print "操作失败: $@\n";
    }
}

# 2. 如果不存在则插入
sub insert_if_not_exists {
    my $data = {
        name  => '张三',
        email => 'zhangsan@example.com',
        age   => 25
    };
    
    # 先检查是否存在
    my $check_sql = "SELECT COUNT(*) as count FROM users WHERE email = ?";
    my $check_sth = $dbh->prepare($check_sql);
    $check_sth->execute($data->{email});
    my $result = $check_sth->fetchrow_hashref;
    $check_sth->finish;
    
    if ($result->{count} == 0) {
        # 不存在，插入
        my $insert_sql = "INSERT INTO users (name, email, age) VALUES (?, ?, ?)";
        my $insert_sth = $dbh->prepare($insert_sql);
        
        eval {
            $insert_sth->execute($data->{name}, $data->{email}, $data->{age});
            print "插入成功\n";
            $insert_sth->finish;
        };
        
        if ($@) {
            print "插入失败: $@\n";
        }
    } else {
        print "记录已存在\n";
    }
}

6. ✏️ 更新数据

6.1 基本更新

# 1. 单条更新
sub update_single {
    my ($id, $data) = @_;
    
    my $sql = "UPDATE users SET name = ?, email = ?, age = ? WHERE id = ?";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute($data->{name}, $data->{email}, $data->{age}, $id);
        my $affected_rows = $sth->rows;
        
        if ($affected_rows > 0) {
            print "更新成功，影响行数: $affected_rows\n";
        } else {
            print "没有找到要更新的记录\n";
        }
        
        $sth->finish;
    };
    
    if ($@) {
        print "更新失败: $@\n";
    }
}

# 2. 条件更新
sub update_with_condition {
    my ($city, $new_city) = @_;
    
    my $sql = "UPDATE users SET city = ? WHERE city = ?";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute($new_city, $city);
        my $affected_rows = $sth->rows;
        print "更新成功，影响行数: $affected_rows\n";
        $sth->finish;
    };
    
    if ($@) {
        print "更新失败: $@\n";
    }
}

6.2 批量更新

# 1. 使用事务批量更新
sub update_multiple_with_transaction {
    my @updates = (
        { id => 1, age => 26 },
        { id => 2, age => 31 },
        { id => 3, age => 29 }
    );
    
    my $sql = "UPDATE users SET age = ? WHERE id = ?";
    my $sth = $dbh->prepare($sql);
    
    # 开始事务
    $dbh->begin_work;
    
    my $total_affected = 0;
    eval {
        foreach my $update (@updates) {
            $sth->execute($update->{age}, $update->{id});
            $total_affected += $sth->rows;
        }
        
        # 提交事务
        $dbh->commit;
        print "批量更新成功，总影响行数: $total_affected\n";
    };
    
    if ($@) {
        # 回滚事务
        $dbh->rollback;
        print "批量更新失败: $@\n";
    }
    
    $sth->finish;
}

# 2. 使用 CASE 语句批量更新
sub update_with_case {
    my %age_updates = (
        1 => 26,
        2 => 31,
        3 => 29
    );
    
    my $sql = "UPDATE users SET age = CASE id ";
    my @bind_params;
    
    foreach my $id (keys %age_updates) {
        $sql .= "WHEN ? THEN ? ";
        push @bind_params, $id, $age_updates{$id};
    }
    
    $sql .= "END WHERE id IN (" . join(',', ('?') x keys %age_updates) . ")";
    push @bind_params, keys %age_updates;
    
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute(@bind_params);
        my $affected_rows = $sth->rows;
        print "批量更新成功，影响行数: $affected_rows\n";
        $sth->finish;
    };
    
    if ($@) {
        print "批量更新失败: $@\n";
    }
}

6.3 递增/递减更新

# 1. 递增字段
sub increment_field {
    my ($id, $field, $amount) = @_;
    
    my $sql = "UPDATE users SET $field = $field + ? WHERE id = ?";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute($amount, $id);
        print "递增成功\n";
        $sth->finish;
    };
    
    if ($@) {
        print "递增失败: $@\n";
    }
}

# 2. 递减字段
sub decrement_field {
    my ($id, $field, $amount) = @_;
    
    my $sql = "UPDATE users SET $field = $field - ? WHERE id = ?";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute($amount, $id);
        print "递减成功\n";
        $sth->finish;
    };
    
    if ($@) {
        print "递减失败: $@\n";
    }
}

7. 🗑️ 删除数据

7.1 基本删除

# 1. 按ID删除
sub delete_by_id {
    my $id = shift;
    
    my $sql = "DELETE FROM users WHERE id = ?";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute($id);
        my $affected_rows = $sth->rows;
        
        if ($affected_rows > 0) {
            print "删除成功，影响行数: $affected_rows\n";
        } else {
            print "没有找到要删除的记录\n";
        }
        
        $sth->finish;
    };
    
    if ($@) {
        print "删除失败: $@\n";
    }
}

# 2. 条件删除
sub delete_with_condition {
    my ($condition, @params) = @_;
    
    my $sql = "DELETE FROM users WHERE $condition";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute(@params);
        my $affected_rows = $sth->rows;
        print "删除成功，影响行数: $affected_rows\n";
        $sth->finish;
    };
    
    if ($@) {
        print "删除失败: $@\n";
    }
}

7.2 批量删除

# 1. 批量删除
sub delete_multiple {
    my @ids = @_;
    
    if (@ids == 0) {
        print "没有要删除的ID\n";
        return;
    }
    
    my $placeholders = join(',', ('?') x @ids);
    my $sql = "DELETE FROM users WHERE id IN ($placeholders)";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute(@ids);
        my $affected_rows = $sth->rows;
        print "批量删除成功，影响行数: $affected_rows\n";
        $sth->finish;
    };
    
    if ($@) {
        print "批量删除失败: $@\n";
    }
}

# 2. 事务中的批量删除
sub delete_multiple_with_transaction {
    my @ids = @_;
    
    if (@ids == 0) {
        print "没有要删除的ID\n";
        return;
    }
    
    my $placeholders = join(',', ('?') x @ids);
    my $sql = "DELETE FROM users WHERE id IN ($placeholders)";
    my $sth = $dbh->prepare($sql);
    
    # 开始事务
    $dbh->begin_work;
    
    eval {
        $sth->execute(@ids);
        my $affected_rows = $sth->rows;
        
        # 提交事务
        $dbh->commit;
        print "批量删除成功，影响行数: $affected_rows\n";
    };
    
    if ($@) {
        # 回滚事务
        $dbh->rollback;
        print "批量删除失败: $@\n";
    }
    
    $sth->finish;
}

7.3 清空表

# 清空表（TRUNCATE）
sub truncate_table {
    my $table = shift;
    
    my $sql = "TRUNCATE TABLE $table";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute;
        print "表 $table 已清空\n";
        $sth->finish;
    };
    
    if ($@) {
        print "清空表失败: $@\n";
    }
}

# 删除表
sub drop_table {
    my $table = shift;
    
    my $sql = "DROP TABLE IF EXISTS $table";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute;
        print "表 $table 已删除\n";
        $sth->finish;
    };
    
    if ($@) {
        print "删除表失败: $@\n";
    }
}

8. 🔄 事务处理

8.1 基本事务

# 手动事务控制
sub transaction_example {
    # 关闭自动提交
    $dbh->{AutoCommit} = 0;
    
    eval {
        # 执行多个操作
        my $sql1 = "UPDATE accounts SET balance = balance - ? WHERE id = ?";
        my $sth1 = $dbh->prepare($sql1);
        $sth1->execute(100, 1);
        
        my $sql2 = "UPDATE accounts SET balance = balance + ? WHERE id = ?";
        my $sth2 = $dbh->prepare($sql2);
        $sth2->execute(100, 2);
        
        # 提交事务
        $dbh->commit;
        print "事务提交成功\n";
        
        $sth1->finish;
        $sth2->finish;
    };
    
    if ($@) {
        # 回滚事务
        $dbh->rollback;
        print "事务回滚: $@\n";
    }
    
    # 恢复自动提交
    $dbh->{AutoCommit} = 1;
}

# 使用 begin_work
sub transaction_with_begin_work {
    eval {
        # 开始事务
        $dbh->begin_work;
        
        my $sql1 = "INSERT INTO orders (user_id, amount) VALUES (?, ?)";
        my $sth1 = $dbh->prepare($sql1);
        $sth1->execute(1, 100.00);
        
        my $order_id = $dbh->last_insert_id(undef, undef, undef, undef);
        
        my $sql2 = "INSERT INTO order_items (order_id, product_id, quantity) VALUES (?, ?, ?)";
        my $sth2 = $dbh->prepare($sql2);
        $sth2->execute($order_id, 101, 2);
        
        # 提交事务
        $dbh->commit;
        print "订单创建成功，订单号: $order_id\n";
        
        $sth1->finish;
        $sth2->finish;
    };
    
    if ($@) {
        # 回滚事务
        $dbh->rollback;
        print "订单创建失败: $@\n";
    }
}

8.2 嵌套事务处理

# 保存点（Savepoint）支持
sub savepoint_example {
    eval {
        $dbh->begin_work;
        
        my $sql1 = "UPDATE accounts SET balance = balance - 100 WHERE id = 1";
        $dbh->do($sql1);
        
        # 创建保存点
        $dbh->do("SAVEPOINT sp1");
        
        my $sql2 = "UPDATE accounts SET balance = balance + 100 WHERE id = 2";
        $dbh->do($sql2);
        
        # 检查条件
        my $sth = $dbh->prepare("SELECT balance FROM accounts WHERE id = 2");
        $sth->execute;
        my $row = $sth->fetchrow_hashref;
        $sth->finish;
        
        if ($row->{balance} < 0) {
            # 回滚到保存点
            $dbh->do("ROLLBACK TO SAVEPOINT sp1");
            print "回滚到保存点\n";
        }
        
        $dbh->commit;
        print "事务完成\n";
    };
    
    if ($@) {
        $dbh->rollback;
        print "事务失败: $@\n";
    }
}

8.3 事务隔离级别

# 设置事务隔离级别
sub set_transaction_isolation {
    my $level = shift;  # READ UNCOMMITTED, READ COMMITTED, REPEATABLE READ, SERIALIZABLE
    
    my $sql = "SET TRANSACTION ISOLATION LEVEL $level";
    $dbh->do($sql);
    print "事务隔离级别设置为: $level\n";
}

# 使用不同隔离级别的事务
sub transaction_with_isolation {
    eval {
        # 设置隔离级别
        $dbh->do("SET TRANSACTION ISOLATION LEVEL SERIALIZABLE");
        
        $dbh->begin_work;
        
        # 执行操作
        my $sql = "SELECT * FROM accounts WHERE id = 1 FOR UPDATE";
        my $sth = $dbh->prepare($sql);
        $sth->execute;
        
        # 更新操作
        my $update_sql = "UPDATE accounts SET balance = balance - 100 WHERE id = 1";
        $dbh->do($update_sql);
        
        $dbh->commit;
        print "事务完成\n";
        
        $sth->finish;
    };
    
    if ($@) {
        $dbh->rollback;
        print "事务失败: $@\n";
    }
}

9. 📊 批量操作

9.1 批量查询

# 使用绑定变量批量查询
sub batch_select {
    my @ids = (1, 2, 3, 4, 5);
    
    my $placeholders = join(',', ('?') x @ids);
    my $sql = "SELECT * FROM users WHERE id IN ($placeholders)";
    my $sth = $dbh->prepare($sql);
    $sth->execute(@ids);
    
    my $results = $sth->fetchall_arrayref({});
    $sth->finish;
    
    return $results;
}

# 分批次查询大数据
sub batch_select_large_data {
    my $page_size = 1000;
    my $offset = 0;
    my @all_results;
    
    while (1) {
        my $sql = "SELECT * FROM users ORDER BY id LIMIT ? OFFSET ?";
        my $sth = $dbh->prepare($sql);
        $sth->execute($page_size, $offset);
        
        my $results = $sth->fetchall_arrayref({});
        $sth->finish;
        
        last unless @$results;
        
        push @all_results, @$results;
        $offset += $page_size;
        
        print "已获取 " . scalar(@all_results) . " 条记录\n";
        
        # 处理当前批次的数据
        process_batch($results);
    }
    
    return \@all_results;
}

9.2 批量插入优化

# 使用 bind_param 批量插入
sub batch_insert_optimized {
    my @users = (
        { name => '张三', email => 'zhangsan@example.com', age => 25 },
        { name => '李四', email => 'lisi@example.com', age => 30 },
        { name => '王五', email => 'wangwu@example.com', age => 28 }
    );
    
    my $sql = "INSERT INTO users (name, email, age) VALUES (?, ?, ?)";
    my $sth = $dbh->prepare($sql);
    
    $dbh->begin_work;
    
    eval {
        foreach my $user (@users) {
            $sth->bind_param(1, $user->{name});
            $sth->bind_param(2, $user->{email});
            $sth->bind_param(3, $user->{age});
            $sth->execute;
        }
        
        $dbh->commit;
        print "批量插入成功\n";
    };
    
    if ($@) {
        $dbh->rollback;
        print "批量插入失败: $@\n";
    }
    
    $sth->finish;
}

# 使用 execute_array 批量插入
sub batch_insert_execute_array {
    my @names  = ('张三', '李四', '王五');
    my @emails = ('zhangsan@example.com', 'lisi@example.com', 'wangwu@example.com');
    my @ages   = (25, 30, 28);
    
    my $sql = "INSERT INTO users (name, email, age) VALUES (?, ?, ?)";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute_array({}, \@names, \@emails, \@ages);
        print "批量插入成功\n";
        $sth->finish;
    };
    
    if ($@) {
        print "批量插入失败: $@\n";
    }
}

9.3 批量更新优化

# 批量更新优化
sub batch_update_optimized {
    my %updates = (
        1 => { name => '张三新', age => 26 },
        2 => { name => '李四新', age => 31 },
        3 => { name => '王五新', age => 29 }
    );
    
    my $sql = "UPDATE users SET name = ?, age = ? WHERE id = ?";
    my $sth = $dbh->prepare($sql);
    
    $dbh->begin_work;
    
    eval {
        foreach my $id (keys %updates) {
            $sth->bind_param(1, $updates{$id}{name});
            $sth->bind_param(2, $updates{$id}{age});
            $sth->bind_param(3, $id);
            $sth->execute;
        }
        
        $dbh->commit;
        print "批量更新成功\n";
    };
    
    if ($@) {
        $dbh->rollback;
        print "批量更新失败: $@\n";
    }
    
    $sth->finish;
}

10. 🎨 高级技巧

10.1 预处理语句缓存

# 使用 prepare_cached
sub use_prepare_cached {
    my $sql = "SELECT * FROM users WHERE id = ?";
    
    # prepare_cached 会缓存预处理语句
    my $sth = $dbh->prepare_cached($sql);
    
    eval {
        $sth->execute(1);
        my $row = $sth->fetchrow_hashref;
        
        if ($row) {
            print "找到用户: $row->{name}\n";
        }
        
        $sth->finish;
    };
    
    if ($@) {
        print "查询失败: $@\n";
    }
}

# 检查缓存
sub check_statement_cache {
    my $dbh = shift;
    
    # 获取缓存统计
    my $cache_info = $dbh->{CachedKids};
    
    if ($cache_info) {
        print "缓存中的预处理语句:\n";
        foreach my $key (keys %$cache_info) {
            print "  $key\n";
        }
    } else {
        print "没有缓存的预处理语句\n";
    }
}

10.2 动态 SQL 生成

# 动态构建 SQL
sub dynamic_sql_builder {
    my $conditions = {
        status => 'active',
        age    => { '>' => 18 },
        city   => '北京'
    };
    
    my $sql = "SELECT * FROM users WHERE 1=1";
    my @bind_values;
    
    foreach my $field (keys %$conditions) {
        my $value = $conditions->{$field};
        
        if (ref $value eq 'HASH') {
            # 处理操作符
            foreach my $op (keys %$value) {
                $sql .= " AND $field $op ?";
                push @bind_values, $value->{$op};
            }
        } else {
            $sql .= " AND $field = ?";
            push @bind_values, $value;
        }
    }
    
    $sql .= " ORDER BY created_at DESC";
    
    my $sth = $dbh->prepare($sql);
    $sth->execute(@bind_values);
    
    my $results = $sth->fetchall_arrayref({});
    $sth->finish;
    
    return $results;
}

# 动态插入
sub dynamic_insert {
    my $data = {
        name  => '张三',
        email => 'zhangsan@example.com',
        age   => 25,
        city  => '北京'
    };
    
    my @fields = keys %$data;
    my @values = values %$data;
    
    my $field_list = join(', ', @fields);
    my $placeholders = join(', ', ('?') x @fields);
    
    my $sql = "INSERT INTO users ($field_list) VALUES ($placeholders)";
    
    my $sth = $dbh->prepare($sql);
    $sth->execute(@values);
    
    my $new_id = $dbh->last_insert_id(undef, undef, undef, undef);
    $sth->finish;
    
    return $new_id;
}

10.3 数据库元数据

# 获取表信息
sub get_table_info {
    my $dbh = shift;
    
    # 获取所有表
    my @tables = $dbh->tables;
    
    print "数据库中的表:\n";
    foreach my $table (@tables) {
        print "  $table\n";
    }
    
    # 获取表结构
    sub get_table_structure {
        my $table_name = shift;
        
        my $sth = $dbh->prepare("DESCRIBE $table_name");
        $sth->execute;
        
        my $structure = $sth->fetchall_arrayref({});
        $sth->finish;
        
        return $structure;
    }
    
    # 获取主键
    sub get_primary_keys {
        my $table_name = shift;
        
        my $sth = $dbh->primary_key_info(undef, undef, $table_name);
        my $pk_info = $sth->fetchall_arrayref({});
        $sth->finish;
        
        return $pk_info;
    }
    
    # 获取外键
    sub get_foreign_keys {
        my $table_name = shift;
        
        my $sth = $dbh->foreign_key_info(undef, undef, undef, undef, undef, $table_name);
        my $fk_info = $sth->fetchall_arrayref({});
        $sth->finish;
        
        return $fk_info;
    }
}

10.4 存储过程调用

# 调用存储过程
sub call_stored_procedure {
    my ($user_id, $amount) = @_;
    
    # MySQL 存储过程调用
    my $sql = "CALL transfer_money(?, ?, @result)";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute($user_id, $amount);
        
        # 获取输出参数
        my $result_sth = $dbh->prepare("SELECT @result as result");
        $result_sth->execute;
        my $result = $result_sth->fetchrow_hashref;
        $result_sth->finish;
        
        print "存储过程返回: $result->{result}\n";
        $sth->finish;
    };
    
    if ($@) {
        print "调用存储过程失败: $@\n";
    }
}

# 调用函数
sub call_function {
    my $user_id = shift;
    
    my $sql = "SELECT get_user_balance(?) as balance";
    my $sth = $dbh->prepare($sql);
    
    eval {
        $sth->execute($user_id);
        my $result = $sth->fetchrow_hashref;
        
        if ($result) {
            print "用户余额: $result->{balance}\n";
        }
        
        $sth->finish;
    };
    
    if ($@) {
        print "调用函数失败: $@\n";
    }
}

11. 🔧 错误处理

11.1 基本错误处理

# 使用 eval 进行错误处理
sub safe_database_operation {
    my $dbh = shift;
    
    eval {
        my $sql = "SELECT * FROM non_existent_table";
        my $sth = $dbh->prepare($sql);
        $sth->execute;
        
        my $results = $sth->fetchall_arrayref({});
        $sth->finish;
    };
    
    if ($@) {
        print "数据库操作失败: $@\n";
        
        # 获取详细错误信息
        if ($dbh->err) {
            print "错误代码: " . $dbh->err . "\n";
            print "错误信息: " . $dbh->errstr . "\n";
        }
    }
}

# 检查连接状态
sub check_connection {
    my $dbh = shift;
    
    unless ($dbh && $dbh->ping) {
        print "数据库连接已断开，尝试重新连接...\n";
        
        # 重新连接
        eval {
            $dbh->disconnect;
            $dbh = DBI->connect($dsn, $user, $password, $options);
        };
        
        if ($@) {
            die "重新连接失败: $@\n";
        }
    }
    
    return $dbh;
}

11.2 事务错误处理

# 事务中的错误处理
sub transaction_with_error_handling {
    my $dbh = shift;
    
    # 保存原始设置
    my $original_raise_error = $dbh->{RaiseError};
    my $original_auto_commit = $dbh->{AutoCommit};
    
    # 设置事务模式
    $dbh->{RaiseError} = 1;
    $dbh->{AutoCommit} = 0;
    
    eval {
        # 操作1
        $dbh->do("UPDATE accounts SET balance = balance - 100 WHERE id = 1");
        
        # 操作2（可能失败）
        $dbh->do("UPDATE accounts SET balance = balance + 100 WHERE id = 999");
        
        # 提交事务
        $dbh->commit;
        print "事务提交成功\n";
    };
    
    if ($@) {
        # 回滚事务
        eval {
            $dbh->rollback;
            print "事务回滚成功\n";
        };
        
        if ($@) {
            print "回滚失败: $@\n";
        }
        
        print "事务执行失败: $@\n";
    }
    
    # 恢复原始设置
    $dbh->{RaiseError} = $original_raise_error;
    $dbh->{AutoCommit} = $original_auto_commit;
}

11.3 重试机制

# 带重试的数据库操作
sub retry_database_operation {
    my ($dbh, $sql, @params) = @_;
    my $max_retries = 3;
    my $retry_delay = 1;  # 秒
    
    for (my $attempt = 1; $attempt <= $max_retries; $attempt++) {
        eval {
            my $sth = $dbh->prepare($sql);
            $sth->execute(@params);
            
            my $result = $sth->fetchall_arrayref({});
            $sth->finish;
            
            return $result;
        };
        
        if ($@) {
            if ($attempt == $max_retries) {
                die "操作失败，已达到最大重试次数: $@\n";
            }
            
            print "第 $attempt 次尝试失败: $@\n";
            print "等待 ${retry_delay}秒后重试...\n";
            sleep($retry_delay);
            
            # 指数退避
            $retry_delay *= 2;
        } else {
            last;  # 成功，退出循环
        }
    }
    
    return undef;
}

12. 📈 性能优化

12.1 连接池

# 简单的连接池实现
package SimpleDBPool;

use strict;
use warnings;
use DBI;
use threads;
use threads::shared;

sub new {
    my ($class, %args) = @_;
    
    my $self = {
        dsn      => $args{dsn},
        user     => $args{user},
        password => $args{password},
        options  => $args{options} || {},
        min_size => $args{min_size} || 2,
        max_size => $args{max_size} || 10,
        pool     => [],  # 可用连接
        in_use   => {},  # 使用中的连接
    };
    
    bless $self, $class;
    
    # 初始化连接池
    for (my $i = 0; $i < $self->{min_size}; $i++) {
        push @{$self->{pool}}, $self->_create_connection;
    }
    
    return $self;
}

sub _create_connection {
    my $self = shift;
    
    my $dbh = DBI->connect(
        $self->{dsn},
        $self->{user},
        $self->{password},
        $self->{options}
    ) or die "连接失败: $DBI::errstr";
    
    return $dbh;
}

sub get_connection {
    my $self = shift;
    
    my $dbh;
    
    if (@{$self->{pool}} > 0) {
        # 从池中获取连接
        $dbh = pop @{$self->{pool}};
    } elsif (scalar(keys %{$self->{in_use}}) < $self->{max_size}) {
        # 创建新连接
        $dbh = $self->_create_connection;
    } else {
        # 等待连接可用
        while (@{$self->{pool}} == 0) {
            sleep(0.1);
        }
        $dbh = pop @{$self->{pool}};
    }
    
    # 记录使用中的连接
    $self->{in_use}{$dbh} = 1;
    
    return $dbh;
}

sub release_connection {
    my ($self, $dbh) = @_;
    
    delete $self->{in_use}{$dbh};
    push @{$self->{pool}}, $dbh;
}

sub DESTROY {
    my $self = shift;
    
    # 关闭所有连接
    foreach my $dbh (@{$self->{pool}}, values %{$self->{in_use}}) {
        $dbh->disconnect if $dbh;
    }
}

1;

12.2 查询缓存

# 查询缓存实现
package QueryCache;

use strict;
use warnings;
use Storable qw(freeze thaw);

sub new {
    my ($class, %args) = @_;
    
    my $self = {
        cache    => {},
        ttl      => $args{ttl} || 300,  # 默认5分钟
        max_size => $args{max_size} || 1000,
    };
    
    bless $self, $class;
    return $self;
}

sub get {
    my ($self, $key) = @_;
    
    my $cache_entry = $self->{cache}{$key};
    
    if ($cache_entry && time - $cache_entry->{timestamp} < $self->{ttl}) {
        return thaw($cache_entry->{data});
    }
    
    return undef;
}

sub set {
    my ($self, $key, $data) = @_;
    
    # 如果缓存已满，清理最旧的条目
    if (scalar(keys %{$self->{cache}}) >= $self->{max_size}) {
        $self->_cleanup;
    }
    
    $self->{cache}{$key} = {
        data      => freeze($data),
        timestamp => time,
    };
}

sub _cleanup {
    my $self = shift;
    
    # 移除过期的条目
    my $now = time;
    foreach my $key (keys %{$self->{cache}}) {
        if ($now - $self->{cache}{$key}{timestamp} > $self->{ttl}) {
            delete $self->{cache}{$key};
        }
    }
    
    # 如果还是太满，移除最旧的条目
    if (scalar(keys %{$self->{cache}}) > $self->{max_size} * 0.9) {
        my @sorted_keys = sort {
            $self->{cache}{$a}{timestamp} <=> $self->{cache}{$b}{timestamp}
        } keys %{$self->{cache}};
        
        my $to_remove = scalar(@sorted_keys) - int($self->{max_size} * 0.8);
        for (my $i = 0; $i < $to_remove; $i++) {
            delete $self->{cache}{$sorted_keys[$i]};
        }
    }
}

1;

12.3 批量操作优化

# 批量插入性能优化
sub bulk_insert_performance {
    my ($dbh, $data) = @_;
    
    # 方法1: 多条INSERT语句（最慢）
    sub method1_multiple_inserts {
        my $sql = "INSERT INTO users (name, email, age) VALUES (?, ?, ?)";
        my $sth = $dbh->prepare($sql);
        
        $dbh->begin_work;
        
        foreach my $row (@$data) {
            $sth->execute($row->{name}, $row->{email}, $row->{age});
        }
        
        $dbh->commit;
        $sth->finish;
    }
    
    # 方法2: 批量INSERT语句
    sub method2_bulk_insert {
        my $sql = "INSERT INTO users (name, email, age) VALUES ";
        my @values;
        my @bind_params;
        
        foreach my $row (@$data) {
            push @values, "(?, ?, ?)";
            push @bind_params, $row->{name}, $row->{email}, $row->{age};
        }
        
        $sql .= join(', ', @values);
        my $sth = $dbh->prepare($sql);
        
        $dbh->begin_work;
        $sth->execute(@bind_params);
        $dbh->commit;
        $sth->finish;
    }
    
    # 方法3: 使用LOAD DATA INFILE（MySQL，最快）
    sub method3_load_data_infile {
        my $temp_file = "temp_users.csv";
        
        # 创建临时文件
        open my $fh, '>', $temp_file or die "无法创建临时文件: $!";
        foreach my $row (@$data) {
            print $fh join(',', 
                $dbh->quote($row->{name}),
                $dbh->quote($row->{email}),
                $row->{age}
            ) . "\n";
        }
        close $fh;
        
        # 使用LOAD DATA INFILE
        my $sql = qq{
            LOAD DATA INFILE '$temp_file'
            INTO TABLE users
            FIELDS TERMINATED BY ','
            ENCLOSED BY '\''
            LINES TERMINATED BY '\\n'
            (name, email, age)
        };
        
        $dbh->do($sql);
        
        # 删除临时文件
        unlink $temp_file;
    }
}

13. 🏆 最佳实践

13.1 安全实践

# 1. 使用绑定变量（防止SQL注入）
sub safe_query_with_bind {
    my ($dbh, $user_id) = @_;
    
    # 安全的方式
    my $sql = "SELECT * FROM users WHERE id = ?";
    my $sth = $dbh->prepare($sql);
    $sth->execute($user_id);
    
    # 不安全的方式（绝对不要这样做！）
    my $unsafe_sql = "SELECT * FROM users WHERE id = $user_id";
    # 如果 $user_id 是 "1 OR 1=1"，就会有问题！
}

# 2. 输入验证
sub validate_input {
    my $input = shift;
    
    # 检查是否为空
    unless (defined $input && $input ne '') {
        die "输入不能为空";
    }
    
    # 检查长度
    if (length($input) > 100) {
        die "输入太长";
    }
    
    # 检查格式
    if ($input =~ /[<>"'&;]/) {
        die "输入包含非法字符";
    }
    
    return $input;
}

# 3. 最小权限原则
sub connect_with_minimal_privileges {
    my $dbh = DBI->connect(
        $dsn,
        'readonly_user',  # 只读用户
        'password',
        { RaiseError => 1 }
    );
    
    return $dbh;
}

13.2 代码组织

# 数据库操作类
package Database;

use strict;
use warnings;
use DBI;

sub new {
    my ($class, %args) = @_;
    
    my $self = {
        dsn      => $args{dsn},
        user     => $args{user},
        password => $args{password},
        options  => $args{options} || {},
        dbh      => undef,
    };
    
    bless $self, $class;
    $self->connect;
    
    return $self;
}

sub connect {
    my $self = shift;
    
    $self->{dbh} = DBI->connect(
        $self->{dsn},
        $self->{user},
        $self->{password},
        $self->{options}
    ) or die "连接失败: $DBI::errstr";
    
    return $self;
}

sub disconnect {
    my $self = shift;
    
    if ($self->{dbh}) {
        $self->{dbh}->disconnect;
        $self->{dbh} = undef;
    }
}

sub get_user {
    my ($self, $user_id) = @_;
    
    my $sql = "SELECT * FROM users WHERE id = ?";
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute($user_id);
    
    my $user = $sth->fetchrow_hashref;
    $sth->finish;
    
    return $user;
}

sub create_user {
    my ($self, $user_data) = @_;
    
    my $sql = "INSERT INTO users (name, email, age) VALUES (?, ?, ?)";
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute($user_data->{name}, $user_data->{email}, $user_data->{age});
    
    my $new_id = $self->{dbh}->last_insert_id(undef, undef, undef, undef);
    $sth->finish;
    
    return $new_id;
}

sub update_user {
    my ($self, $user_id, $user_data) = @_;
    
    my $sql = "UPDATE users SET name = ?, email = ?, age = ? WHERE id = ?";
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute($user_data->{name}, $user_data->{email}, $user_data->{age}, $user_id);
    
    my $affected = $sth->rows;
    $sth->finish;
    
    return $affected;
}

sub delete_user {
    my ($self, $user_id) = @_;
    
    my $sql = "DELETE FROM users WHERE id = ?";
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute($user_id);
    
    my $affected = $sth->rows;
    $sth->finish;
    
    return $affected;
}

sub DESTROY {
    my $self = shift;
    $self->disconnect;
}

1;

13.3 配置文件

# config/database.yaml
# ---
# development:
#   dsn: "DBI:mysql:database=myapp_dev;host=localhost;port=3306"
#   user: "dev_user"
#   password: "dev_password"
#   options:
#     RaiseError: 1
#     AutoCommit: 1
#     mysql_enable_utf8: 1
# 
# production:
#   dsn: "DBI:mysql:database=myapp_prod;host=prod.db.example.com;port=3306"
#   user: "prod_user"
#   password: "prod_password"
#   options:
#     RaiseError: 1
#     AutoCommit: 1
#     mysql_enable_utf8: 1
#     mysql_auto_reconnect: 1

package Config::Database;

use strict;
use warnings;
use YAML::XS qw(LoadFile);
use File::Spec;

my $config;

sub load_config {
    my $env = shift || 'development';
    
    my $config_file = File::Spec->catfile('config', 'database.yaml');
    unless (-e $config_file) {
        die "配置文件不存在: $config_file";
    }
    
    $config = LoadFile($config_file);
    
    unless ($config->{$env}) {
        die "环境 '$env' 的配置不存在";
    }
    
    return $config->{$env};
}

sub get_dbh {
    my ($env, %overrides) = @_;
    
    my $db_config = load_config($env);
    
    # 覆盖配置
    while (my ($key, $value) = each %overrides) {
        $db_config->{$key} = $value;
    }
    
    my $dbh = DBI->connect(
        $db_config->{dsn},
        $db_config->{user},
        $db_config->{password},
        $db_config->{options}
    ) or die "连接失败: $DBI::errstr";
    
    return $dbh;
}

1;

14. 📋 示例项目

14.1 完整的用户管理系统

#!/usr/bin/perl
use strict;
use warnings;
use DBI;
use Data::Dumper;

package UserManager;

use strict;
use warnings;

sub new {
    my ($class, $dbh) = @_;
    
    my $self = {
        dbh => $dbh
    };
    
    bless $self, $class;
    return $self;
}

# 创建用户表
sub create_table {
    my $self = shift;
    
    my $sql = "
        CREATE TABLE IF NOT EXISTS users (
            id INT AUTO_INCREMENT PRIMARY KEY,
            username VARCHAR(50) UNIQUE NOT NULL,
            email VARCHAR(100) UNIQUE NOT NULL,
            password_hash VARCHAR(255) NOT NULL,
            full_name VARCHAR(100),
            age INT,
            city VARCHAR(50),
            status ENUM('active', 'inactive', 'suspended') DEFAULT 'active',
            created_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP,
            updated_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP ON UPDATE CURRENT_TIMESTAMP,
            INDEX idx_username (username),
            INDEX idx_email (email),
            INDEX idx_status (status)
        ) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4
    ";
    
    eval {
        $self->{dbh}->do($sql);
        print "用户表创建成功\n";
    };
    
    if ($@) {
        die "创建用户表失败: $@\n";
    }
}

# 添加用户
sub add_user {
    my ($self, $user_data) = @_;
    
    my $sql = "
        INSERT INTO users (username, email, password_hash, full_name, age, city, status)
        VALUES (?, ?, ?, ?, ?, ?, ?)
    ";
    
    my $sth = $self->{dbh}->prepare($sql);
    
    eval {
        $sth->execute(
            $user_data->{username},
            $user_data->{email},
            $user_data->{password_hash},
            $user_data->{full_name},
            $user_data->{age},
            $user_data->{city},
            $user_data->{status} || 'active'
        );
        
        my $user_id = $self->{dbh}->last_insert_id(undef, undef, undef, undef);
        $sth->finish;
        
        return $user_id;
    };
    
    if ($@) {
        die "添加用户失败: $@\n";
    }
}

# 获取用户
sub get_user {
    my ($self, $user_id) = @_;
    
    my $sql = "SELECT * FROM users WHERE id = ?";
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute($user_id);
    
    my $user = $sth->fetchrow_hashref;
    $sth->finish;
    
    return $user;
}

# 获取用户列表
sub list_users {
    my ($self, %filters) = @_;
    
    my $sql = "SELECT * FROM users WHERE 1=1";
    my @bind_values;
    
    if ($filters{status}) {
        $sql .= " AND status = ?";
        push @bind_values, $filters{status};
    }
    
    if ($filters{city}) {
        $sql .= " AND city = ?";
        push @bind_values, $filters{city};
    }
    
    if ($filters{min_age}) {
        $sql .= " AND age >= ?";
        push @bind_values, $filters{min_age};
    }
    
    if ($filters{max_age}) {
        $sql .= " AND age <= ?";
        push @bind_values, $filters{max_age};
    }
    
    if ($filters{search}) {
        $sql .= " AND (username LIKE ? OR email LIKE ? OR full_name LIKE ?)";
        my $search_term = "%$filters{search}%";
        push @bind_values, ($search_term) x 3;
    }
    
    $sql .= " ORDER BY created_at DESC";
    
    if ($filters{limit}) {
        $sql .= " LIMIT ?";
        push @bind_values, $filters{limit};
    }
    
    if ($filters{offset}) {
        $sql .= " OFFSET ?";
        push @bind_values, $filters{offset};
    }
    
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute(@bind_values);
    
    my $users = $sth->fetchall_arrayref({});
    $sth->finish;
    
    return $users;
}

# 更新用户
sub update_user {
    my ($self, $user_id, $update_data) = @_;
    
    my @sets;
    my @bind_values;
    
    foreach my $field (keys %$update_data) {
        push @sets, "$field = ?";
        push @bind_values, $update_data->{$field};
    }
    
    return unless @sets;
    
    push @bind_values, $user_id;
    
    my $sql = "UPDATE users SET " . join(', ', @sets) . " WHERE id = ?";
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute(@bind_values);
    
    my $affected = $sth->rows;
    $sth->finish;
    
    return $affected;
}

# 删除用户
sub delete_user {
    my ($self, $user_id) = @_;
    
    my $sql = "DELETE FROM users WHERE id = ?";
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute($user_id);
    
    my $affected = $sth->rows;
    $sth->finish;
    
    return $affected;
}

# 用户统计
sub get_user_stats {
    my $self = shift;
    
    my $sql = "
        SELECT
            COUNT(*) as total_users,
            COUNT(CASE WHEN status = 'active' THEN 1 END) as active_users,
            COUNT(CASE WHEN status = 'inactive' THEN 1 END) as inactive_users,
            COUNT(CASE WHEN status = 'suspended' THEN 1 END) as suspended_users,
            AVG(age) as avg_age,
            MIN(age) as min_age,
            MAX(age) as max_age
        FROM users
    ";
    
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute;
    
    my $stats = $sth->fetchrow_hashref;
    $sth->finish;
    
    return $stats;
}

# 按城市统计
sub get_stats_by_city {
    my $self = shift;
    
    my $sql = "
        SELECT
            city,
            COUNT(*) as user_count,
            AVG(age) as avg_age
        FROM users

❤️❤️❤️本人水平有限，如有纰漏，欢迎各位大佬评论批评指正！😄😄😄

💘💘💘如果觉得这篇文对你有帮助的话，也请给个点赞、收藏下吧，非常感谢!👍 👍 👍

🔥🔥🔥Stay Hungry Stay Foolish 道阻且长,行则将至,让我们一起加油吧！🌙🌙🌙

AtomGit开源社区

AtomGit 是由开放原子开源基金会联合 CSDN 等生态伙伴共同推出的新一代开源与人工智能协作平台。平台坚持“开放、中立、公益”的理念，把代码托管、模型共享、数据集托管、智能体开发体验和算力服务整合在一起，为开发者提供从开发、训练到部署的一站式体验。

更多推荐

Claude Code 必备 Skill 清单：14 个亲测好用的效率技能包，一键安装全部

内置 50+ 设计风格、161 套配色方案、57 组字体搭配、99 条 UX 指南，覆盖 React、Next.js、Vue、SwiftUI、Flutter、Tailwind、shadcn/ui 等主流技术栈。PDF 工具箱：读取内容、合并拆分页面、旋转方向、添加水印、OCR 文字识别、表单填写。创建、读取、编辑，支持目录生成、页眉页脚、批注修订、图片替换。写报告和方案的人必备。表格数据处理：创建

AtomGit开源社区

Redis分布式锁进阶相关中文文献分享第九十期

本文推荐了多篇关于Redis分布式锁进阶技术的中文文献，涵盖实现原理、优化方案及常见问题解决方案。文献分析了Redis分布式锁的核心机制，包括SETNX命令使用、锁超时问题及Redlock算法实现，提出了结合Lua脚本的原子性操作方案。同时探讨了Redlock算法的可靠性争议，对比了ZooKeeper和etcd的分布式锁方案，并介绍了锁续期与Watchdog机制、集群环境下的锁优化策略以及性能调优

AtomGit开源社区

AI安全攻防战：五层防御体系破解提示词注入

AtomGit开源社区

所有评论(0)

查看更多评论

云夏之末

@2401_86544677

已为社区贡献209条内容

HoRain云--Perl数据库连接完全指南

云夏之末

⛳️ 推荐

专栏介绍

🎯 Perl 数据库连接完全指南

1. 🎯 DBI 基础

1.1 什么是 DBI？

1.2 核心模块

2. 📦 安装和配置

2.1 安装 DBI

2.2 检查安装

3. 🔌 连接数据库

3.1 基本连接参数

3.2 连接各种数据库

3.3 连接选项

4. 🔍 查询数据

4.1 基本查询

4.2 获取数据的不同方法

4.3 高级查询

5. 📝 插入数据

5.1 基本插入

5.2 批量插入

5.3 插入或更新

6. ✏️ 更新数据

6.1 基本更新

6.2 批量更新

6.3 递增/递减更新

7. 🗑️ 删除数据

7.1 基本删除

7.2 批量删除

7.3 清空表

8. 🔄 事务处理

8.1 基本事务

8.2 嵌套事务处理

8.3 事务隔离级别

9. 📊 批量操作

9.1 批量查询

9.2 批量插入优化

9.3 批量更新优化

10. 🎨 高级技巧

10.1 预处理语句缓存

10.2 动态 SQL 生成

10.3 数据库元数据

10.4 存储过程调用

11. 🔧 错误处理

11.1 基本错误处理

11.2 事务错误处理

11.3 重试机制

12. 📈 性能优化

12.1 连接池

12.2 查询缓存

12.3 批量操作优化

13. 🏆 最佳实践

13.1 安全实践

13.2 代码组织

13.3 配置文件

14. 📋 示例项目

14.1 完整的用户管理系统

所有评论(0)

温馨提示：您尚未绑定手机号

云夏之末