首页 文章

Perl:将STDERR重定向到文件而不创建空文件?

提问于
浏览
3

我正在使用perl脚本重定向STDOUT和STDERR:

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

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

事情是,如果程序没有输出,我最终得到一个0号文件,但我想根本没有文件 . 如果不手动检查和删除文件,我怎么能这样做?

谢谢!

4 回答

  • 0

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

    如果已写入任何内容,请在结尾处检查,如果没有,请删除该文件 . 确保你有autoflush .

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

    我能想到的唯一方法就是分叉一个子进程,它通过管道发回一切(想想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
    

    希望有所帮助 .

  • 5

    您不希望延迟打开文件,如果您确实延迟打开任何问题,如权限错误,或文件路径中缺少目录将导致程序在第一个print语句失败 . 鉴于你可能有程序运行永远不会打印任何东西,你可能会面临你的程序在未来的某个随机时间失败,因为它恰好打印到一个无法打开几个月的文件 . 到那时,你或者你的继任者可能已经忘记了这个功能曾经存在过 .

    完成后检查文件以查看它是否为空并将其删除(如果是的话)会好得多 . 如果要为您执行此操作,可以将逻辑包装在类中 .

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

    此代码不是't really production ready, it doesn' t尝试处理 IO::File->new() 可以被调用的所有方式,它还应该以与 new 类似的方式覆盖对 $file_obj->open() 的调用 . 它也可以用更好的错误处理 .

相关问题