コマンドからの出力をSTDOUTと変数の両方に送信したいと思います。私は、結合したい:どのようにしてPerlの出力をSTDOUTと変数の両方に送ることができますか?
my $var = `some command` ;
system('some command') ;
Teeは正しい方向への一歩であるが、これはファイルにではなく、変数に送信します。私はファイルを読むことができたと思うが、それをまっすぐにする方が簡単だろう。
コマンドからの出力をSTDOUTと変数の両方に送信したいと思います。私は、結合したい:どのようにしてPerlの出力をSTDOUTと変数の両方に送ることができますか?
my $var = `some command` ;
system('some command') ;
Teeは正しい方向への一歩であるが、これはファイルにではなく、変数に送信します。私はファイルを読むことができたと思うが、それをまっすぐにする方が簡単だろう。
あなたは私がTシャツやキャプチャのいくつかの並べ替えを行うが、一つの方法または別の欠陥は約20他のモジュールを交換するためにそれを書いたCapture::Tiny
use Capture::Tiny 'tee';
my $output = tee { system("some command") };
をしたいです。
- のxdg(別名dagolden)
両方のストリームへの出力が同時に行われていますか?
ない場合は、行うことができます:
sub backtick(@)
{
my $pid = open(KID, '-|');
die "fork: $!" unless defined($pid);
if ($pid) {
my $output;
while (<KID>) {
print STDOUT $_;
$output .= $_; # could be improved...
}
close(KID);
return $output;
} else {
exec @_;
}
}
my @cmd = ('/bin/ls', '-l');
my $output = backtick(@cmd);
はい - 私はSTDOUTへのhte出力を擬似的にすることをお勧めします。かなり長いかもしれないし、ユーザーに何か起こっているような暖かい感触を与えるでしょう。 – justintime
OK、最新の編集ではありますが、ラインバッファされています。 – Alnitak
あなたは 'my $ pid = open(KID、 ' - |');とこれについての詳細を話すことができますか? – gbtimmon
:
my $var = 'cmd'
my $output = `$cmd`
print STDOUT $output
またはサブシェルを呼び出す必要としない、とプリントが一度に行を標準出力に安全なバージョン、について
Teeモジュールからの出力を/dev/stdout
(または
/dev/fd/1
)に送信します。
これは、ターゲットOSにそのようなものが存在することを前提としています。 –
さて、はい、それはその仮定を行い、o/sがそれをサポートしていなければ、いいえ、この答えは当てはまりません。しかし、/ dev/stdout機能が利用できる場合、Teeを適用するのは簡単です。 –
IO::String
モジュールからselect()
STDOUTを文字列に使用し、system()
を呼び出してコマンドを実行できます。 IO::String
ハンドルから出力を収集することができます。これは効果的にバックティック構文がすることを行います。
コマンド出力をリアルタイムで収集するには、コマンドをfork()
などの手段で非同期で実行し、更新のためにハンドルをポーリングします。
EDIT:OPごとに、このアプローチは機能しません。 select()
は、system()
コールには影響しません。
また、同じ機能を果たすPerl 5.8以降、IO::String
は新しいopen()
という構文に置き換えられました。
perl 5.8以降では、open(my $ fh、 ">" \ my $変数)や "Err:$!"などの変数に直接FHを開くことができます。 IO :: String(またはIO :: Scalarなど)の必要がなくなりました – runrig
毎日新しいことを学んでください... – spoulson
選択は「システム」からの出力をリダイレクトしないようです。 – justintime
おそらくここに私の答えはあなたを助けることができる:How can I hook into Perl’s print?
私は、出力を行っているPerlではない、それは子プロセスです。 – Alnitak
あなたにもファイルハンドルを介してこれを行うことができます。いくつかのソリューションほどエレガントではありませんが、うまくいくでしょう。線に沿って何か:
my $foo;
open(READ, "env ps |");
while (<READ>) {
print;
$foo .= $_;
}
print $foo;
close(READ);
package Logger ;
# docs at the end ...
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
[email protected]
=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
私の$出力=システム( "あなたのコマンド| Tシャツは/ dev/ttyの");
私のために働いた!
私は、Teeの限界を克服するためにCapture :: Tinyを書きました。例については、私の返答を参照してください。 – xdg