Salvando Manejadores de Fichero

Supongamos que queremos que la salida de una ejecución mediante system vaya a un cierto fichero. Una solución - independiente del sistema operativo - es re-abrir STDOUT a ese fichero y volverlo a poner a su antiguo valor después de la ejecución. Para ello debemos conservar el antiguo valor de STDOUT.

Copia de Manejadores

Se puede salvar un manejador de ficheros sin mas que pasárselo como segundo argumento a open prefijado de una secuencia de la forma ">&" (escritura) o "<&" (lectura).

El siguiente ejemplo muestra como este mecanismo es utilizado para redirigir temporalmente la salida estandar y restaurarla posteriormente:

lhp@nereida:~/Lperl/src/perl_networking/ch1$ cat -n redirect.pl
     1  #!/usr/bin/perl
     2  use strict;
     3
     4  print "Redirecting STDOUT\n";
     5  open (SAVEOUT,">&STDOUT");
     6  open (STDOUT,">test.txt") or die "Can't open test.txt: $!";
     7  print "STDOUT is redirected\n";
     8  system "date";
     9  open (STDOUT,">&SAVEOUT");
    10  print "STDOUT restored\n";

Vemos que en la salida estándar se produce la salida:

lhp@nereida:~/Lperl/src/perl_networking/ch1$ ./redirect.pl
Redirecting STDOUT
STDOUT restored

Y en el fichero test.txt queda:

lhp@nereida:~/Lperl/src/perl_networking/ch1$ cat test.txt
STDOUT is redirected
mar abr 18 13:16:45 WEST 2006

Atributos de la Copia

La siguiente sesión de comandos con el depurador muestra que la copia mantiene los atributos del original y no es afectado por los cambios a los que se someta al original:

  DB<1> open $f, ">&", STDOUT            # Salvamos STDOUT en $f
  DB<2> open STDOUT, "> /tmp/prueba.txt" # Redirigimos STDOUT
  DB<3> print STDOUT "Hola\n"            # /tmp/prueba.txt contiene "Hola\n"
  DB<4> print $f "Hola\n"                # Salida a STDOUT
Hola

  DB<5> !! cat /tmp/prueba.txt           # !! Permite ejecutar un comando shell
Hola
  DB<6> close(STDOUT)
  DB<8> print "Hola"
print() on closed filehandle STDOUT at (eval 11)
  DB<9> print $f "Hola\n"
Hola
  DB<10> print DB::OUT "Hola\n"
  Hola

Obsérvese el formato de llamada a open en la línea 1 con tres argumentos.

Nótese que el debugger usa su propio manejador de ficheros de salida DB::OUT que está asociado a la terminal (véase perldebug).

Duplicación de Manejadores con IO::File

Una alternativa a este sistema la provee el método fdopen en IO::Handle que permite reabrir un fichero existente, haciendo una copia en uno nuevo. Una llamada a este método sigue el formato:

$io->fdopen ( $FD, $MODE )

La variable $FD debe ser un objeto IO::Handle o un fichero normal o un descriptor numérico. El modo $MODE debe casar con el original de $FD. El manejador de IO $io pasa a tener una copia del manejador $FD.

En el siguiente ejemplo usamos el método en conjunción con new_from_fd (línea 6) el cual crea un IO::Handle que es una copia del argumento:

lhp@nereida:~/Lperl/src/perl_networking/ch1$ cat -n redirectIO.pl
     1  #!/usr/bin/perl
     2  use strict;
     3  use IO::File;
     4
     5  print "Redirecting STDOUT\n";
     6  my $SAVEOUT = IO::File->new_from_fd(\*STDOUT,">");
     7  open(STDOUT, ">test.txt") or die "Can't open test.txt: $!";
     8  print "STDOUT is redirected\n";
     9  system "date";
    10  STDOUT->fdopen($SAVEOUT, ">");
    11  print "STDOUT restored\n";

El efecto es el mismo:

lhp@nereida:~/Lperl/src/perl_networking/ch1$ ./redirectIO.pl
Redirecting STDOUT
STDOUT restored

y el fichero test.txt contiene:

lhp@nereida:~/Lperl/src/perl_networking/ch1$ cat test.txt
STDOUT is redirected
mar abr 18 13:40:14 WEST 2006
lhp@nereida:~/Lperl/src/perl_networking/ch1$

Salvando y Redirigiendo STDIN

El siguiente programa salva STDIN usando

open (SAVEIN,"<& STDIN");

a continuación se abre de nuevo STDIN a un cierto fichero para leer del mismo durante un cierto periodo (líneas 8-12). Por último se restaura STDIN y se pasa a leer desde teclado:

pp2@nereida:~/src/perl/perltesting$ cat -n redirectinput.pl 
 1  #!/usr/bin/perl -w
 2  use strict;
 3  
 4  print "Redirecting STDIN to file testin.txt\n";
 5  open (my $SAVEIN,"<& STDIN");
 6  open (STDIN,"<", "testin.txt") or die "Can't open testin.txt: $!";
 7  
 8  my $x = <STDIN>;
 9  chomp($x);
10  
11  print "STDIN was redirected. First line of testin.txt: <$x>. Now executing cat -n\n";
12  system "cat -n ";
13  
14  open (STDIN,"<&", $SAVEIN);
15  print "STDIN now restored. Write some input: ";
16  $x = <STDIN>;
17  chomp($x);
18  print "STDIN restored. We read: <$x>\n";

Estos son los contenidos del fichero testin.txt:

casiano@tonga:~/src/perl/tests$ cat -n testin.txt
     1  1
     2  2
     3  3
     4  4
     5  5
     6  6
     7  7
     8

Ejecución:

pp2@nereida:~/Lperltesting$ ./redirectinput.pl testin.txt 
Redirecting STDIN to file testin.txt
STDIN was redirected. First line of testin.txt: <1>. Now executing cat -n
     1  2
     2  3
     3  4
     4  5
     5  6
     6  7
     7  
STDIN now restored. Write some input: my input
STDIN restored. We read: <my input>
pp2@nereida:~/Lperltesting$

Mezclando STDOUT y STDERR

El siguiente programa redirectmergestdoutandstderr.pl redirecciona (de forma independiente del S.O.) STDOUT al fichero testmerge.txt. Después salva STDOUT en STDERR:

pp2@nereida:~/src/perl/perl_networking/ch1$ cat -n redirectmergestdoutandstderr.pl
 1  #!/usr/bin/perl
 2  use strict;
 3
 4  # redirect STDOUT
 5  open (STDOUT,">testmerge.txt") or die "Can't open test.txt: $!";
 6
 7  # merging STDOUT and STDERR
 8  open (my $saveerr,">&STDERR");
 9  open (STDERR,">&STDOUT");
10
11  print "STDOUT is redirected\n";
12  system "ls -l does.not.exists";
13
14  open (STDERR,">&", $saveerr);
15  print STDERR "STDERR restored\n";

A continuación se ejecutan sentencias y programa(s) que produzcen salida por ambos STDOUT y STDERR como:

print "STDOUT is redirected\n";
system "ls -l does.not.exists";

Se mezclan las salidas por STDERR y STDOUT:

pp2@nereida:~/src/perl/perl_networking/ch1$ ./redirectmergestdoutandstderr.pl
STDERR restored
pp2@nereida:~/src/perl/perl_networking/ch1$ cat -n testmerge.txt
1  STDOUT is redirected
2  ls: no se puede acceder a does.not.exists: No existe el fichero ó directorio
pp2@nereida:~/src/perl/perl_networking/ch1$