Perl：将 STDERR 重定向到文件而不创建空文件？

Question

我在 perl 脚本中重定向 STDOUT 和 STDERR ，方法是：

open STDOUT, '>', $logfile or die "Can't redirect STDOUT: $!";
open STDERR, ">&STDOUT" or die "Can't dup for STDERR: $!";

保存和恢复之前和之后的文件句柄...

事情是，如果程序没有输出，我最终会得到一个大小为 0 的文件，但我希望有根本没有文件。如何在不手动检查和删除文件的情况下做到这一点？

谢谢！

Answer 1

您可以将 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;

Answer 2

只需检查最后是否写入了任何内容，如果没有，则删除该文件。确保您已打开自动冲洗功能。

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;
}

Answer 3

我能想到的唯一方法是分叉一个子进程，该子进程通过管道发送回所有内容（想想 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

希望有帮助。

Answer 4

您不想延迟打开文件，如果确实延迟打开，任何问题（例如权限错误或文件路径中缺少目录）都会导致程序在第一个打印语句处失败。鉴于听起来您的程序运行可能永远不会打印任何内容，您可能会在未来的某个随机时间面临程序失败，因为它恰好打印到几个月内无法打开的文件。到那时，您或您的继任者可能已经忘记了此功能的存在。

最好在完成后检查该文件，看看它是否为空，如果是则将其删除。
如果您想为您执行此操作，可以将逻辑包装在一个类中。

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() 的所有方式，并且它还应该覆盖对 的调用$file_obj->open() 的方式与 new 类似。它还可以提供更好的错误处理。