Perl: éviter la lecture gourmande de stdin?

Question

Tenir compte le script perl suivant (read.pl):

my $line = <STDIN>; 
print "Perl read: $line"; 
print "And here's what cat gets: ", `cat -`; 

Si ce script est exécuté à partir de la ligne de commande, il obtiendra la première ligne d'entrée, tandis que cat obtient tout le reste jusqu'à la fin de l'entrée (^D est pressé).

Cependant, les choses sont différentes lorsque l'entrée est canalisé d'un autre processus ou de lecture d'un fichier:

$ echo "foo\nbar" | ./read.pl 
Perl read: foo 
And here's what cat gets: 

Perl semble tampon greadily quelque part l'entrée entière, et les processus appelés en utilisant les backticks ou système ne pas voir aucune de l'entrée.

Le problème est que je voudrais tester un module qui mélange <STDIN> et les appels à d'autres processus. Quelle serait la meilleure façon de faire cela? Puis-je désactiver la mise en mémoire tampon d'entrée dans Perl? Ou est-ce que je peux spouler les données d'une manière qui "imitera" un terminal?

Answer 1

Aujourd'hui, je pense que je « ai trouvé ce que je avais besoin: Perl dispose d'un module appelé Expect qui est parfait pour de telles situations:

#!/usr/bin/perl 

use strict; 
use warnings; 

use Expect; 

my $exp = Expect->spawn('./read.pl'); 
$exp->send("First Line\n"); 
$exp->send("Second Line\n"); 
$exp->send("Third Line\n"); 
$exp->soft_close(); 

Fonctionne comme un charme;)

Answer 2

est ici un sous-optimal façon que je l'ai trouvé:

use IPC::Run; 

my $input = "First Line\n"; 
my $output; 
my $process = IPC::Run::start(['./read.pl'], \$input, \$output); 
$process->pump() until $output =~ /Perl read:/; 
$input .= "Second Line\n"; 
$process->finish(); 
print $output; 

Il est sous-optimal dans le sens où l'on a besoin de connaître le « prompt » que le programme émet avant d'attendre plus d'entrée.

Une autre solution sous-optimale est la suivante:

use IPC::Run; 

my $input = "First Line\n"; 
my $output; 
my $process = IPC::Run::start(['./read.pl'], \$input, my $timer = IPC::Run::timer(1)); 
$process->pump() until $timer->is_expired(); 
$timer->start(1); 
$input .= "Second Line\n"; 
$process->finish(); 

Il ne nécessite pas connaissance d'une rapide, mais est lente, car elle attend au moins deux secondes. De plus, je ne comprends pas pourquoi la seconde minuterie est nécessaire (la finition ne reviendra pas autrement).

Est-ce que quelqu'un connaît de meilleures solutions?

Answer 3

Ce n'est pas un problème Perl. C'est un problème UNIX/shell. Lorsque vous exécutez une commande sans canaux, vous êtes en mode de mise en mémoire tampon, mais lorsque vous redirigez avec des canaux, vous êtes en mode de mise en mémoire tampon. Vous pouvez voir cela en disant:

cat /usr/share/dict/words | ./read.pl | head 

Ce programme C a le même problème:

#include <stdio.h> 

int main(int argc, char** argv) { 
    char line[4096]; 
    FILE* cat; 
    fgets(line, 4096, stdin); 
    printf("C got: %s\ncat got:\n", line); 
    cat = popen("cat", "r"); 
    while (fgets(line, 4096, cat)) { 
     printf("%s", line); 
    } 
    pclose(cat); 
    return 0; 
} 

Answer 4

J'ai de bonnes nouvelles et de mauvaises nouvelles.

Les bonnes nouvelles sont une simple modification de read.pl vous permet de lui donner entrée faux:

#! /usr/bin/perl 

use warnings; 
use strict; 

binmode STDIN, "unix" or die "$0: binmode: $!"; 

my $line = <STDIN>; 
print "Perl read: $line"; 
print "And here's what cat gets: ", `cat -`; 

