Làm cách nào để gửi đầu ra Perl tới cả STDOUT lẫn biến?

Question

Tôi muốn gửi đầu ra từ lệnh tới cả STDOUT và tới một biến. Tôi muốn kết hợp:

my $var = `some command` ; 
system('some command') ; 

Tee là một bước đi đúng hướng nhưng điều này gửi nó đến tệp chứ không phải biến. Tôi đoán tôi có thể đọc tập tin nhưng nó sẽ đơn giản hơn để đưa nó thẳng đến đó.

Answer 1

Bạn muốn Capture::Tiny

use Capture::Tiny 'tee'; 
my $output = tee { system("some command") }; 

tôi đã viết nó để thay thế Tee và khoảng 20 module khác mà làm một số loại chụp nhưng thiếu sót trong cách này hay cách khác.

- xdg (aka dagolden)

Answer 2

Đầu ra cho cả hai luồng có đồng thời không?

Nếu không, bạn có thể làm:

my $var = 'cmd' 
my $output = `$cmd` 
print STDOUT $output 

hoặc cho một phiên bản an toàn hơn, mà không liên quan đến cách gọi một subshell, và in để stdout một dòng tại một thời điểm:

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

Answer 3

Gửi đầu ra từ mô-đun Tee đến /dev/stdout (hoặc /dev/fd/1).

Answer 4

Bạn có thể sử dụng mô-đun IO::String để select() STDOUT vào chuỗi và sau đó gọi system() để chạy lệnh. Bạn có thể thu thập đầu ra từ tay cầm IO::String. Điều này có hiệu quả làm những gì cú pháp backtick nào.

Vì vậy, để thu thập thời gian thực của lệnh đầu ra, hãy chạy lệnh system() không đồng bộ thông qua fork() hoặc một số phương tiện khác và thăm dò ý kiến ​​để biết cập nhật.

EDIT: Theo OP, hóa ra phương pháp này không hoạt động. select() không ảnh hưởng đến các cuộc gọi system().

Ngoài ra, IO::String đã được thay thế bằng cú pháp mới open() vì Perl 5.8 thực hiện cùng chức năng.

Answer 5

Có lẽ câu trả lời của tôi ở đây có thể giúp bạn: How can I hook into Perl’s print?

Answer 6

Bạn có thể làm điều này thông qua một tập tin xử lý là tốt. Không thanh lịch như một số giải pháp, nhưng nó có khả năng sẽ hoạt động. Một cái gì đó dọc theo dòng:

my $foo; 
open(READ, "env ps |"); 
while (<READ>) { 
    print; 
    $foo .= $_; 
} 
print $foo; 
close(READ); 

Answer 7

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 

    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 

Answer 8

của tôi $ output = hệ thống ("bạn lệnh | tee/dev/tty");

Làm việc cho tôi !!