用于将 stdout 和 stderr 管道传输到文件中的子程序

Question

如果我有一个名为simplecalc.pl的程序：

use v5.10; 
use warnings;
use strict;

# SIMPLE CALCULATOR
# Usage: simplecalc.pl <n1> <n2> [<verbose> <logswitch>]
# Example Usage:
# normal usage      : simplecalc.pl 4 2  
# verbose usage     : simplecalc.pl 4 2 1
# support-case usage: simplecalc.pl 4 2 0 1

my($OK,$UNKNOWN)=(0,3);
my($filename, $endmsg, $exit) = ('my.log', undef, undef);
my($n1, $n2, $DEBUG, $GET_SUPPORT_FILE) = @ARGV;

# Handling of the support-file starts here ===============================
*ORIGINAL_STDOUT = *STDOUT;

if ($GET_SUPPORT_FILE) {
    $DEBUG = 1;
    $endmsg = "support-info sucessfully written into $filename";
    $exit = $UNKNOWN;
    # redirect stdout and stderr
    open my $stdout_txt, '>>:utf8', "$filename";
    *STDOUT = $stdout_txt;
    open STDERR, '>&STDOUT';
} else {
    $endmsg = "Finnished calculation - good bye.";
    $exit = $OK;
}

END {
    select *ORIGINAL_STDOUT;
    say $endmsg;
};
# end of support-file handling ============================================


say STDERR "INFO: got $n1 and $n2 from the commandline" if $DEBUG;
say "Hello, let me calc the quotient from $n1 trough $n2 for you ...";
my $quotient = $n1 / $n2;
say "Quotient: $quotient";

exit $exit;

有没有办法将支持文件的冗长处理以可重用的方式放入模块中？ （支持文件是由用户发送给程序维护者的。）

注意：上述解决方案也适用于simplecalc.pl 4 0 0 1，这会导致除法槽 0。在主程序使用的任何模块中捕获die 并将 die-msg 写入支持文件是很重要的功能。

Answer 1

我猜您正在寻找select，它会更改print 和say 中的默认文件处理程序。还有END，它在程序结束之前运行。

use v5.10; use warnings; use strict;
my($OK,$UNKNOWN)=(1,0);

my($filename, $endmsg, $exit) = ('my.log', 'OK', $OK);
END { say $endmsg }
my $DEFAULT_FH=select;  #select returns current default file handler (often STDOUT)
if( rand()<0.5){        #half the time, for test
    open my $FH, '>>:utf8', $filename or die; #append
    $endmsg = qq{support-info successfully written into $filename};
    $exit = $UNKNOWN;
    select $FH;
}

print "print something\n";
say   "say something more"; #same as print except \n is added

if(1){
    select $DEFAULT_FH;     #or just:  select STDOUT
}
exit $exit;

Answer 2

我的问题是想要控制来自模块的两个流的重定向。

类似这个基本示例？

RedirectStreams.pm

package RedirectStreams;

use warnings;
use strict;

use Exporter qw(import);
our @EXPORT_OK = qw(redirect_streams restore_streams);

our ($stdout, $stderr) = (*STDOUT, *STDERR);

sub redirect_streams {
    my ($handle) = @_;
    *STDOUT = $handle;
    *STDERR = $handle;
}

sub restore_streams {
    *STDOUT = $stdout;
    *STDERR = $stderr;
}

1;

ma​​in.pl

use warnings;
use strict;

use RedirectStreams qw(redirect_streams restore_streams);

my $logfile = shift @ARGV  || 'streams.log';

say "Hello from ", __PACKAGE__;            
warn "WARN from ", __PACKAGE__;

open my $fh, '>', $logfile;
    
redirect_streams($fh);

say "\tHi to redirected";
warn "\tWARN to redirected";

restore_streams();
    
say  "Hi to STDOUT again";
warn "WARN in main again";

open my $fh_other, '>', 'other_' . $logfile;
redirect_streams($fh_other);
say  "STDOUT redirected to another";
warn "STDERR redirected to another";

close $_ for $fh, $fh_other;

控制台上的输出是（对齐的）

来自主要的你好 在 ... 第 18 行的主要警告。 再次向 STDOUT 致敬 在 ... 第 29 行再次在 main 中发出警告。

而文件streams.log 有

你好重定向 警告重定向到 ... 第 24 行。

和other_streams.log 有两行。 （如果他们在控制台上结束，标签很容易发现。）

在这个例子中管理文件句柄的责任在于调用者。

这应该通过各种错误检查、subs 中的选项（仅重定向一个流，或每个流到其自己的文件等）以及可能更多的便利例程来完成。

---

请注意，our $stdout = *STDOUT 创建了一个别名。

另一种保留STDOUT 以供以后恢复的方法是duplicate it，

open my $stdout, '>&', STDOUT;

这将创建一个独立的文件句柄，作为 STDOUT 的副本（我们需要的只是这里），它不受 STDOUT 的更改（或关闭）的影响。使用示例见this post。