run Exemple:

$ printf "A\nB\nC\nD\n" | ./read.pl 
Perl read: A 
And here's what cat gets: B 
C 
D

Les mauvaises nouvelles est que vous obtenez un seul passage: si vous essayer de répéter le read-then-cat, le premier cat affamera toutes les lectures suivantes. Pour voir cela, considérons

#! /usr/bin/perl 

use warnings; 
use strict; 

binmode STDIN, "unix" or die "$0: binmode: $!"; 

my $line = <STDIN>; 
print "1: Perl read: $line"; 
print "1: And here's what cat gets: ", `cat -`; 
$line = <STDIN>; 
$line = "<undefined>\n" unless defined $line; 
print "2: Perl read: $line"; 
print "2: And here's what cat gets: ", `cat -`; 

puis une course d'échantillon qui produit

$ printf "A\nB\nC\nD\n" | ./read.pl 
1: Perl read: A 
1: And here's what cat gets: B 
C 
D 
2: Perl read: <undefined> 
2: And here's what cat gets:

Answer 5

Enfin j'ai fini avec la solution suivante.Encore loin d'être optimal, mais ça marche. Même dans des situations comme the one described by gbacon.

use Carp qw(confess); 
use IPC::Run; 
use Scalar::Util; 
use Time::HiRes; 

# Invokes the given program with the given input and argv, and returns stdout/stderr. 
# 
# The first argument provided is the input for the program. It is an arrayref 
# containing one or more of the following: 
# 
# * A scalar is simply passed to the program as stdin 
# 
# * An arrayref in the form [ "prompt", "input" ] causes the function to wait 
# until the program prints "prompt", then spools "input" to its stdin 
# 
# * An arrayref in the form [ 0.3, "input" ] waits 0.3 seconds, then spools 
# "input" to the program's stdin 
sub capture_with_input { 
    my ($program, $inputs, @argv) = @_; 
    my ($stdout, $stderr); 
    my $stdin = ''; 

    my $process = IPC::Run::start([$program, @argv], \$stdin, \$stdout, \$stderr); 
    foreach my $input (@$inputs) { 
     if (ref($input) eq '') { 
      $stdin .= $input; 
     } 
     elsif (ref($input) eq 'ARRAY') { 
      (scalar @$input == 2) or 
       confess "Input to capture_with_input must be of the form ['prompt', 'input'] or [timeout, 'input']!"; 

      my ($prompt_or_timeout, $text) = @$input; 
      if (Scalar::Util::looks_like_number($prompt_or_timeout)) { 
       my $start_time = [ Time::HiRes::gettimeofday ]; 
       $process->pump_nb() while (Time::HiRes::tv_interval($start_time) < $prompt_or_timeout); 
      } 
      else { 
       $prompt_or_timeout = quotemeta $prompt_or_timeout; 
       $process->pump until $stdout =~ m/$prompt_or_timeout/gc; 
      } 

      $stdin .= $text; 
     } 
     else { 
      confess "Unknown input type passed to capture_with_input!"; 
     } 
    } 
    $process->finish(); 

    return ($stdout, $stderr); 
} 

my $input = [ 
    "First Line\n", 
    ["Perl read:", "Second Line\n"], 
    [0.5, "Third Line\n"], 
]; 
print "Executing process...\n"; 
my ($stdout, $stderr) = capture_with_input('./read.pl', $input); 
print "done.\n"; 
print "STDOUT:\n", $stdout; 
print "STDERR:\n", $stderr; 

Exemple d'utilisation (avec un read.pl légèrement modifié pour tester le cas de gbacon):

$ time ./spool_read4.pl 
Executing process... 
done. 
STDOUT: 
Perl read: First Line 
And here's what head -n1 gets: Second Line 
Perl read again: Third Line 

STDERR: 
./spool_read4.pl 0.54s user 0.02s system 102% cpu 0.547 total 

encore, je suis ouvert à de meilleures solutions ...