samples/bench.pl

   1 #!/usr/bin/perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use POSIX qw/SIGINT SIGTERM SIGKILL SIGHUP EXIT_FAILURE/;
   7
   8 use lib qw{blib/lib};
   9
  10 use IPC::MorseSignals qw/msend mrecv mreset/;
  11
  12 my $lives = 100;
  13
  14 sub spawn {
  15  --$lives;
  16  die 'forked too many times' if $lives < 0;
  17  pipe my $rdr, my $wtr or die "pipe() failed: $!";
  18  my $pid = fork;
  19  if (!defined $pid) {
  20   die "fork() failed: $!";
  21  } elsif ($pid == 0) {
  22   close $rdr or die "close() failed: $!";
  23   my $s = mrecv local %SIG, cb => sub {
  24    select $wtr; $| = 1;
  25    print $wtr $_[1], "\n";
  26    select $wtr; $| = 1;
  27   };
  28   $SIG{'HUP'} = sub { mreset $s };
  29   1 while 1;
  30   exit EXIT_FAILURE;
  31  }
  32  close $wtr or die "close() failed: $!";
  33  return ($pid, $rdr);
  34 }
  35
  36 sub slaughter {
  37  my ($pid) = @_;
  38  kill SIGINT  => $pid;
  39  kill SIGTERM => $pid;
  40  kill SIGKILL => $pid;
  41  waitpid $pid, 0;
  42 }
  43
  44 my @res;
  45
  46 my ($pid, $rdr) = spawn;
  47
  48 sub tryspeed {
  49  my ($l, $n) = @_;
  50  my $speed = 2 ** 16;
  51  my $ok = 0;
  52  my @alpha = ('a' .. 'z');
  53  my $msg = join '', map { $alpha[rand @alpha] } 1 .. $l;
  54  while (($ok < $n) && (($speed /= 2) >= 1)) {
  55   print STDERR "$n sends of $l bytes at $speed bits/s";
  56 TRY:
  57   for (1 .. $n) {
  58    print STDERR '.';
  59    my $r = '';
  60    eval {
  61     local $SIG{ALRM} = sub { print STDERR "timeout\n"; die };
  62     my $a = (int(100 * (3 * $l) / $speed) || 1);
  63     $a = 10 if $a > 10;
  64     alarm $a;
  65     msend $msg => $pid, speed => $speed;
  66     $r = <$rdr>;
  67    };
  68    kill SIGHUP => $pid if $@;
  69    alarm 0;
  70    if (!defined $r) { # Something bad happened, respawn
  71     print STDERR "oops\n";
  72     close $rdr or die "close() failed: $!";
  73     slaughter $pid;
  74     ($pid, $rdr) = spawn;
  75     redo TRY;         # Retry this send
  76    } else {
  77     chomp $r;
  78     if ($r eq $msg) {
  79      ++$ok;
  80     } else {
  81      print STDERR "transfer error\n";
  82      kill SIGHUP => $pid;
  83      last TRY;
  84     }
  85    }
  86   }
  87  }
  88  my $desc = "$l bytes sent $n times";
  89  if ($speed >= 1) {
  90   print STDERR " OK\n\n";
  91   push @res, "$desc at $speed bits/s";
  92  } else {
  93   print STDERR " FAILED\n\n";
  94   push @res, "$desc FAILED";
  95  }
  96 }
  97
  98 tryspeed 4,    1;
  99 tryspeed 4,    4;
 100 tryspeed 4,    16;
 101 tryspeed 4,    64;
 102 tryspeed 4,    256;
 103 tryspeed 16,   1;
 104 tryspeed 16,   4;
 105 tryspeed 16,   16;
 106 tryspeed 16,   64;
 107 tryspeed 64,   1;
 108 tryspeed 64,   4;
 109 tryspeed 64,   16;
 110 tryspeed 256,  1;
 111 tryspeed 256,  4;
 112 tryspeed 1024, 1;
 113
 114 print STDERR "=== Summary ===\n";
 115 print STDERR "$_\n" for @res;