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

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

#!/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()