HoRain云--Perl错误处理完全指南
·
🎬 HoRain云小助手：个人主页
🔥 个人专栏: 《Linux 系列教程》《c语言教程》
⛺️生活的理想，就是为了理想的生活!
⛳️ 推荐
前些天发现了一个超棒的服务器购买网站，性价比超高，大内存超划算！忍不住分享一下给大家。点击跳转到网站。
专栏介绍
|
专栏名称 |
专栏介绍 |
|
本专栏主要撰写C干货内容和编程技巧，让大家从底层了解C，把更多的知识由抽象到简单通俗易懂。 |
|
|
本专栏主要是注重从底层来给大家一步步剖析网络协议的奥秘，一起解密网络协议在运行中协议的基本运行机制！ |
|
|
全面深入解析 docker 容器，从基础到进阶，涵盖原理、操作、实践案例，助您精通 docker。 |
|
|
本专栏主要撰写Linux干货内容，从基础到进阶，知识由抽象到简单通俗易懂，帮你从新手小白到扫地僧。 |
|
|
本专栏着重撰写Python相关的干货内容与编程技巧，助力大家从底层去认识Python，将更多复杂的知识由抽象转化为简单易懂的内容。 |
|
|
本专栏主要是发布一些考试和练习题库（涵盖软考、HCIE、HRCE、CCNA等） |
目录
🚨 Perl 错误处理完全指南
Perl 提供了多种错误处理机制，从简单的 die/warn到现代的异常处理模式。
#!/usr/bin/perl
use strict;
use warnings;
use v5.36;
# ===================================================================
# 目录
# 1. 🚨 基本错误处理
# 2. 🔧 eval 异常捕获
# 3. 🎯 Try::Tiny 模块
# 4. 📦 对象异常
# 5. 🎨 自定义异常
# 6. 🔄 错误传播
# 7. 📊 错误记录
# 8. 🛡️ 防御性编程
# 9. 🔍 调试技巧
# 10. 🎪 最佳实践
# ===================================================================1. 🚨 基本错误处理
1.1 die 和 warn
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
# ================= die - 致命错误 =================
# 1. 基本用法
sub divide {
my ($numerator, $denominator) = @_;
die "除数不能为零" if $denominator == 0;
return $numerator / $denominator;
}
# 调用
eval {
my $result = divide(10, 0);
say "结果: $result";
};
if ($@) {
warn "计算失败: $@";
}
# 2. die 的不同格式
die "简单错误信息"; # 简单字符串
die "错误发生在 ", __FILE__, " 第 ", __LINE__; # 多部分
die sprintf("错误代码: %d, 信息: %s", 404, "未找到"); # 格式化
# 3. 带退出码
if ($error) {
die "严重错误\n"; # 默认退出码: 255
}
# 4. 在模块中使用
package MyModule;
sub new {
my $class = shift;
die "缺少必需参数" unless @_;
bless { @_ }, $class;
}
# ================= warn - 警告 =================
# 1. 基本警告
sub process_file {
my $filename = shift;
unless (-e $filename) {
warn "文件不存在: $filename";
return;
}
unless (-r $filename) {
warn "文件不可读: $filename";
return;
}
# 处理文件
say "处理文件: $filename";
}
# 2. 警告级别控制
{
# 临时关闭警告
no warnings;
my $result = 10 / 0; # 不警告
# 只开启特定警告
use warnings 'numeric';
my $x = "abc" + 1; # 会警告: Argument "abc" isn't numeric
}
# 3. 自定义警告处理器
local $SIG{__WARN__} = sub {
my $message = shift;
chomp $message;
# 记录到日志文件
open my $log, '>>', 'warnings.log' or die $!;
print $log scalar(localtime) . ": $message\n";
close $log;
# 同时输出到STDERR
warn $message;
};
warn "这是一个测试警告";
# 4. warn 的返回值
my $result = warn "警告信息"; # 返回1（真值）
say "warn返回值: $result";
# ================= carp/croak/cluck/confess =================
use Carp qw(carp croak cluck confess);
# 1. carp - 从调用者的角度警告
sub carp_example {
carp "这是一个警告（从调用者角度）";
}
sub call_carp {
carp_example();
}
call_carp(); # 警告会显示调用位置
# 2. croak - 从调用者的角度die
sub croak_example {
croak "这是一个致命错误（从调用者角度）";
}
sub call_croak {
croak_example();
}
# eval { call_croak() };
# 3. cluck - 打印堆栈跟踪的警告
sub cluck_example {
cluck "带堆栈跟踪的警告";
}
sub nested_call {
cluck_example();
}
nested_call();
# 4. confess - 打印堆栈跟踪的die
sub confess_example {
confess "带堆栈跟踪的致命错误";
}
# eval { confess_example() };
# 5. 完整示例
package SafeDivider {
sub divide {
my ($class, $a, $b) = @_;
unless (defined $a && defined $b) {
carp "未定义的参数";
return;
}
unless ($b != 0) {
croak "除数不能为零";
}
return $a / $b;
}
sub complex_operation {
my $self = shift;
eval {
$self->risky_op();
};
if ($@) {
cluck "操作失败: $@";
return;
}
}
}
# ================= 特殊变量 =================
# 1. $! - 系统错误
eval {
open my $fh, '<', 'nonexistent.txt' or die "无法打开文件: $!";
};
if ($@) {
say "错误: $@";
say "错误号: $!";
say "错误字符串: " . $!+0;
}
# 2. $@ - 最后的错误/异常
eval {
die "测试异常";
};
if ($@) {
say "捕获到异常: $@";
# 分析异常
if ($@ =~ /测试/) {
say "这是一个测试异常";
}
}
# 3. $? - 子进程退出状态
system("ls /tmp");
if ($? == -1) {
die "命令执行失败: $!";
} elsif ($? & 127) {
die sprintf "子进程收到信号 %d, %s coredump",
($? & 127), ($? & 128) ? '有' : '无';
} else {
die sprintf "子进程退出，返回码 %d", $? >> 8;
}
# 4. $^E - 扩展系统错误（某些系统）
eval {
# 某些Windows特定错误
die "Windows错误: $^E" if $^E;
};
# 5. $^S - 当前解析状态
# 用于判断是否在eval中
sub check_state {
if ($^S) {
say "在eval块中";
} else {
say "不在eval块中";
}
}
check_state(); # 不在eval块中
eval { check_state() }; # 在eval块中
# ================= 错误处理模式 =================
# 模式1: 返回undef
sub safe_open {
my $filename = shift;
open my $fh, '<', $filename
or return; # 失败返回undef
return $fh; # 成功返回文件句柄
}
my $file = safe_open("test.txt");
if ($file) {
say "文件打开成功";
} else {
warn "文件打开失败: $!" if $!;
}
# 模式2: 返回(成功, 值)
sub try_operation {
my ($op, $arg) = @_;
my $result = eval {
$op->($arg);
};
if ($@) {
return (0, $@);
} else {
return (1, $result);
}
}
my ($ok, $result_or_error) = try_operation(
sub { die "测试错误" if $_[0] eq "error"; return "成功" },
"error"
);
if ($ok) {
say "结果: $result_or_error";
} else {
warn "错误: $result_or_error";
}
# 模式3: 错误对象
sub get_data {
my $id = shift;
unless ($id =~ /^\d+$/) {
return {
success => 0,
error => "无效的ID格式",
code => 400,
};
}
return {
success => 1,
data => { id => $id, name => "测试" },
};
}
my $response = get_data("abc");
if ($response->{success}) {
say "数据: " . $response->{data}{name};
} else {
warn "错误 $response->{code}: $response->{error}";
}
# 模式4: 异常链
sub outer {
eval {
inner();
};
if ($@) {
die "外部错误: $@";
}
}
sub inner {
eval {
innermost();
};
if ($@) {
die "内部错误: $@";
}
}
sub innermost {
die "最内层错误";
}
# 捕获链
eval { outer() };
if ($@) {
say "捕获到的异常链:";
say $@;
}2. 🔧 eval 异常捕获
2.1 eval BLOCK
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
# ================= 基本eval用法 =================
# 1. 捕获致命错误
eval {
my $result = 10 / 0; # 除零错误
1; # 成功时返回真
} or do {
my $error = $@;
warn "捕获到错误: $error";
};
# 2. 捕获die
eval {
die "用户定义的错误" if rand() < 0.5;
say "操作成功";
};
if ($@) {
warn "操作失败: $@";
}
# 3. 带返回值
my $success = eval {
# 可能失败的操作
open my $fh, '<', 'nonexistent.txt';
return 1; # 成功
};
if (!$success) {
warn "eval失败: $@" if $@;
}
# ================= eval的返回值 =================
# eval BLOCK 返回最后表达式的值
my $result = eval {
my $x = 10;
my $y = 2;
$x / $y; # 返回5
};
say "结果: $result"; # 5
# 捕获错误的返回值
$result = eval {
my $x = 10;
my $y = 0;
$x / $y; # 除零错误
};
if ($@) {
say "错误: $@"; # 错误信息
$result = undef; # 可以设置默认值
}
say "结果: ", defined $result ? $result : "未定义";
# ================= 嵌套eval =================
sub level1 {
eval {
level2();
1;
} or do {
my $error = $@;
# 添加上下文信息
die "level1失败: $error";
};
}
sub level2 {
eval {
level3();
1;
} or do {
my $error = $@;
die "level2失败: $error";
};
}
sub level3 {
die "原始错误";
}
# 捕获嵌套错误
eval { level1() };
if ($@) {
say "捕获到的错误链:";
say $@;
}
# ================= eval中的变量作用域 =================
my $outer_var = "外部变量";
eval {
my $inner_var = "内部变量";
$outer_var = "在eval中修改";
die "测试错误";
};
if ($@) {
# $inner_var 不可访问
# 但 $outer_var 的修改会保留
say "外部变量: $outer_var"; # 在eval中修改
}
# 使用local临时修改全局变量
our $Global = "原始值";
eval {
local $Global = "临时值";
die "错误发生";
};
# $Global 恢复为"原始值"
# ================= 安全的文件操作 =================
sub safe_file_operation {
my $filename = shift;
my $content = eval {
open my $fh, '<', $filename
or die "无法打开文件 $filename: $!";
local $/; # 一次性读取整个文件
my $data = <$fh>;
close $fh or die "关闭文件失败: $!";
$data; # 返回文件内容
};
if ($@) {
warn "文件操作失败: $@";
return; # 返回undef
}
return $content;
}
# 使用
my $data = safe_file_operation("test.txt");
if ($data) {
say "文件内容: $data";
}
# ================= 安全的数据库操作 =================
use DBI;
sub safe_db_query {
my ($dbh, $query, @params) = @_;
my $result = eval {
my $sth = $dbh->prepare($query)
or die "准备语句失败: " . $dbh->errstr;
$sth->execute(@params)
or die "执行失败: " . $sth->errstr;
my $data = $sth->fetchall_arrayref;
$sth->finish;
$data;
};
if ($@) {
# 记录错误并回滚事务
eval { $dbh->rollback } if $dbh;
warn "数据库错误: $@";
return;
}
return $result;
}
# ================= eval陷阱 =================
# 陷阱1: $@变量可能被重置
eval {
eval {
die "内部错误";
};
# 这里的$@已经被内部eval重置
if ($@) { # 这里不会执行！
warn "捕获内部错误: $@";
}
die "外部错误"; # 这会覆盖之前的$@
};
if ($@) {
say "最终错误: $@"; # 只看到"外部错误"
}
# 正确做法
my $inner_error;
eval {
eval {
die "内部错误";
1;
} or do {
$inner_error = $@;
};
if ($inner_error) {
warn "内部错误: $inner_error";
}
die "外部错误";
};
if ($@) {
say "捕获: $@";
say "内部错误: $inner_error" if $inner_error;
}
# 陷阱2: 信号可能中断eval
eval {
local $SIG{ALRM} = sub { die "超时" };
alarm(5);
# 长时间运行的操作
sleep 10;
alarm(0);
};
if ($@) {
if ($@ =~ /超时/) {
warn "操作超时";
} else {
warn "其他错误: $@";
}
}
# 陷阱3: 内存不足错误无法捕获
eval {
my @huge_array = (1) x 10_000_000_000; # 可能内存不足
};
if ($@) {
warn "内存错误: $@"; # 可能不会执行
}
# ================= eval最佳实践 =================
# 模式1: 标准模板
my $result = eval {
# 可能失败的操作
risky_operation();
1; # 成功标记
} or do {
my $error = $@ || "未知错误";
# 错误处理
handle_error($error);
return; # 或die，取决于上下文
};
# 模式2: 带清理的模板
my $resource;
my $success = eval {
$resource = acquire_resource();
# 使用资源
use_resource($resource);
1; # 成功
};
if (!$success) {
my $error = $@ || "未知错误";
# 清理资源
release_resource($resource) if $resource;
# 处理错误
handle_error($error);
return;
}
# 模式3: 嵌套错误处理
sub process_with_recovery {
my $operation = shift;
# 主尝试
my $result = eval {
$operation->();
1;
};
if ($result) {
return 1; # 成功
}
my $error = $@;
# 第一次重试
warn "第一次尝试失败: $error，重试...";
sleep 1;
$result = eval {
$operation->();
1;
};
if ($result) {
warn "重试成功";
return 1;
}
$error = $@;
# 回退方案
warn "重试失败: $error，使用回退方案";
return fallback_operation();
}3. 🎯 Try::Tiny 模块
3.1 现代异常处理
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
# 安装: cpanm Try::Tiny
use Try::Tiny;
# ================= 基本用法 =================
# 1. try-catch
try {
# 可能失败的代码
die "测试错误" if rand() < 0.5;
say "try块成功";
} catch {
# 错误处理
my $error = $_;
warn "捕获错误: $error";
};
# 2. try-catch-finally
try {
# 可能失败的代码
die "错误";
say "这不会执行";
} catch {
# 错误处理
my $error = $_;
warn "错误: $error";
} finally {
# 总是执行，无论是否出错
say "finally块执行";
};
# 3. 返回值处理
my $result = try {
# 返回一个值
my $value = compute();
return $value; # 从try返回
} catch {
# 错误时返回默认值
warn "计算失败: $_";
return 0; # 从catch返回
};
say "结果: $result";
# ================= 错误分类 =================
sub process_file {
my $filename = shift;
try {
open my $fh, '<', $filename
or die "FileError: 无法打开文件: $!";
my $content = do { local $/; <$fh> };
close $fh or die "FileError: 无法关闭文件: $!";
return $content;
} catch {
my $error = $_;
if ($error =~ /^FileError:/) {
warn "文件错误: $error";
return undef;
} else {
# 重新抛出未知错误
die $_;
}
};
}
# ================= 嵌套try块 =================
sub complex_operation {
my $input = shift;
try {
# 第一步
my $step1 = try {
process_step1($input);
} catch {
warn "第一步失败: $_";
return undef; # 返回undef表示失败
};
return unless defined $step1;
# 第二步
my $step2 = try {
process_step2($step1);
} catch {
warn "第二步失败: $_";
return undef;
};
return unless defined $step2;
return $step2;
} catch {
warn "整体操作失败: $_";
return undef;
};
}
# ================= 自定义异常类 =================
{
package MyException;
use overload '""' => 'as_string';
sub new {
my ($class, %args) = @_;
bless \%args, $class;
}
sub message { $_[0]{message} }
sub code { $_[0]{code} }
sub as_string {
my $self = shift;
return sprintf "[%s] %s", $self->code, $self->message;
}
}
# 使用自定义异常
sub risky_operation {
my $param = shift;
unless (defined $param) {
die MyException->new(
message => "参数未定义",
code => 400,
);
}
unless ($param =~ /^\d+$/) {
die MyException->new(
message => "参数必须是数字",
code => 422,
);
}
return $param * 2;
}
# 处理自定义异常
try {
my $result = risky_operation("abc");
say "结果: $result";
} catch {
my $error = $_;
if (ref $error && $error->isa('MyException')) {
warn "业务错误: " . $error->code . " - " . $error->message;
} else {
warn "系统错误: $error";
}
};
# ================= 资源管理 =================
# 使用Scope::Guard确保清理
use Scope::Guard;
sub with_file {
my $filename = shift;
my $fh;
my $guard = scope_guard {
if ($fh) {
close $fh or warn "关闭文件失败: $!";
}
};
try {
open $fh, '<', $filename
or die "无法打开文件: $!";
my $content = do { local $/; <$fh> };
return $content;
} catch {
warn "文件操作失败: $_";
return;
};
}
# ================= 重试逻辑 =================
sub retry_operation {
my ($operation, $max_retries, $delay) = @_;
$max_retries //= 3;
$delay //= 1;
my $last_error;
for my $attempt (1 .. $max_retries) {
try {
my $result = $operation->();
say "第${attempt}次尝试成功" if $attempt > 1;
return $result;
} catch {
$last_error = $_;
warn "第${attempt}次尝试失败: $last_error";
if ($attempt < $max_retries) {
sleep $delay;
$delay *= 2; # 指数退避
}
};
}
die "所有重试失败，最后错误: $last_error";
}
# 使用重试
try {
my $result = retry_operation(
sub {
# 可能失败的操作
die "临时失败" if rand() < 0.7;
return "成功";
},
3, # 最大重试次数
1, # 初始延迟
);
say "最终结果: $result";
} catch {
warn "操作最终失败: $_";
};
# ================= 批量操作 =================
sub batch_process {
my @items = @_;
my @errors;
my @results;
for my $item (@items) {
try {
my $result = process_item($item);
push @results, $result;
} catch {
push @errors, {
item => $item,
error => $_,
};
};
}
return {
results => \@results,
errors => \@errors,
success_rate => scalar(@results) / scalar(@items) * 100,
};
}
# ================= Try::Tiny高级模式 =================
# 模式1: 带超时的操作
use Time::HiRes qw(sleep);
sub with_timeout {
my ($code, $timeout) = @_;
my $result;
my $timed_out = 0;
try {
local $SIG{ALRM} = sub { die "操作超时" };
alarm $timeout;
$result = $code->();
alarm 0;
} catch {
if ($_ =~ /操作超时/) {
$timed_out = 1;
} else {
die $_; # 重新抛出其他错误
}
};
if ($timed_out) {
warn "操作在${timeout}秒后超时";
return;
}
return $result;
}
# 模式2: 事务处理
sub transactional {
my ($dbh, $code) = @_;
try {
$dbh->begin_work;
my $result = $code->();
$dbh->commit;
return $result;
} catch {
my $error = $_;
eval { $dbh->rollback };
warn "事务回滚: $error";
return;
};
}
# 模式3: 条件执行
sub execute_if {
my ($condition, $code) = @_;
return unless $condition;
try {
$code->();
} catch {
warn "条件执行失败: $_";
};
}4. 📦 对象异常
4.1 异常对象
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
# ================= 基本异常类 =================
package Exception::Simple {
sub new {
my ($class, $message, %args) = @_;
bless {
message => $message,
time => time,
%args,
}, $class;
}
sub message { $_[0]{message} }
sub time { $_[0]{time} }
sub code { $_[0]{code} // 500 }
sub data { $_[0]{data} }
sub as_string {
my $self = shift;
my $str = sprintf "[%s] %s (at %s)",
$self->code,
$self->message,
scalar localtime $self->time;
if (my $data = $self->data) {
$str .= "\n数据: " . (ref $data ? Dumper($data) : $data);
}
return $str;
}
sub throw {
my ($class, @args) = @_;
die $class->new(@args);
}
}
# 使用异常对象
sub validate_input {
my $input = shift;
unless (defined $input) {
Exception::Simple->throw(
"输入未定义",
code => 400,
data => { field => 'input' },
);
}
unless ($input =~ /^\w+$/) {
Exception::Simple->throw(
"输入必须只包含字母数字",
code => 422,
data => { input => $input },
);
}
return 1;
}
# 捕获异常对象
try {
validate_input(undef);
} catch {
my $e = $_;
if (ref $e && $e->isa('Exception::Simple')) {
warn "验证错误: " . $e->message;
warn "错误码: " . $e->code;
warn "时间: " . scalar localtime $e->time;
if (my $data = $e->data) {
warn "相关数据: " . Dumper($data);
}
} else {
warn "未知错误: $e";
}
};
# ================= 异常层次结构 =================
package Exception::Base {
sub new {
my ($class, $message, %args) = @_;
bless {
message => $message,
time => time,
%args,
}, $class;
}
sub message { $_[0]{message} }
sub time { $_[0]{time} }
sub as_string {
my $self = shift;
return $self->message;
}
sub throw {
my ($class, @args) = @_;
die $class->new(@args);
}
}
package Exception::IO {
our @ISA = qw(Exception::Base);
sub code { 500 }
sub as_string {
my $self = shift;
return sprintf "IO错误: %s (代码: %d)",
$self->message, $self->code;
}
}
package Exception::Network {
our @ISA = qw(Exception::IO);
sub code { 503 }
sub as_string {
my $self = shift;
return sprintf "网络错误: %s", $self->message;
}
}
package Exception::Validation {
our @ISA = qw(Exception::Base);
sub code { 400 }
sub as_string {
my $self = shift;
my $str = sprintf "验证错误: %s", $self->message;
if (my $fields = $self->{fields}) {
$str .= sprintf " 字段: %s", join(', ', @$fields);
}
return $str;
}
}
# 使用异常层次结构
sub process_request {
my $request = shift;
# 验证
unless ($request->{valid}) {
Exception::Validation->throw(
"无效请求",
fields => ['valid'],
);
}
# 网络操作
unless (network_available()) {
Exception::Network->throw("网络不可用");
}
# 文件操作
unless (file_exists($request->{file})) {
Exception::IO->throw("文件不存在");
}
return 1;
}
# 分层捕获
try {
process_request({ valid => 0 });
} catch {
my $e = $_;
if ($e->isa('Exception::Validation')) {
warn "用户输入错误: " . $e->as_string;
# 返回400错误给用户
}
elsif ($e->isa('Exception::Network')) {
warn "网络问题: " . $e->as_string;
# 重试逻辑
}
elsif ($e->isa('Exception::IO')) {
warn "IO错误: " . $e->as_string;
# 清理资源
}
elsif ($e->isa('Exception::Base')) {
warn "其他错误: " . $e->as_string;
}
else {
warn "未知错误: $e";
}
};
# ================= 带堆栈跟踪的异常 =================
package Exception::WithStackTrace {
use Devel::StackTrace;
our @ISA = qw(Exception::Base);
sub new {
my ($class, $message, %args) = @_;
my $self = $class->SUPER::new($message, %args);
$self->{stack_trace} = Devel::StackTrace->new(
ignore_package => __PACKAGE__,
);
return $self;
}
sub stack_trace { $_[0]{stack_trace} }
sub as_string {
my $self = shift;
my $str = $self->SUPER::as_string();
$str .= "\n堆栈跟踪:\n" . $self->stack_trace->as_string();
return $str;
}
}
# 使用带堆栈跟踪的异常
sub deep_function {
deeper_function();
}
sub deeper_function {
deepest_function();
}
sub deepest_function {
Exception::WithStackTrace->throw("深层错误");
}
try {
deep_function();
} catch {
my $e = $_;
warn "错误详情:\n" . $e->as_string;
};
# ================= 异常链 =================
package Exception::Chained {
our @ISA = qw(Exception::Base);
sub new {
my ($class, $message, $cause, %args) = @_;
my $self = $class->SUPER::new($message, %args);
$self->{cause} = $cause;
return $self;
}
sub cause { $_[0]{cause} }
sub as_string {
my $self = shift;
my $str = $self->SUPER::as_string();
if (my $cause = $self->cause) {
$str .= "\n原因: " .
(ref $cause ? $cause->as_string : $cause);
}
return $str;
}
}
# 使用异常链
sub high_level_operation {
try {
low_level_operation();
} catch {
my $e = $_;
Exception::Chained->throw(
"高层操作失败",
$e, # 原因异常
code => 500,
);
};
}
sub low_level_operation {
Exception::Base->throw("底层操作失败");
}
try {
high_level_operation();
} catch {
my $e = $_;
warn "完整错误链:\n" . $e->as_string;
};
# ================= 工厂模式创建异常 =================
package Exception::Factory {
my %exceptions = (
io => 'Exception::IO',
network => 'Exception::Network',
validation => 'Exception::Validation',
business => 'Exception::Business',
);
sub create {
my ($class, $type, $message, %args) = @_;
my $exception_class = $exceptions{$type}
or die "未知异常类型: $type";
# 动态加载模块
eval "require $exception_class" unless $exception_class->can('new');
return $exception_class->new($message, %args);
}
sub throw {
my ($class, $type, $message, %args) = @_;
die $class->create($type, $message, %args);
}
}
# 使用工厂
try {
Exception::Factory->throw('validation', "无效输入");
} catch {
my $e = $_;
warn "异常: " . $e->as_string;
};5. 🎨 自定义异常
5.1 完整异常框架
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use overload '""' => 'as_string';
# ================= 异常基类 =================
package Exception {
use Carp qw(confess);
use Devel::StackTrace;
sub new {
my ($class, $message, %attrs) = @_;
my $self = bless {
message => $message,
time => time,
stack_trace => Devel::StackTrace->new(
ignore_package => __PACKAGE__,
),
%attrs,
}, $class;
return $self;
}
sub throw {
my ($class, @args) = @_;
confess $class->new(@args);
}
sub message { $_[0]{message} }
sub time { $_[0]{time} }
sub stack_trace { $_[0]{stack_trace} }
sub code { $_[0]{code} // 500 }
sub data { $_[0]{data} }
sub inner_error { $_[0]{inner_error} }
sub as_string {
my $self = shift;
my $str = sprintf "[%s] %s at %s",
ref($self),
$self->message,
scalar localtime $self->time;
if (my $data = $self->data) {
require Data::Dumper;
local $Data::Dumper::Terse = 1;
$str .= "\n数据: " . Data::Dumper::Dumper($data);
}
if (my $inner = $self->inner_error) {
$str .= "\n内部错误: " .
(ref $inner ? $inner->as_string : $inner);
}
if ($self->{show_trace}) {
$str .= "\n堆栈跟踪:\n" . $self->stack_trace->as_string;
}
return $str;
}
sub BUILDARGS {
my ($class, @args) = @_;
if (@args == 1 && !ref $args[0]) {
return (message => $args[0]);
}
elsif (@args == 1 && ref $args[0] eq 'HASH') {
return %{$args[0]};
}
else {
return @args;
}
}
}
# ================= 具体异常类 =================
package Exception::ValidationError {
our @ISA = qw(Exception);
sub code { 400 }
sub as_string {
my $self = shift;
my $str = $self->SUPER::as_string;
if (my $fields = $self->{fields}) {
$str .= sprintf "\n无效字段: %s", join(', ', @$fields);
}
if (my $rules = $self->{rules}) {
$str .= "\n验证规则:";
while (my ($field, $rule) = each %$rules) {
$str .= sprintf "\n %s: %s", $field, $rule;
}
}
return $str;
}
}
package Exception::AuthenticationError {
our @ISA = qw(Exception);
sub code { 401 }
sub as_string {
my $self = shift;
my $str = $self->SUPER::as_string;
if (my $user = $self->{user}) {
$str .= sprintf "\n用户: %s", $user;
}
if (my $attempts = $self->{attempts}) {
$str .= sprintf "\n尝试次数: %d", $attempts;
}
return $str;
}
}
package Exception::AuthorizationError {
our @ISA = qw(Exception);
sub code { 403 }
sub as_string {
my $self = shift;
my $str = $self->SUPER::as_string;
if (my $resource = $self->{resource}) {
$str .= sprintf "\n资源: %s", $resource;
}
if (my $action = $self->{action}) {
$str .= sprintf "\n操作: %s", $action;
}
if (my $permissions = $self->{permissions}) {
$str .= sprintf "\n所需权限: %s", join(', ', @$permissions);
}
return $str;
}
}
package Exception::NotFoundError {
our @ISA = qw(Exception);
sub code { 404 }
sub as_string {
my $self = shift;
my $str = $self->SUPER::as_string;
if (my $resource_type = $self->{resource_type}) {
$str .= sprintf "\n资源类型: %s", $resource_type;
}
if (my $resource_id = $self->{resource_id}) {
$str .= sprintf "\n资源ID: %s", $resource_id;
}
return $str;
}
}
package Exception::BusinessError {
our @ISA = qw(Exception);
sub code { 422 }
sub as_string {
my $self = shift;
my $str = $self->SUPER::as_string;
if (my $business_code = $self->{business_code}) {
$str .= sprintf "\n业务代码: %s", $business_code;
}
if (my $suggestions = $self->{suggestions}) {
$str .= "\n建议:";
for my $suggestion (@$suggestions) {
$str .= "\n - $suggestion";
}
}
return $str;
}
}
# ================= 使用自定义异常 =================
package UserManager {
sub new {
my ($class, %args) = @_;
bless \%args, $class;
}
sub authenticate {
my ($self, $username, $password) = @_;
# 验证输入
unless (defined $username && length $username) {
Exception::ValidationError->throw(
message => "用户名不能为空",
fields => ['username'],
rules => { username => 'required' },
);
}
unless (defined $password && length $password >= 8) {
Exception::ValidationError->throw(
message => "密码至少8个字符",
fields => ['password'],
rules => { password => 'min_length:8' },
);
}
# 检查用户是否存在
my $user = $self->_find_user($username);
unless ($user) {
Exception::AuthenticationError->throw(
message => "用户不存在",
user => $username,
attempts => 1,
);
}
# 验证密码
unless ($self->_check_password($user, $password)) {
Exception::AuthenticationError->throw(
message => "密码错误",
user => $username,
attempts => $user->{failed_attempts} + 1,
);
}
# 检查权限
unless ($self->_check_permissions($user)) {
Exception::AuthorizationError->throw(
message => "权限不足",
user => $username,
resource => 'dashboard',
action => 'access',
permissions => ['admin', 'user'],
);
}
return $user;
}
sub get_profile {
my ($self, $user_id) = @_;
my $profile = $self->_find_profile($user_id);
unless ($profile) {
Exception::NotFoundError->throw(
message => "用户资料不存在",
resource_type => 'user_profile',
resource_id => $user_id,
);
}
return $profile;
}
sub update_balance {
my ($self, $user_id, $amount) = @_;
my $user = $self->_find_user_by_id($user_id);
# 业务规则检查
if ($amount < 0 && abs($amount) > $user->{balance}) {
Exception::BusinessError->throw(
message => "余额不足",
business_code => 'INSUFFICIENT_FUNDS',
data => {
user_id => $user_id,
balance => $user->{balance},
amount => $amount,
},
suggestions => [
"请充值",
"联系客服",
],
);
}
# 更新余额
$user->{balance} += $amount;
return $user;
}
# 私有方法
sub _find_user { undef }
sub _check_password { 0 }
sub _check_permissions { 0 }
sub _find_profile { undef }
sub _find_user_by_id { { balance => 100 } }
}
# ================= 异常处理框架 =================
package ExceptionHandler {
sub new {
my ($class, %args) = @_;
bless {
logger => $args{logger},
config => $args{config} || {},
}, $class;
}
sub handle {
my ($self, $code) = @_;
try {
return $code->();
} catch {
my $e = $_;
return $self->_handle_exception($e);
};
}
sub _handle_exception {
my ($self, $e) = @_;
# 根据异常类型处理
if ($e->isa('Exception::ValidationError')) {
return $self->_handle_validation_error($e);
}
elsif ($e->isa('Exception::AuthenticationError')) {
return $self->_handle_auth_error($e);
}
elsif ($e->isa('Exception::AuthorizationError')) {
return $self->_handle_authz_error($e);
}
elsif ($e->isa('Exception::NotFoundError')) {
return $self->_handle_not_found_error($e);
}
elsif ($e->isa('Exception::BusinessError')) {
return $self->_handle_business_error($e);
}
elsif ($e->isa('Exception')) {
return $self->_handle_generic_error($e);
}
else {
return $self->_handle_unknown_error($e);
}
}
sub _handle_validation_error {
my ($self, $e) = @_;
$self->{logger}->warn("验证错误: " . $e->message) if $self->{logger};
return {
success => 0,
error => {
code => $e->code,
message => "输入验证失败",
details => {
fields => $e->{fields},
rules => $e->{rules},
},
},
};
}
sub _handle_auth_error {
my ($self, $e) = @_;
$self->{logger}->warn("认证错误: " . $e->message) if $self->{logger};
return {
success => 0,
error => {
code => $e->code,
message => "认证失败",
details => {
user => $e->{user},
attempts => $e->{attempts},
},
},
};
}
sub _handle_authz_error {
my ($self, $e) = @_;
$self->{logger}->warn("授权错误: " . $e->message) if $self->{logger};
return {
success => 0,
error => {
code => $e->code,
message => "权限不足",
details => {
resource => $e->{resource},
action => $e->{action},
permissions => $e->{permissions},
},
},
};
}
sub _handle_not_found_error {
my ($self, $e) = @_;
$self->{logger}->warn("未找到: " . $e->message) if $self->{logger};
return {
success => 0,
error => {
code => $e->code,
message => "资源未找到",
details => {
resource_type => $e->{resource_type},
resource_id => $e->{resource_id},
},
},
};
}
sub _handle_business_error {
my ($self, $e) = @_;
$self->{logger}->warn("业务错误: " . $e->message) if $self->{logger};
return {
success => 0,
error => {
code => $e->code,
message => "业务规则违反",
details => $e->data,
suggestions => $e->{suggestions},
business_code => $e->{business_code},
},
};
}
sub _handle_generic_error {
my ($self, $e) = @_;
$self->{logger}->error("通用错误: " . $e->as_string) if $self->{logger};
my $response = {
success => 0,
error => {
code => $e->code,
message => "服务器内部错误",
},
};
# 开发模式显示详细信息
if ($self->{config}{debug}) {
$response->{error}{details} = $e->as_string;
}
return $response;
}
sub _handle_unknown_error {
my ($self, $e) = @_;
$self->{logger}->error("未知错误: $e") if $self->{logger};
return {
success => 0,
error => {
code => 500,
message => "未知错误",
($self->{config}{debug} ? (details => "$e") : ()),
},
};
}
}
# ================= 使用示例 =================
# 创建异常处理器
my $handler = ExceptionHandler->new(
logger => { # 简单的日志器
warn => sub { warn "WARN: @_" },
error => sub { warn "ERROR: @_" },
},
config => { debug => 1 },
);
# 创建用户管理器
my $user_manager = UserManager->new();
# 处理请求
my $response = $handler->handle(sub {
# 尝试认证
my $user = $user_manager->authenticate("", "short");
return { success => 1, data => $user };
});
# 输出结果
if ($response->{success}) {
say "成功: " . Dumper($response->{data});
} else {
say "失败: " . Dumper($response->{error});
}6. 🔄 错误传播
6.1 错误传播策略
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
# ================= 错误传播模式 =================
# 模式1: 立即失败
sub process_data_1 {
my $data = shift;
# 任何错误都立即失败
validate_input($data) or die "输入无效";
my $result1 = step1($data) or die "步骤1失败";
my $result2 = step2($result1) or die "步骤2失败";
my $final = step3($result2) or die "步骤3失败";
return $final;
}
# 模式2: 收集所有错误
sub process_data_2 {
my $data = shift;
my @errors;
my @results;
# 收集所有错误
push @errors, "步骤1失败" unless step1($data);
push @errors, "步骤2失败" unless step2($data);
push @errors, "步骤3失败" unless step3($data);
if (@errors) {
return (0, \@errors);
}
return (1, \@results);
}
# 模式3: 尝试恢复
sub process_data_3 {
my $data = shift;
my $result = eval {
# 主路径
return primary_path($data);
};
unless ($result) {
# 尝试备用路径
$result = eval {
return fallback_path($data);
};
unless ($result) {
# 返回默认值
$result = default_value();
}
}
return $result;
}
# ================= 错误上下文传播 =================
sub high_level_operation {
my $input = shift;
try {
# 添加高层上下文
my $result = medium_level_operation($input);
return $result;
} catch {
my $e = $_;
# 添加上下文信息
die sprintf "高层操作失败 (输入: %s): %s",
$input, $e;
};
}
sub medium_level_operation {
my $input = shift;
try {
# 添加中层上下文
my $result = low_level_operation($input);
return $result;
} catch {
my $e = $_;
die sprintf "中层操作失败: %s", $e;
};
}
sub low_level_operation {
my $input = shift;
# 原始错误
die "原始错误: 输入无效" unless $input =~ /^\d+$/;
return $input * 2;
}
# 测试传播
eval {
high_level_operation("abc");
};
if ($@) {
say "捕获到的错误链:";
say $@;
}
# ================= 错误码传播 =================
package ErrorCode {
use constant {
SUCCESS => 0,
INVALID_INPUT => 1001,
NOT_FOUND => 1002,
PERMISSION_DENIED => 1003,
NETWORK_ERROR => 2001,
DATABASE_ERROR => 2002,
UNKNOWN_ERROR => 9999,
};
our %ERROR_MESSAGES = (
SUCCESS() => "成功",
INVALID_INPUT() => "输入无效",
NOT_FOUND() => "未找到",
PERMISSION_DENIED() => "权限不足",
NETWORK_ERROR() => "网络错误",
DATABASE_ERROR() => "数据库错误",
UNKNOWN_ERROR() => "未知错误",
);
sub get_message {
my $code = shift;
return $ERROR_MESSAGES{$code} || "未知错误码: $code";
}
}
# 使用错误码
sub api_call {
my ($endpoint, $params) = @_;
# 验证输入
unless ($endpoint && $params) {
return (ErrorCode::INVALID_INPUT, "缺少参数");
}
# 执行业务逻辑
my $result = eval {
# 可能失败的操作
if ($endpoint eq 'users' && !$params->{user_id}) {
die "user_id required";
}
return { data => "模拟数据" };
};
if ($@) {
# 根据错误类型返回相应的错误码
if ($@ =~ /not found/i) {
return (ErrorCode::NOT_FOUND, $@);
} elsif ($@ =~ /permission/i) {
return (ErrorCode::PERMISSION_DENIED, $@);
} else {
return (ErrorCode::UNKNOWN_ERROR, $@);
}
}
return (ErrorCode::SUCCESS, $result);
}
# 处理错误码
my ($code, $result) = api_call('users', {});
if ($code == ErrorCode::SUCCESS) {
say "成功: " . Dumper($result);
} else {
my $message = ErrorCode::get_message($code);
warn "错误 $code: $message ($result)";
}
# ================= 错误包装 =================
sub with_context {
my ($context, $code) = @_;
try {
return $code->();
} catch {
my $e = $_;
# 包装错误
if (ref $e && $e->isa('Exception')) {
# 已经是异常对象，添加上下文
$e->{context} = $context;
die $e;
} else {
# 普通错误，包装成异常
die Exception->new(
message => "$context: $e",
inner_error => $e,
);
}
};
}
# 使用错误包装
sub complex_operation {
my $data = shift;
with_context("处理数据", sub {
with_context("验证输入", sub {
die "输入为空" unless $data;
});
with_context("计算", sub {
my $result = calculate($data);
die "计算失败" unless defined $result;
return $result;
});
});
}
# ================= 错误传播决策 =================
# 1. 立即传播
sub fail_fast {
my $data = shift;
# 任何错误都立即失败
step1($data) or die "步骤1失败";
step2($data) or die "步骤2失败";
step3($data) or die "步骤3失败";
return 1;
}
# 2. 收集后传播
sub collect_errors {
my $data = shift;
my @errors;
push @errors, "步骤1" unless step1($data);
push @errors, "步骤2" unless step2($data);
push @errors, "步骤3" unless step3($data);
if (@errors) {
die "多个错误: " . join(", ", @errors);
}
return 1;
}
# 3. 最佳努力
sub best_effort {
my $data = shift;
my @results;
# 尝试所有步骤，忽略失败
push @results, step1($data) if eval { step1($data) };
push @results, step2($data) if eval { step2($data) };
push @results, step3($data) if eval { step3($data) };
return \@results;
}
# 4. 阈值传播
sub threshold_propagation {
my ($data, $threshold) = @_;
my $error_count = 0;
# 容忍一定数量的错误
step1($data) or $error_count++;
step2($data) or $error_count++;
step3($data) or $error_count++;
if ($error_count > $threshold) {
die "错误过多: $error_count 个错误";
}
return 1;
}
# ================= 错误传播框架 =================
package ErrorPropagator {
sub new {
my ($class, %args) = @_;
bless {
strategy => $args{strategy} || 'fail_fast',
threshold => $args{threshold} || 1,
logger => $args{logger},
}, $class;
}
sub execute {
my ($self, @operations) = @_;
if ($self->{strategy} eq 'fail_fast') {
return $self->_fail_fast(@operations);
}
elsif ($self->{strategy} eq 'collect') {
return $self->_collect_errors(@operations);
}
elsif ($self->{strategy} eq 'best_effort') {
return $self->_best_effort(@operations);
}
elsif ($self->{strategy} eq 'threshold') {
return $self->_threshold(@operations);
}
else {
die "未知策略: " . $self->{strategy};
}
}
sub _fail_fast {
my ($self, @operations) = @_;
my @results;
for my $op (@operations) {
push @results, $op->() or die "操作失败";
}
return \@results;
}
sub _collect_errors {
my ($self, @operations) = @_;
my @results;
my @errors;
for my $i (0..$#operations) {
my $result = eval { $operations[$i]->() };
if ($@) {
push @errors, "操作 $i 失败: $@";
push @results, undef;
} else {
push @results, $result;
}
}
if (@errors) {
die join("\n", @errors);
}
return \@results;
}
sub _best_effort {
my ($self, @operations) = @_;
my @results;
for my $op (@operations) {
my $result = eval { $op->() };
push @results, $result if defined $result;
}
return \@results;
}
sub _threshold {
my ($self, @operations) = @_;
my @results;
my $error_count = 0;
for my $op (@operations) {
my $result = eval { $op->() };
if ($@) {
$error_count++;
$self->{logger}->warn("操作失败: $@") if $self->{logger};
if ($error_count > $self->{threshold}) {
die "超过错误阈值: $error_count 个错误";
}
push @results, undef;
} else {
push @results, $result;
}
}
return \@results;
}
}
# 使用错误传播器
my $propagator = ErrorPropagator->new(
strategy => 'threshold',
threshold => 2,
logger => { warn => sub { say "警告: @_" } },
);
my $results = eval {
$propagator->execute(
sub { die "步骤1失败" },
sub { return "步骤2成功" },
sub { die "步骤3失败" },
sub { return "步骤4成功" },
);
};
if ($@) {
warn "执行失败: $@";
} else {
say "结果: " . Dumper($results);
}7. 📊 错误记录
7.1 日志记录系统
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use POSIX qw(strftime);
# ================= 简单日志器 =================
package SimpleLogger {
use constant {
DEBUG => 0,
INFO => 1,
WARN => 2,
ERROR => 3,
FATAL => 4,
};
my %LEVEL_NAMES = (
DEBUG() => 'DEBUG',
INFO() => 'INFO',
WARN() => 'WARN',
ERROR() => 'ERROR',
FATAL() => 'FATAL',
);
sub new {
my ($class, %args) = @_;
bless {
level => $args{level} || INFO,
file => $args{file} || \*STDERR,
format => $args{format} || '%t [%l] %m',
_handle => undef,
}, $class;
}
sub _open_file {
my $self = shift;
if (!ref $self->{file}) {
# 文件路径
open my $fh, '>>', $self->{file}
or die "无法打开日志文件: $!";
$self->{_handle} = $fh;
} elsif (ref $self->{file} eq 'GLOB') {
# 文件句柄
$self->{_handle} = $self->{file};
} else {
# 默认标准错误
$self->{_handle} = \*STDERR;
}
}
sub _format_message {
my ($self, $level, $message) = @_;
my $fmt = $self->{format};
$fmt =~ s/%t/strftime("%Y-%m-%d %H:%M:%S", localtime)/e;
$fmt =~ s/%l/$LEVEL_NAMES{$level}/e;
$fmt =~ s/%m/$message/;
$fmt =~ s/%%/%/g;
return $fmt . "\n";
}
sub _should_log {
my ($self, $level) = @_;
return $level >= $self->{level};
}
sub log {
my ($self, $level, $message) = @_;
return unless $self->_should_log($level);
$self->_open_file() unless $self->{_handle};
my $formatted = $self->_format_message($level, $message);
print { $self->{_handle} } $formatted;
}
sub debug { shift->log(DEBUG, @_) }
sub info { shift->log(INFO, @_) }
sub warn { shift->log(WARN, @_) }
sub error { shift->log(ERROR, @_) }
sub fatal { shift->log(FATAL, @_) }
sub DESTROY {
my $self = shift;
if ($self->{_handle} && $self->{_handle} ne \*STDERR) {
close $self->{_handle};
}
}
}
# ================= 错误处理器 =================
package ErrorHandler {
sub new {
my ($class, %args) = @_;
bless {
logger => $args{logger} || SimpleLogger->new(),
config => $args{config} || {},
}, $class;
}
sub handle_error {
my ($self, $error, %context) = @_;
my $level = $context{level} || 'ERROR';
my $message = $self->_format_error($error, %context);
# 记录日志
$self->{logger}->$level($message);
# 根据配置处理
if ($self->{config}{notify_admin} && $level eq 'FATAL') {
$self->_notify_admin($error, %context);
}
if ($self->{config}{exit_on_fatal} && $level eq 'FATAL') {
exit 1;
}
}
sub _format_error {
my ($self, $error, %context) = @_;
my $message = "错误: $error";
if (%context) {
$message .= "\n上下文:";
while (my ($key, $value) = each %context) {
$message .= "\n $key: $value";
}
}
if (my $stack_trace = $context{stack_trace}) {
$message .= "\n堆栈跟踪:\n$stack_trace";
}
return $message;
}
sub _notify_admin {
my ($self, $error, %context) = @_;
# 发送邮件、短信等通知
warn "通知管理员: $error";
}
}
# ================= 异常日志集成 =================
package Exception::Logged {
our @ISA = qw(Exception);
sub throw {
my ($class, $message, %attrs) = @_;
my $exception = $class->new($message, %attrs);
# 记录日志
if ($attrs{logger}) {
$attrs{logger}->error($exception->as_string);
}
# 发送通知
if ($attrs{notify}) {
$class->_notify($exception, %attrs);
}
die $exception;
}
sub _notify {
my ($class, $exception, %attrs) = @_;
my $notifier = $attrs{notifier} || sub {
my ($e, %args) = @_;
warn sprintf "通知: %s (级别: %s)",
$e->message, $args{level} || 'ERROR';
};
$notifier->($exception, level => $attrs{level} || 'ERROR');
}
}
# ================= 结构化日志 =================
package StructuredLogger {
use JSON;
sub new {
my ($class, %args) = @_;
bless {
level => $args{level} || 'INFO',
output => $args{output} || \*STDERR,
json => JSON->new->utf8->pretty(!$args{compact}),
}, $class;
}
sub log {
my ($self, $level, $data) = @_;
my %log_entry = (
timestamp => time,
level => $level,
%$data,
);
my $json = $self->{json}->encode(\%log_entry);
print { $self->{output} } $json . "\n";
}
sub debug { shift->log('DEBUG', @_) }
sub info { shift->log('INFO', @_) }
sub warn { shift->log('WARN', @_) }
sub error { shift->log('ERROR', @_) }
sub fatal { shift->log('FATAL', @_) }
}
# 使用结构化日志
my $structured_logger = StructuredLogger->new();
$structured_logger->error({
message => "数据库连接失败",
error => "Connection refused",
host => "localhost",
port => 5432,
attempt => 3,
backtrace => $@,
});
# ================= 上下文日志 =================
package ContextLogger {
sub new {
my ($class, %args) = @_;
bless {
logger => $args{logger} || SimpleLogger->new(),
context => $args{context} || {},
}, $class;
}
sub with_context {
my ($self, %new_context) = @_;
my %merged_context = (%{$self->{context}}, %new_context);
return bless {
logger => $self->{logger},
context => \%merged_context,
}, ref $self;
}
sub _add_context {
my ($self, $message) = @_;
if (%{$self->{context}}) {
$message .= " | " . join(" ",
map { "$_:$self->{context}{$_}" }
sort keys %{$self->{context}}
);
}
return $message;
}
sub debug { shift->_log('debug', @_) }
sub info { shift->_log('info', @_) }
sub warn { shift->_log('warn', @_) }
sub error { shift->_log('error', @_) }
sub fatal { shift->_log('fatal', @_) }
sub _log {
my ($self, $level, $message) = @_;
$message = $self->_add_context($message);
$self->{logger}->$level($message);
}
}
# 使用上下文日志
my $logger = ContextLogger->new();
my $request_logger = $logger->with_context(
request_id => "req-123",
user_id => 456,
);
$request_logger->info("开始处理请求");
$request_logger->with_context(stage => "validation")->debug("验证输入");
$request_logger->with_context(stage => "processing")->error("处理失败");
# ================= 错误统计 =================
package ErrorStats {
use Time::HiRes qw(time);
sub new {
my ($class) = @_;
bless {
errors => {},
start_time => time,
}, $class;
}
sub record_error {
my ($self, $type, $message) = @_;
my $now = time;
$self->{errors}{$type} ||= {
count => 0,
first => $now,
last => $now,
samples => [],
};
my $error = $self->{errors}{$type};
$error->{count}++;
$error->{last} = $now;
# 保留最近的样本
push @{$error->{samples}}, {
time => $now,
message => $message,
};
if (@{$error->{samples}} > 10) {
shift @{$error->{samples}};
}
}
sub get_stats {
my $self = shift;
my $now = time;
my $uptime = $now - $self->{start_time};
my %stats;
for my $type (keys %{$self->{errors}}) {
my $error = $self->{errors}{$type};
$stats{$type} = {
count => $error->{count},
rate => $error->{count} / $uptime,
first => scalar localtime $error->{first},
last => scalar localtime $error->{last},
recent => [@{$error->{samples}}],
};
}
return \%stats;
}
sub report {
my $self = shift;
my $stats = $self->get_stats;
say "错误统计报告:";
say "=" x 50;
for my $type (sort keys %$stats) {
my $s = $stats->{$type};
printf "类型: %s\n", $type;
printf " 次数: %d\n", $s->{count};
printf " 频率: %.2f/秒\n", $s->{rate};
printf " 首次: %s\n", $s->{first};
printf " 最近: %s\n", $s->{last};
if (@{$s->{recent}}) {
say " 最近错误:";
for my $error (@{$s->{recent}}) {
printf " [%s] %s\n",
scalar localtime $error->{time},
$error->{message};
}
}
say "";
}
}
}
# 使用错误统计
my $stats = ErrorStats->new();
sub monitored_operation {
my $code = shift;
try {
return $code->();
} catch {
my $error = $_;
$stats->record_error("operation", $error);
die $error;
};
}
# 记录一些错误
for (1..5) {
eval {
monitored_operation(sub {
die "模拟错误
❤️❤️❤️本人水平有限，如有纰漏，欢迎各位大佬评论批评指正！😄😄😄
💘💘💘如果觉得这篇文对你有帮助的话，也请给个点赞、收藏下吧，非常感谢!👍 👍 👍
🔥🔥🔥Stay Hungry Stay Foolish 道阻且长,行则将至,让我们一起加油吧！🌙🌙🌙
AtomGit 是由开放原子开源基金会联合 CSDN 等生态伙伴共同推出的新一代开源与人工智能协作平台。平台坚持“开放、中立、公益”的理念，把代码托管、模型共享、数据集托管、智能体开发体验和算力服务整合在一起，为开发者提供从开发、训练到部署的一站式体验。
更多推荐
6
0- 0
已为社区贡献210条内容
所有评论(0)