我在 perl 脚本中重定向 STDOUT 和 STDERR：
open STDOUT, '>', $logfile or die "Can't redirect STDOUT: $!";
open STDERR, ">&STDOUT" or die "Can't dup for STDERR: $!";
在...之前和之后保存和恢复文件句柄
问题是，如果程序没有输出，我最终会得到一个大小为 0 的文件，但我想根本没有文件。如果不手动检查和删除文件，我该如何做到这一点？
谢谢！
【问题讨论】：
标签： perl file-io io-redirection
您可以将 STDOUT 绑定到一个延迟打开目标文件直到第一次写入句柄的类：
package FastidiousHandle;
use Tie::StdHandle;
use strict;
our @ISA = 'Tie::StdHandle';
sub TIEHANDLE {
my ($class, @args) = @_;
my $self = $class->SUPER::TIEHANDLE;
${*$self}{openargs} = \@args;
return $self;
}
sub WRITE {
my $self = shift;
my $openargs = delete ${*$self}{openargs};
$self->OPEN(@$openargs) if $openargs;
$self->SUPER::WRITE(@_);
}
1;
然后在你的主程序中，你会说：
tie *STDOUT, 'FastidiousHandle', '>', $path;
my $saved_stderr = *STDERR;
*STDERR = *STDOUT;
要恢复以前的句柄，你会说：
*STDERR = $saved_stderr;
untie *STDOUT;
【讨论】：
检查最后是否有任何内容，如果没有，请删除文件。确保您开启了自动刷新功能。
use IO::Handle;
...
open STDOUT, '>', $logfile or die "Can't redirect STDOUT: $!";
open STDERR, ">&STDOUT" or die "Can't dup for STDERR: $!";
STDOUT->autoflush(1);
STDERR->autoflush(1);
...
END {
unlink $logfile if -z $logfile;
}
或者旧式的……
open STDOUT, '>', $logfile or die "Can't redirect STDOUT: $!";
open STDERR, ">&STDOUT" or die "Can't dup for STDERR: $!";
select(STDERR); $|=1; select(STDOUT); $|=1;
END {
unlink $logfile if -z $logfile;
}
【讨论】：
我能想到的唯一方法是分叉一个子进程，该子进程通过管道发回所有内容（想想 IO::Pipe 或类似 IPC::Open2 的东西 - 无论哪种方式，您仍然将 STDERR 重定向到子进程中的 STDOUT） ，然后在父级中，将您在管道中获得的内容写入日志文件 - 这允许您在第一次有数据时打开日志文件。例如：
#!/usr/bin/perl
use Proc::Fork;
use IO::Pipe;
sub pipe_to_logfile
{
my $log = shift;
my @cmd = @_;
my $pipe = IO::Pipe->new();
run_fork {
child {
$pipe->writer();
open STDOUT, '>&', $pipe or die "Can't redirect STDOUT: $!";
open STDERR, '>&STDOUT' or die "Can't redirect STDERR: $!";
exec(@cmd);
}
parent {
$pipe->reader();
my $fh;
while(<$pipe>)
{
unless ($fh)
{
open $fh, '>', $log or die "Can't write to $log: $!";
}
print $fh $_;
}
}
}
}
pipe_to_logfile('/tmp/true.out', 'true');
pipe_to_logfile('/tmp/ls.out', qw(ls /));
当我运行它时，我得到：
$ ls /tmp/*.out
ls: cannot access /tmp/*.out: No such file or directory
$ cd tmp
$ perl foo.pl
$ ls /tmp/*.out
/tmp/ls.out
希望对您有所帮助。
【讨论】：
您不想延迟打开文件，如果您确实延迟打开任何问题，例如权限错误或文件路径中缺少目录，都会导致程序在第一个打印语句处失败。鉴于听起来您可能运行的程序永远不会打印任何内容，您可能会在未来某个随机时间遇到程序失败，因为它恰好打印到一个几个月都无法打开的文件。到那时，您或您的继任者可能已经忘记了这个功能曾经存在过。
最好在完成后检查文件以查看它是否为空，如果是则将其删除。 如果你想为你做，你可以将逻辑包装在一个类中。
package My::File;
use strict;
use warnings;
use base qw(IO::File);
sub new {
my ($class, $file, @args) = @_;
my $self = $class->SUPER::new($file, @args);
if ($self) {
*{$self}->{file} = $file;
}
return $self;
}
sub DESTROY {
local $@;
my ($self) = @_;
$self->flush;
if (-e *{$self}->{file} && -z *{$self}->{file}) {
unlink *{$self}->{file};
}
return;
}
package main;
my $fh1 = My::File->new("file_1", "w");
my $fh2 = My::File->new("file_2", "w");
print $fh1 "This file should stay\n";
这段代码并没有真正准备好生产，它不会尝试处理可以调用IO::File->new() 的所有方式，它还应该以与new 类似的方式覆盖对$file_obj->open() 的调用。它还可以更好地处理错误。
【讨论】：