¿Cómo puedo enviar la salida de Perl a STDOUT y a una variable?

Question

Me gustaría enviar el resultado de un comando tanto a STDOUT como a una variable. Quiero combinar:

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

Tee es un paso en la dirección correcta, pero este lo envía a un archivo en lugar de a una variable. Supongo que podría leer el archivo, pero sería más sencillo hacerlo directamente allí.

Answer 1

¿Quieres Capture::Tiny

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

lo escribí para reemplazar Tee y otros 20 módulos que hacen algún tipo de captura, pero son deficientes en una forma u otra.

- xdg (también conocido como dagolden)

Answer 2

¿La salida a ambas transmisiones es simultánea?

Si no, usted podría hacer:

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

o de una versión más segura, que no implica la invocación de una subcapa, e imprime en la salida estándar de una línea a la vez:

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

Envíe la salida del módulo Tee al /dev/stdout (o /dev/fd/1).

Answer 4

Puede usar el módulo IO::String en select() STDOUT en una cadena y luego llamar al system() para ejecutar el comando. Puede recopilar la salida desde el controlador IO::String. Esto efectivamente hace lo que hace la sintaxis de backtick.

Así que se reúnen en tiempo real de salida del sistema, ejecute el comando system() de forma asíncrona a través fork() o algún otro medio y sondear el mango para las actualizaciones.

EDITAR: Por OP, resulta que este enfoque no funciona. select() no afecta a system() llamadas.

Además, IO::String se ha reemplazado con la nueva sintaxis open() ya que Perl 5.8 hace la misma función.

Answer 5

Tal vez mi respuesta aquí puede ayudarle a: How can I hook into Perl’s print?

Answer 6

Usted puede hacer esto a través de un archivo de manejar así. No es tan elegante como algunas soluciones, pero probablemente funcionaría. Algo a lo largo de las líneas de:

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

mi $ salida = sistema ("su comando | T/dev/tty");

¡Funcionó para mí!