Question

我有一个函数（字符串++的变体）：

sub inc
{
  $_[0] =~ /^(.*?)([0-9]+)$/;
  my ($a,$b)=($1,$2);
  die "cannot increment [$_[0]]" unless defined $b;
  warn "increment overflow [$_[0]]" if length(++$b) != length($2);
  $a.$b;
}

在脚本的许多地方，在不同的数据（有时来自文件，有时来自数据库）中调用它。

当我从文件句柄中读取时，die和warn会打印如下消息：

cannot increment [abc] at script line 5, <filehandle> line 123.

否则会打印一条较短的信息：

cannot increment [abc] at script line 5.

当我从数据库中读取数据时，我希望得到如下消息：

cannot increment [abc] at script line 5, <SELECT...> line 123.

有可能吗？

设置行号非常简单：可以对$.进行分配。但是如何设置'文件句柄'部分并使其可见？

我找到了这样的解决方法：

my $fh = "SELECT...";
open $fh, "/dev/null";
<$fh>;

但它有点长，它确实打开了一个文件。

Answer 1

仅在调用warn，die，<HANDLE>，readline后设置tell和eof消息中显示的文件句柄信息和seek。例如，当您使用DBI从数据库中获取数据时，您并未调用其中任何一项数据，因此您必须自己传递额外数据。

执行此操作的一种方法是编写一个自定义异常类，该类将字符串化为所需的文本：

package MyException;

use strict;
use warnings 'all';
use v5.18.0;

use overload '""' => \&as_string;

sub new {
    my ($self, $message, $src, $src_line) = @_;
    my ($package, $file, $line) = caller;

    if (! defined $src && ref ${^LAST_FH} eq 'GLOB') {
        $src = *${^LAST_FH}{NAME};
        $src_line = $.;
    }

    bless { message  => $message,
            file     => $file,
            line     => $line,
            src      => $src,
            src_line => $src_line }, $self;
}

sub as_string {
    my ($self) = @_;

    my $message = "$self->{message} at $self->{file} line $self->{line}";

    if (defined $self->{src} && defined $self->{src_line}) {
        $message .= ", <$self->{src}> line $self->{src_line}";
    }

    $message .= "\n";
}

1;

请注意，Perl 5.18.0或更高版本需要使用只读${^LAST_FH}变量，该变量包含对最后一个读取文件句柄的引用。

以下是从文件中读取时如何使用它：

use strict;
use warnings 'all';

use MyException;

while (<DATA>) {
    warn MyException->new('foo'); # equivalent to warn 'foo'
}

__DATA__
first
second

输出：

foo at ./myscript line 9, <DATA> line 1
foo at ./myscript line 9, <DATA> line 2

以下是从数据库中提取记录时如何使用它：

use strict;
use warnings 'all';

use DBI;
use MyException;

my $dbh = DBI->connect('dbi:mysql:test', 'user', 'pass', {
    RaiseError => 1
});

my $sql = 'SELECT * FROM test';
my $sth = $dbh->prepare($sql);
$sth->execute;

my $count;
while (my $row = $sth->fetch) {
    warn MyException->new('foo', $sql, ++$count);
}

输出：

foo at ./myscript line 19, <SELECT * FROM test> line 1
foo at ./myscript line 19, <SELECT * FROM test> line 2

（不幸的是，DBI没有提供一种方法来获取到目前为止已经获取的行数，所以你必须自己计算它们。）

由于你在子程序中尝试warn或die，你必须做更多的工作。 die最简单的方法是使用eval捕获子例程中的异常并重新抛出它们：

my $count = 1;
while (my $row = $sth->fetch) {
    eval {
        inc($row[0]);
    };

    if ($@ =~ /^(cannot increment \[.*?\])/) {
        die MyException->new($1, $sql, $count);
    }
    elsif ($@) {
        die $@;
    }

    $count++;
}

您可以通过创建__WARN__处理程序以类似的方式处理警告：

{
    my $count = 1;

    local $SIG{__WARN__} = sub {
        if ($_[0] =~ /^(increment overflow \[.*?\])/) {
            warn MyException->new($1, $sql, $count);
        }
        else {
            warn @_;
        }
    };

    while (my $row = $sth->fetch) {
        inc($row[0]);
        $count++;
    }
}

Answer 2

您可能更喜欢inc子例程的此实现。您自己使用保留变量$a和$b，以及保存和检索字符串的初始非数字部分

请注意，STDERR输出与STDOUT不同步，因此警告会在聚合文本中过早显示。实际上，仅当传递的字符串具有全九个数字字段

时才会发出警告

use strict;
use warnings 'all';

my $s = 'ZZ90';

for ( 1 .. 20 ) {
    $s = inc_str($s);
    print $s, "\n";
}

sub inc_str {

    my ($str) = @_;

    $str =~ s{([0-9]+)$}{
        my $num = $1;
        warn "Increment overflow [$str]"  unless $num =~ /[^9]/;
        sprintf '%0*d', length($num), $num+1;
    }e or die "Cannot increment [$str]";

    return $str;
}

输出

Increment overflow [ZZ99] at E:\Perl\source\inc_str.pl line 18.
ZZ91
ZZ92
ZZ93
ZZ94
ZZ95
ZZ96
ZZ97
ZZ98
ZZ99
ZZ100
ZZ101
ZZ102
ZZ103
ZZ104
ZZ105
ZZ106
ZZ107
ZZ108
ZZ109
ZZ110

perl：如何让'警告'认为我们从文件中读取？

2 个答案:

输出