Perl: перенаправить STDERR в файл, не создавая пустой файл? - PullRequest
Новая
       29

Perl: перенаправить STDERR в файл, не создавая пустой файл?

3 голосов
/ 19 апреля 2011

Я перенаправляю STDOUT и STDERR в Perl-скрипте с: 

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

сохранением и восстановлением файловых дескрипторов до и после ...

Дело в том, если нет выводаиз программы я получаю файл размером 0, но я бы вообще не хотел иметь файл.Как это сделать, не прибегая к проверке и удалению файла вручную?

Спасибо!

Ответы [ 4 ]

5 голосов
/ 19 апреля 2011

Вы можете привязать 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 голосов
/ 19 апреля 2011

Просто проверьте в конце, написано ли что-нибудь, и если нет, удалите файл. Убедитесь, что вы включили автозапуск. 

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 голосов
/ 19 апреля 2011

Вы не хотите откладывать открытие файла, если вы откладываете открытие любых проблем, таких как ошибка разрешения, или отсутствующий каталог в пути к файлу приведет к сбою программы при первом операторе печати.Принимая во внимание тот факт, что у вас могут быть запуски программ, которые никогда не будут печатать что-либо, что вы, вероятно, столкнетесь с ошибкой вашей программы в какое-то случайное время в будущем, потому что она просто выполнила печать в файл, который не мог открыться месяцами.К тому времени вы или ваш преемник, возможно, уже забыли, что эта функция когда-либо существовала.

Гораздо лучше проверить файл после того, как вы сделали, чтобы убедиться, что он пуст, и удалить его, если он есть.Вы можете заключить логику в класс, если хотите сделать это за вас. 

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()call, и он также должен переопределять вызовы на $file_obj->open() аналогично new.Это также можно сделать с лучшей обработкой ошибок.

0 голосов
/ 19 апреля 2011

Единственный способ, о котором я могу подумать, - это отключить подпроцесс, который отправляет все обратно по каналу (подумайте, 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

Надеюсь, это поможет.

...