如何实时跨平台地将perl代码输出到STDOUT/STDERR和一个文件?
我需要将正常的Perl代码输出到屏幕上,同时输出到日志文件中。然而,问题是该工具的运行时间可能长达数小时。使用Capture::Tiny的tee意味着日志文件只会在脚本终止后写入,这不是很有用 为了使事情进一步复杂化,我需要从同一个进程捕获纯perl的输出,以及使用system()调用的进程的输出 最后,由于雇主的限制,它也需要在Win32上工作如何实时跨平台地将perl代码输出到STDOUT/STDERR和一个文件?,perl,stdout,tee,Perl,Stdout,Tee,我需要将正常的Perl代码输出到屏幕上,同时输出到日志文件中。然而,问题是该工具的运行时间可能长达数小时。使用Capture::Tiny的tee意味着日志文件只会在脚本终止后写入,这不是很有用 为了使事情进一步复杂化,我需要从同一个进程捕获纯perl的输出,以及使用system()调用的进程的输出 最后,由于雇主的限制,它也需要在Win32上工作 我还有什么其他选项?如果您的程序在Linux/Unix平台上运行,则可以使用命令。Tee读取stdin并写入stdout和指定文件 例如: mypro
我还有什么其他选项?如果您的程序在Linux/Unix平台上运行,则可以使用命令。Tee读取stdin并写入stdout和指定文件 例如:
myprogram.pl 2>&1 |tee mylog.txt
perl myprogram.pl 2>&1 |perl tee.pl mylog.txt
唯一需要注意的是,stdout和stderr将合并到同一个文件中
因为您是在Windows平台上,所以您可以,或者您可以尝试这个最简单的perl版本的tee:
$|=1;
if ( !$ARGV[0] ) {
print "Usage: some_command \| tee.pl [-a] logfile\n";
exit(1);
}
# Append mode
my $mode='>';
if ($ARGV[0] eq '-a')
{
$mode='>>';
shift;
}
my $LOGFILE=$ARGV[0];
while (<STDIN>) {
print;
open( OUT, "$mode $LOGFILE");
print OUT $_;
close OUT;
# Your logic here!
}
如果要进行系统调用,我会尽量避免修改源代码,只是为了越来越多地捕获STDOUT和/或STDERR
- 创建一个特殊的T形文件句柄
- 编辑你的程序。将所有对标准输出的打印更改为对此文件句柄的打印
- 需要时,重新定义tee filehandle以仅打印到标准输出,或打印到2个或更多文件
- 使用``而不是os system()捕获程序输出并将其打印到特殊的文件句柄
sub myPrint
{
print @_;
if ($LOGMODE)
{
open(LOGFILE, ">>$logfile");
print LOGFILE @_;
close LOGFILE;
}
}
使用
刚刚在草莓Perl 5.12.1 32位下测试了它,它工作得非常完美,因此它将是跨平台的。下面的代码完全符合您的预期。而且,由于它修改了实际的STDOUT和STDERR文件句柄,因此对它们的任何写入都将自动执行
use strict;
use warnings;
use IO::Handle;
use PerlIO::Util;
use 5.012;
for (*STDOUT, *STDERR) {
$_->autoflush; $_->push_layer(tee => ">>stdout.txt");
}
for (1..10) {
say $_;
warn $_ unless $_ % 2;
}
由于提出的解决方案都不令人满意,我坐下来自己解决了问题:
我不介意合并输出,但由于雇主的限制,它也需要在Win32上工作。我修改了答案。希望能有帮助。是的,这是一个选择,但这更像是最后的选择。我正在编写的脚本需要启动和捕获其他脚本,并围绕它们包装锁文件逻辑、错误捕获、电子邮件等。所有这些都需要放到一个日志文件中,Capture::Tiny做得很好。只是不是实时的。请澄清。您是否只需要捕获程序输出?那么tee就是你的朋友了。您需要实时日志处理器吗?也许你可以使用我的perl-tee并修改它来解析行。如果我不清楚,很抱歉。我有一个工具,它需要始终打印到屏幕上,并且如果其中的逻辑要求,它还需要能够开始将所有输出记录到一个文件中。这个输出可以来自工具本身,打印关于锁文件处理之类的调试信息,也可以来自system()调用它所做的任何事情。是的,我也尝试过这个,并且非常喜欢它。但是,如果您添加类似于
system('dir')这些都不是完整的解决方案,但它们为我指明了一条可行的道路。我将添加一个切换来切换日志记录的类型,并利用open(STDOUT,“>>logfile”)代码>或使用Capture::Tiny
作为合适的工具;因为似乎只有那些能够捕获system()。您能提供此代码的描述吗?仅仅发布350行代码并不是一个好的答案。我还注意到这是一个精确的复制品。还请确保您的答案解决了用户遇到的特定问题。谢谢。Ctrl+F,=head1 description您是否错过了我提到system()的部分,以及我已经发布了问题的正确解决方案的部分?$objLogger->LogInfoMsg(“Running$cmd:\n$cmd”)$objLogger->loginfomg($cmd 2>&1
);获得一项新技能的最好方法不是直接得到完整的答案,而是自己去发现它。这是可以的,只是谷歌的答案,并粘贴它,但下次你有一个新的问题,你将不得不搜索它,谷歌它再次。。。
package Logger ;
# docs at the end ...
# capture conditionally the output of the command
# $objLogger->LogDebugMsg ( "Running $cmd : \n $cmd " ) ;
# $objLogger->LogDebugMsg ( `$cmd 2>&1` ) ;
use lib '.' ; use strict ; use warnings ; use Carp qw(cluck);
our ( $MyBareName , $LibDir , $RunDir ) = () ;
BEGIN {
$RunDir = '' ;
$0 =~ m/^(.*)(\\|\/)(.*)\.([a-z]*)/;
$RunDir = $1 if defined $1 ;
push ( @INC , $RunDir) ;
#debug print join ( ' ' , @INC ) ;
} #eof sub
use Timer ; use FileHandler ;
# the hash holding the vars
our $confHolder = () ;
# ===============================================================
# START OO
# the constructor
sub new {
my $self = shift;
#get the has containing all the settings
$confHolder = ${ shift @_ } ;
# Set the defaults ...
Initialize () ;
return bless({}, $self);
} #eof new
BEGIN {
# strip the remote path and keep the bare name
$0=~m/^(.*)(\\|\/)(.*)\.([a-z]*)/;
my ( $MyBareName , $RunDir ) = () ;
$MyBareName = $3;
$RunDir= $1 ;
push ( @INC,$RunDir ) ;
} #eof BEGIN
sub AUTOLOAD {
my $self = shift ;
no strict 'refs';
my $name = our $AUTOLOAD;
*$AUTOLOAD = sub {
my $msg = "BOOM! BOOM! BOOM! \n RunTime Error !!!\nUndefined Function $name(@_)\n" ;
print "$self , $msg";
};
goto &$AUTOLOAD; # Restart the new routine.
}
sub DESTROY {
my $self = shift;
#debug print "the DESTRUCTOR is called \n" ;
return ;
}
END {
close(STDOUT) || die "can't close STDOUT: $! \n\n" ;
close(STDERR) || die "can't close STDERR: $! \n\n" ;
}
# STOP OO
# =============================================================================
sub Initialize {
$confHolder = { Foo => 'Bar' , } unless ( $confHolder ) ;
# if the log dir does not exist create it
my $LogDir = '' ;
$LogDir = $confHolder->{'LogDir'} ;
# create the log file in the current directory if it is not specified
unless ( defined ( $LogDir )) {
$LogDir = $RunDir ;
}
use File::Path qw(mkpath);
if( defined ($LogDir) && !-d "$LogDir" ) {
mkpath("$LogDir") ||
cluck ( " Cannot create the \$LogDir : $LogDir $! !!! " ) ;
}
# START set default value if value not specified =========================
# Full debugging ....
$confHolder->{'LogLevel'} = 4
unless ( defined ( $confHolder->{'LogLevel'} ) ) ;
$confHolder->{'PrintErrorMsgs'} = 1
unless ( defined ( $confHolder->{'PrintErrorMsgs'} ) ) ;
$confHolder->{'PrintDebugMsgs'} = 1
unless ( defined ($confHolder->{'PrintDebugMsgs'})) ;
$confHolder->{'PrintTraceMsgs'} = 1
unless ( defined ( $confHolder->{'PrintTraceMsgs'} )) ;
$confHolder->{'PrintWarningMsgs'} = 1
unless ( defined ( $confHolder->{'PrintWarningMsgs'} ) ) ;
$confHolder->{'LogMsgs'} = 1
unless ( defined ( $confHolder->{'LogMsgs'} ) ) ;
$confHolder->{'LogTimeToTextSeparator'} = '---'
unless ( defined ( $confHolder->{'LogTimeToTextSeparator'} ) ) ;
#
# STOP set default value if value not specified =========================
} #eof sub Initialize
# =============================================================================
# START functions
# logs an warning message
sub LogErrorMsg {
my $self = shift ;
my $msg = "@_" ;
my $msgType = "ERROR" ;
# Do not print anything if the PrintWarningMsgs = 0
return if ( $confHolder->{'LogMsgs'} == 0 ) ;
# Do not print anything if the PrintWarningMsgs = 0
return if ( $confHolder->{'PrintErrorMsgs'} == 0 ) ;
$self->LogMsg( $msgType , "$msg" ) if ( $confHolder->{'PrintErrorMsgs'} == 1 ) ;
} #eof sub
# logs an warning message
sub LogWarningMsg {
my $self = shift ;
my $msg = "@_" ;
my $msgType = 'WARNING' ;
# Do not print anything if the PrintWarningMsgs = 0
return if ( $confHolder->{'LogMsgs'} == 0 ) ;
# Do not print anything if the PrintWarningMsgs = 0
return if ( $confHolder->{'PrintWarningMsgs'} == 0 ) ;
$self->LogMsg( $msgType , "$msg" ) if ( $confHolder->{'PrintWarningMsgs'} == 1 ) ;
} #eof sub
# logs an info message
sub LogInfoMsg {
my $self = shift ;
my $msg = "@_" ;
my $msgType = 'INFO' ;
# Do not print anything if the PrintWarningMsgs = 0
return if ( $confHolder->{'LogMsgs'} == 0 ) ;
# Do not print anything if the PrintWarningMsgs = 0
return if ( $confHolder->{'PrintInfoMsgs'} == 0 ) ;
$self->LogMsg( $msgType , "$msg" ) if ( $confHolder->{'PrintInfoMsgs'} == 1 ) ;
} #eof sub
# logs an trace message
sub LogTraceMsg {
my $self = shift ;
my $msg = "@_" ;
my $msgType = 'TRACE' ;
my ($package, $filename, $line) = caller();
# Do not print anything if the PrintDebugMsgs = 0
return if ( $confHolder->{'PrintTraceMsgs'} == 0 ) ;
$msg = "$msg : FROM Package: $package FileName: $filename Line: $line " ;
# Do not print anything if the PrintWarningMsgs = 0
return if ( $confHolder->{'LogMsgs'} == 0 ) ;
# Do not print anything if the PrintWarningMsgs = 0
return if ( $confHolder->{'PrintTraceMsgs'} == 0 ) ;
$self->LogMsg( $msgType , "$msg" ) if ( $confHolder->{'PrintTraceMsgs'} == 1 ) ;
} #eof sub
# logs an Debug message
sub LogDebugMsg {
my $self = shift ;
my $msg = "@_" ;
my $msgType = 'DEBUG' ;
# Do not print anything if the PrintWarningMsgs = 0
return if ( $confHolder->{'LogMsgs'} == 0 ) ;
# Do not print anything if the PrintWarningMsgs = 0
return if ( $confHolder->{'PrintDebugMsgs'} == 0 ) ;
$self->LogMsg( $msgType , "$msg" ) if ( $confHolder->{'PrintDebugMsgs'} == 1 ) ;
} #eof sub
sub GetLogFile {
my $self = shift ;
#debug print "The log file is " . $confHolder->{ 'LogFile' } ;
my $LogFile = $confHolder->{ 'LogFile' } ;
#if the log file is not defined we create one
unless ( $confHolder->{ 'LogFile' } ) {
$LogFile = "$0.log" ;
}
return $LogFile ;
} #eof sub
sub BuildMsg {
my $self = shift ;
my $msgType = shift ;
my $objTimer= new Timer();
my $HumanReadableTime = $objTimer->GetHumanReadableTime();
my $LogTimeToTextSeparator = $confHolder->{'LogTimeToTextSeparator'} ;
my $msg = () ;
# PRINT TO STDOUT if
if ( $msgType eq 'WARNING'
|| $msgType eq 'INFO'
|| $msgType eq 'DEBUG'
|| $msgType eq 'TRACE' ) {
$msg = " $HumanReadableTime $LogTimeToTextSeparator $msgType : @_ \n" ;
}
elsif ( $msgType eq 'ERROR' ) {
$msg = " $HumanReadableTime $LogTimeToTextSeparator $msgType : @_ \n" ;
}
else {
$msg = " $HumanReadableTime $LogTimeToTextSeparator $msgType @_ \n" ;
}
return $msg ;
} #eof sub BuildMsg
sub LogMsg {
my $self = shift ;
my $msgType = shift ;
my $msg = $self->BuildMsg ( $msgType , @_ ) ;
my $LogFile = $self -> GetLogFile();
# Do not print anything if the LogLevel = 0
return if ( $confHolder->{'LogLevel'} == 0 ) ;
# PRINT TO STDOUT if
if (
$confHolder->{'PrintMsgs'} == 1
|| $confHolder->{'PrintInfoMsgs'} == 1
|| $confHolder->{'PrintDebugMsgs'} == 1
|| $confHolder->{'PrintTraceMsgs'} == 1
) {
print STDOUT $msg ;
}
elsif ( $confHolder->{'PrintErrorMsgs'} ) {
print STDERR $msg ;
}
if ( $confHolder->{'LogToFile'} == 1 ) {
my $LogFile = $self -> GetLogFile();
my $objFileHandler = new FileHandler();
$objFileHandler->AppendToFile( $LogFile , "$msg" );
} #eof if
#TODO: ADD DB LOGGING
} #eof LogMsg
# STOP functions
# =============================================================================
1;
__END__
=head1 NAME
Logger
=head1 SYNOPSIS
use Logger ;
=head1 DESCRIPTION
Provide a simple interface for dynamic logging. This is part of the bigger Morphus tool : google code morphus
Prints the following type of output :
2011.06.11-13:33:11 --- this is a simple message
2011.06.11-13:33:11 --- ERROR : This is an error message
2011.06.11-13:33:11 --- WARNING : This is a warning message
2011.06.11-13:33:11 --- INFO : This is a info message
2011.06.11-13:33:11 --- DEBUG : This is a debug message
2011.06.11-13:33:11 --- TRACE : This is a trace message : FROM Package: Morphus
FileName: E:\Perl\sfw\morphus\morphus.0.5.0.dev.ysg\sfw\perl\morphus.pl Line: 52
=head2 EXPORT
=head1 SEE ALSO
perldoc perlvars
No mailing list for this module
=head1 AUTHOR
yordan.georgiev@gmail.com
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2011 Yordan Georgiev
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.1 or,
at your option, any later version of Perl 5 you may have available.
VersionHistory:
1.4.0 --- 2011.06.11 --- ysg --- Separated actions of building and printing msgs. Total refactoring. Beta .
1.3.0 --- 2011.06.09 --- ysg --- Added Initialize
1.2.0 --- 2011.06.07 --- ysg --- Added LogInfoErrorMsg print both to all possible
1.1.4 --- ysg --- added default values if conf values are not set
1.0.0 --- ysg --- Create basic methods
1.0.0 --- ysg --- Stolen shamelessly from several places of the Perl monks ...
=cut