强曰为道
与天地相似，故不违。知周乎万物，而道济天下，故不过。旁行而不流，乐天知命，故不忧.
文档目录

Perl 完全指南 / 第 16 章：数据库编程

第 16 章：数据库编程

“数据是应用的核心”

Perl 通过 DBI（Database Interface）模块访问各种数据库。本章涵盖 DBI 基础、ORM 框架 DBIx::Class 以及连接池管理。

16.1 DBI 基础

连接数据库

use strict;
use warnings;
use DBI;

# 连接 SQLite
my $dbh = DBI->connect(
    "dbi:SQLite:dbname=mydata.db",   # DSN
    "",                                 # 用户名
    "",                                 # 密码
    {
        RaiseError => 1,                # 错误时 die
        AutoCommit => 1,                # 自动提交
        PrintError => 0,                # 不打印错误（由 RaiseError 处理）
    }
) or die "连接失败: $DBI::errstr\n";

常见 DSN 格式

数据库DSN 格式
SQLitedbi:SQLite:dbname=file.db
MySQLdbi:mysql:database=db;host=localhost;port=3306
PostgreSQLdbi:Pg:database=db;host=localhost;port=5432
Oracledbi:Oracle:SID=orcl;host=localhost;port=1521

16.2 执行 SQL

增删改查

# 创建表
$dbh->do(<<'SQL');
CREATE TABLE IF NOT EXISTS users (
    id    INTEGER PRIMARY KEY AUTOINCREMENT,
    name  TEXT NOT NULL,
    email TEXT UNIQUE,
    age   INTEGER DEFAULT 0
)
SQL

# 插入 — 使用占位符（防止 SQL 注入）
$dbh->do(
    "INSERT INTO users (name, email, age) VALUES (?, ?, ?)",
    undef,
    "张三", "zhangsan\@example.com", 30
);

# 更新
my $rows = $dbh->do(
    "UPDATE users SET age = ? WHERE name = ?",
    undef,
    31, "张三"
);
print "更新了 $rows 行\n";

# 删除
$dbh->do("DELETE FROM users WHERE age < ?", undef, 18);

SELECT 查询

# 准备并执行
my $sth = $dbh->prepare("SELECT id, name, email, age FROM users WHERE age > ?");
$sth->execute(18);

# 逐行获取
while (my $row = $sth->fetchrow_hashref()) {
    printf "ID: %d, 姓名: %s, 邮箱: %s\n",
        $row->{id}, $row->{name}, $row->{email};
}

# 获取所有行
$sth->execute(18);
my $all = $sth->fetchall_arrayref({});   # 数组引用（哈希引用）

# 获取单个值
my $count = $dbh->selectrow_array(
    "SELECT COUNT(*) FROM users WHERE age > ?", undef, 18
);

fetch 方法对比

方法返回值适用场景
fetchrow_array()列表已知列数
fetchrow_arrayref()数组引用性能敏感
fetchrow_hashref()哈希引用需要列名
fetchall_arrayref()所有行批量处理
selectrow_array()单行查单个值
selectall_arrayref()所有行快速查询

16.3 事务处理

# 手动事务
$dbh->{AutoCommit} = 0;

eval {
    $dbh->do("UPDATE accounts SET balance = balance - 100 WHERE id = 1");
    $dbh->do("UPDATE accounts SET balance = balance + 100 WHERE id = 2");
    $dbh->commit();
};

if ($@) {
    warn "事务失败: $@";
    $dbh->rollback();
}

16.4 连接池 — DBIx::Connector

use DBIx::Connector;

my $conn = DBIx::Connector->new(
    "dbi:mysql:database=mydb;host=localhost",
    "user", "password",
    {
        RaiseError => 1,
        AutoCommit => 1,
    }
);

# 自动重连
$conn->run(sub {
    my $dbh = $_;   # 数据库句柄
    my $rows = $dbh->do("UPDATE ...");
});

# 事务模式
$conn->txn(sub {
    my $dbh = $_;
    $dbh->do("INSERT ...");
    $dbh->do("UPDATE ...");
    # 自动 commit 或 rollback
});

16.5 DBIx::Class — ORM

定义 Schema

# lib/MyApp/Schema.pm
package MyApp::Schema;
use base 'DBIx::Class::Schema';
__PACKAGE__->load_namespaces();
1;

# lib/MyApp/Schema/Result/User.pm
package MyApp::Schema::Result::User;
use base 'DBIx::Class::Core';

__PACKAGE__->table('users');
__PACKAGE__->add_columns(
    id    => { data_type => 'integer', is_auto_increment => 1 },
    name  => { data_type => 'text',    is_nullable => 0 },
    email => { data_type => 'text',    is_nullable => 0 },
    age   => { data_type => 'integer', default_value => 0 },
);
__PACKAGE__->set_primary_key('id');
__PACKAGE__->add_unique_constraint(['email']);
__PACKAGE__->has_many(posts => 'MyApp::Schema::Result::Post', 'user_id');
1;

使用 ORM

use MyApp::Schema;

my $schema = MyApp::Schema->connect("dbi:SQLite:dbname=mydata.db");

# 创建
my $user = $schema->resultset('User')->create({
    name  => "张三",
    email => "zhangsan\@example.com",
    age   => 30,
});

# 查询
my $rs = $schema->resultset('User')->search(
    { age => { '>', 18 } },
    { order_by => { -asc => 'name' } }
);

while (my $row = $rs->next) {
    printf "%s (%d)\n", $row->name, $row->age;
}

# 更新
$user->update({ age => 31 });

# 删除
$user->delete();

16.6 业务场景：数据迁移脚本

#!/usr/bin/env perl
use strict;
use warnings;
use DBI;
use Text::CSV;

my $csv = Text::CSV->new({ binary => 1 });
my $dbh = DBI->connect("dbi:SQLite:dbname=import.db", "", "", {
    RaiseError => 1, AutoCommit => 0,
});

$dbh->do(<<'SQL');
CREATE TABLE IF NOT EXISTS products (
    id       INTEGER PRIMARY KEY AUTOINCREMENT,
    name     TEXT NOT NULL,
    price    REAL NOT NULL,
    category TEXT
)
SQL

my $sth = $dbh->prepare(
    "INSERT INTO products (name, price, category) VALUES (?, ?, ?)"
);

open my $fh, '<:encoding(UTF-8)', 'products.csv' or die $!;
my $header = $csv->getline($fh);   # 跳过表头

my ($imported, $errors) = (0, 0);
while (my $row = $csv->getline($fh)) {
    eval {
        $sth->execute($row->[0], $row->[1], $row->[2]);
        $imported++;
    };
    if ($@) {
        warn "导入失败: @$row - $@\n";
        $errors++;
    }
}
close $fh;

$dbh->commit();
$dbh->disconnect();

print "导入完成: $imported 成功, $errors 失败\n";

本章小结

要点内容
DBIPerl 数据库标准接口
占位符 ?防止 SQL 注入
RaiseError推荐的错误处理方式
DBIx::Connector连接池与自动重连
DBIx::ClassPerl 的 ORM 框架
事务手动 commit/rollback 或使用 DBIx::Connector

练习

  1. 使用 DBI 创建一个 SQLite 数据库，建表并插入 10 条数据
  2. 实现参数化查询，防止 SQL 注入
  3. 编写事务脚本：模拟银行转账
  4. 使用 DBIx::Class 定义一对多关系
  5. 编写 CSV 导入脚本，带错误处理和统计

扩展阅读