samples/bench.pl

   1 #!/usr/bin/perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS EXIT_FAILURE WIFEXITED WEXITSTATUS/;
   7
   8 use lib qw{blib/lib};
   9
  10 use IPC::MorseSignals qw/msend mrecv/;
  11
  12 my @res;
  13
  14 sub tryspeed {
  15  my ($l, $n) = @_;
  16  my $speed = 2 ** 16;
  17  my $ok = 0;
  18  my $desc;
  19 SPEED:
  20  while (($speed > 1) && ($ok < $n)) {
  21   $speed /= 2;
  22   $desc = "$n sends of $l bytes at $speed bits/s";
  23   $ok = 0;
  24   print STDERR "try $desc";
  25   for (1 .. $n) {
  26    print STDERR ".";
  27    my @alpha = ('a' .. 'z');
  28    my $msg = join '', map { $alpha[rand @alpha] } 1 .. $l;
  29    my $pid = fork;
  30    if (!defined $pid) {
  31     die "$desc: fork() failed : $!";
  32    } elsif ($pid == 0) {
  33     local @SIG{qw/USR1 USR2/} = mrecv sub {
  34      exit(($msg eq $_[0]) ? EXIT_SUCCESS : EXIT_FAILURE);
  35     };
  36     1 while 1;
  37     exit EXIT_FAILURE;
  38    }
  39    my $next = 0;
  40    eval {
  41     local $SIG{ALRM} = sub { die 'timeout' };
  42     my $a = (int(100 * (3 * $l) / $speed) || 1);
  43     $a = 10 if $a > 10;
  44     alarm $a;
  45     msend $msg => $pid, speed => $speed;
  46     waitpid $pid, 0;
  47     if (WIFEXITED($?) && (WEXITSTATUS($?) == EXIT_SUCCESS)) {
  48      ++$ok;
  49     } else {
  50      print STDERR " transfer error\n";
  51      $next = 1;
  52     }
  53    };
  54    alarm 0;
  55    if ($@) {
  56     kill SIGINT,  $pid;
  57     kill SIGTERM, $pid;
  58     kill SIGKILL, $pid;
  59     print STDERR " timeout\n";
  60     $next = 1;
  61    }
  62    next SPEED if $next;
  63   }
  64  }
  65  $desc = "$l bytes sent $n times";
  66  if ($speed >= 1) {
  67   print STDERR " OK\n\n";
  68   push @res, "$desc at $speed bits/s";
  69  } else {
  70   print STDERR " FAILED\n\n";
  71   push @res, "$desc FAILED";
  72  }
  73 }
  74
  75 tryspeed 4, 1;
  76 tryspeed 4, 5;
  77 tryspeed 4, 10;
  78 tryspeed 4, 50;
  79 tryspeed 16, 1;
  80 tryspeed 16, 5;
  81 tryspeed 16, 10;
  82 tryspeed 64, 1;
  83 tryspeed 64, 5;
  84 tryspeed 64, 10;
  85 tryspeed 256, 1;
  86 tryspeed 256, 5;
  87 tryspeed 1024, 1;
  88
  89 print STDERR "=== Summary ===\n";
  90 print STDERR "$_\n" for @res;