Как я могу отправить вывод Perl как STDOUT, так и переменной?

Question

Я хотел бы отправить вывод команды как в STDOUT, так и в переменную. Я хочу объединить:

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

Tee - это шаг в правильном направлении, но он отправляет его в файл, а не в переменную. Думаю, я мог бы тогда прочитать файл, но было бы проще получить его прямо там.

Answer 1

Одновременный ли вывод на оба потока?

Если нет, вы можете сделать:

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

или для более безопасной версии, которая не требует вызова подоболочки и печатает в STDOUT строку за раз:

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 2

Вы хотите Capture :: Tiny

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

Я написал его, чтобы заменить Ти и еще около 20 других модулей, которые делают какие-то захваты, но так или иначе имеют недостатки.

- XDG (он же Даголден)

Answer 3

Возможно, мой ответ здесь поможет вам: Как я могу подключиться к печати Perl?

Answer 4

Вы также можете сделать это через дескриптор файла. Не так элегантно, как некоторые решения, но, скорее всего, это сработает. Что-то вроде:

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

Answer 5

Вы можете использовать модуль IO::String, чтобы select() STDOUT в строку, а затем вызвать system() для запуска команды. Вы можете получить выходные данные из дескриптора IO::String. Это эффективно делает то, что делает синтаксис backtick.

Таким образом, чтобы собрать вывод команды в реальном времени, выполните команду system() асинхронно с помощью fork() или каким-либо другим способом и опросите дескриптор на наличие обновлений.

РЕДАКТИРОВАТЬ: По ОП, оказывается, этот подход не работает. select() не влияет на system() звонки.

Кроме того, IO::String был заменен новым синтаксисом open() начиная с Perl 5.8, который выполняет ту же функцию.

Answer 6

my $ output = system ("ваша команда | tee / dev / tty");

работал для меня !!

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

Отправьте вывод из модуля Tee на /dev/stdout (или /dev/fd/1).