From: Vincent Pit <vince@profvince.com>
Date: Sun, 29 Jun 2008 16:35:30 +0000 (+0200)
Subject: Importing IPC-MorseSignals-0.02.tar.gz
X-Git-Tag: v0.02^0
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FIPC-MorseSignals.git;a=commitdiff_plain;h=762a8a02ffc76d62c023619d0dffe451498ae2b0

Importing IPC-MorseSignals-0.02.tar.gz
---

diff --git a/Changes b/Changes
index 46a37ea..1432373 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,11 @@
 Revision history for IPC-MorseSignals
 
+0.02    2007-08-16 15:55 UTC
+        + Add : samples/bench.pl, a transfer speed benchmark script.
+        + Add : New tests : t/02-sigusr.t, t/11-speed.t
+        + Fix : Warnings when the transfer fails.
+	+ Doc : The protocol was documented.
+
 0.01    2007-08-15 21:20 UTC
         First version, released on an unsuspecting world.
 
diff --git a/MANIFEST b/MANIFEST
index 7ce3c31..2590699 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5,9 +5,12 @@ Makefile.PL
 README
 lib/IPC/MorseSignals.pm
 samples/tryityourself.pl
+samples/bench.pl
 t/00-load.t
 t/01-import.t
+t/02-sigusr.t
 t/10-base.t
+t/11-speed.t
 t/boilerplate.t
 t/kwalitee.t
 t/pod-coverage.t
diff --git a/META.yml b/META.yml
index 86062df..8a0c77b 100644
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                IPC-MorseSignals
-version:             0.01
+version:             0.02
 abstract:            Communicate between processes with Morse signals.
 license:             perl
 generated_by:        ExtUtils::MakeMaker version 6.36
diff --git a/README b/README
index 221958f..0e5fb78 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ NAME
     IPC::MorseSignals - Communicate between processes with Morse signals.
 
 VERSION
-    Version 0.01
+    Version 0.02
 
 SYNOPSIS
         use IPC::MorseSignals qw/msend mrecv/;
@@ -11,7 +11,10 @@ SYNOPSIS
         if (!defined $pid) {
          die "fork() failed: $!";
         } elsif ($pid == 0) {
-         local @SIG{qw/USR1 USR2/} = mrecv sub { print STDERR "recieved $_[0]!\n" };
+         local @SIG{qw/USR1 USR2/} = mrecv sub {
+          print STDERR "received $_[0]!\n";
+          exit
+         };
          1 while 1;
         }
         msend "hello!\n" => $pid;
@@ -19,9 +22,8 @@ SYNOPSIS
 
 DESCRIPTION
     This module implements a rare form of IPC by sending Morse-like signals
-    through "SIGUSR1" and "SIGUSR2". It uses both signals "SIGUSR1" and
-    "SIGUSR2", so you won't be able to keep them for something else when you
-    use this module.
+    through "SIGUSR1" and "SIGUSR2". Both of those signals are used, so you
+    won't be able to keep them for something else when you use this module.
 
     But, seriously, use something else for your IPC. :)
 
@@ -31,7 +33,7 @@ FUNCTIONS
 
     Sends the string $msg to the process $pid (or to all the processes @$pid
     if $pid is an array ref) at $speed bits per second. Default speed is
-    1000, don't set it too low or the target will miss bits and the whole
+    512, don't set it too low or the target will miss bits and the whole
     message will be crippled.
 
   "mrecv"
@@ -48,12 +50,37 @@ EXPORT
     This module exports on request its two only functions, "msend" and
     "mrecv".
 
+PROTOCOL
+    Each byte of the data string is converted into its bits sequence, with
+    bits of highest weight coming first. All those bits sequences are put
+    into the same order as the characters occur in the stream. The emitter
+    computes then the longuest sequence of successives 0 (say, "m") and 1
+    ("n"). A signature is then chosen :
+
+    If C(m > n), we take "n+1" times 1 follewed by 1 0 ;
+    Otherwise, we take "m+1" times 0 follewed by 1 1.
+
+    The signal is then formed by concatenating the signature, the data bits
+    and the reversed signature (i.e. the bits of the signature in the
+    reverse order).
+
+    The receiver knows that the signature has been sent when it has catched
+    at least one 0 and one 1. The signal is completely transferred when it
+    has received for the first time the whole reversed signature.
+
+CAVEATS
+    This type of IPC is highly unreliable. Send little data at slow speed if
+    you want it to reach its goal.
+
+    SIGUSR{1,2} seem to interrupt sleep, so it's not a good idea to transfer
+    data to a sleeping process.
+
 DEPENDENCIES
     POSIX (standard since perl 5) and Time::HiRes (standard since perl
     5.7.3) are required.
 
 SEE ALSO
-    perlipc for information about signals.
+    perlipc for information about signals in perl.
 
     For truely useful IPC, search for shared memory, pipes and semaphores.
 
diff --git a/lib/IPC/MorseSignals.pm b/lib/IPC/MorseSignals.pm
index ded0f02..214073b 100644
--- a/lib/IPC/MorseSignals.pm
+++ b/lib/IPC/MorseSignals.pm
@@ -12,11 +12,11 @@ IPC::MorseSignals - Communicate between processes with Morse signals.
 
 =head1 VERSION
 
-Version 0.01
+Version 0.02
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 =head1 SYNOPSIS
 
@@ -26,7 +26,10 @@ our $VERSION = '0.01';
     if (!defined $pid) {
      die "fork() failed: $!";
     } elsif ($pid == 0) {
-     local @SIG{qw/USR1 USR2/} = mrecv sub { print STDERR "recieved $_[0]!\n" };
+     local @SIG{qw/USR1 USR2/} = mrecv sub {
+      print STDERR "received $_[0]!\n";
+      exit
+     };
      1 while 1;
     }
     msend "hello!\n" => $pid;
@@ -34,7 +37,7 @@ our $VERSION = '0.01';
 
 =head1 DESCRIPTION
 
-This module implements a rare form of IPC by sending Morse-like signals through C<SIGUSR1> and C<SIGUSR2>. It uses both signals C<SIGUSR1> and C<SIGUSR2>, so you won't be able to keep them for something else when you use this module.
+This module implements a rare form of IPC by sending Morse-like signals through C<SIGUSR1> and C<SIGUSR2>. Both of those signals are used, so you won't be able to keep them for something else when you use this module.
 
 But, seriously, use something else for your IPC. :)
 
@@ -44,7 +47,7 @@ But, seriously, use something else for your IPC. :)
 
     msend $msg, $pid [, $speed ]
 
-Sends the string C<$msg> to the process C<$pid> (or to all the processes C<@$pid> if $pid is an array ref) at C<$speed> bits per second. Default speed is 1000, don't set it too low or the target will miss bits and the whole message will be crippled.
+Sends the string C<$msg> to the process C<$pid> (or to all the processes C<@$pid> if $pid is an array ref) at C<$speed> bits per second. Default speed is 512, don't set it too low or the target will miss bits and the whole message will be crippled.
 
 =cut
 
@@ -52,7 +55,7 @@ sub msend {
  my ($msg, $pid, $speed) = @_;
  my @pid = (ref $pid eq 'ARRAY') ? @$pid : $pid;
  return unless @pid && $msg;
- $speed ||= 1000;
+ $speed ||= 512;
  my $delay = int(1_000_000 / $speed);
  my @bits = split //, unpack 'B*', $msg;
  my ($c, $n, @l) = (2, 0, 0, 0, 0);
@@ -88,11 +91,12 @@ Takes as its sole argument the callback triggered when a complete message is rec
 
 sub mrecv {
  my ($cb) = @_;
- my ($bits, $state, $c, $n, $end) = ('', 0, undef, 0, undef);
+ return unless $cb;
+ my ($bits, $state, $c, $n, $end) = ('', 0, undef, 0, '');
  my $sighandler = sub {
   my ($b) = @_;
   if ($state == 2) {
-   if ((substr $bits, -$n) eq $end) { # done
+   if (defined $bits && (substr $bits, -$n) eq $end) { # done
     substr $bits, -$n, $n, '';
     $cb->(pack 'B*', $bits);
    }
@@ -131,13 +135,35 @@ our %EXPORT_TAGS    = ( 'funcs' => [ qw/msend mrecv/ ] );
 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 $EXPORT_TAGS{'all'} = \@EXPORT_OK;
 
+=head1 PROTOCOL
+
+Each byte of the data string is converted into its bits sequence, with bits of highest weight coming first. All those bits sequences are put into the same order as the characters occur in the stream. The emitter computes then the longuest sequence of successives 0 (say, C<m>) and 1 (C<n>). A signature is then chosen :
+
+=over 4
+
+=item If C(m > n), we take C<n+1> times 1 follewed by C<1> 0 ;
+
+=item Otherwise, we take C<m+1> times 0 follewed by C<1> 1.
+
+=back
+
+The signal is then formed by concatenating the signature, the data bits and the reversed signature (i.e. the bits of the signature in the reverse order).
+
+The receiver knows that the signature has been sent when it has catched at least one 0 and one 1. The signal is completely transferred when it has received for the first time the whole reversed signature.
+
+=head1 CAVEATS
+
+This type of IPC is highly unreliable. Send little data at slow speed if you want it to reach its goal.
+
+SIGUSR{1,2} seem to interrupt sleep, so it's not a good idea to transfer data to a sleeping process.
+
 =head1 DEPENDENCIES
 
 L<POSIX> (standard since perl 5) and L<Time::HiRes> (standard since perl 5.7.3) are required.
 
 =head1 SEE ALSO
 
-L<perlipc> for information about signals.
+L<perlipc> for information about signals in perl.
 
 For truely useful IPC, search for shared memory, pipes and semaphores.
 
diff --git a/samples/bench.pl b/samples/bench.pl
new file mode 100755
index 0000000..852c09f
--- /dev/null
+++ b/samples/bench.pl
@@ -0,0 +1,98 @@
+#!/usr/bin/perl -T
+
+use strict;
+use warnings;
+
+use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS/;
+
+use lib qw{blib/lib};
+
+use IPC::MorseSignals qw/msend mrecv/;
+
+my @res;
+
+sub tryspeed {
+ my ($l, $n) = @_;
+ my $speed = 2 ** 16;
+ my $ok = 0;
+ my $desc;
+ while ($speed && $ok < $n) {
+  $desc = "$n sends of $l bytes at $speed bits/s";
+  $speed /= 2;
+  $ok = 0;
+  print STDERR "try $desc";
+TRY:
+  for (1 .. $n) {
+   print STDERR ".";
+   my @alpha = ('a' .. 'z');
+   my $msg = join '', map { $alpha[rand @alpha] } 1 .. $l;
+   pipe my $rdr, my $wtr or die "$desc: pipe() failed : $!";
+   my $pid = fork;
+   if (!defined $pid) {
+    die "$desc: fork() failed : $!";
+   } elsif ($pid == 0) {
+    close $rdr;
+    local @SIG{qw/USR1 USR2/} = mrecv sub {
+     print $wtr $_[0], "\n";
+     close $wtr;
+     exit EXIT_SUCCESS;
+    };
+    1 while 1;
+   }
+   close $wtr or die "$desc: close() failed : $!";
+   eval {
+    local $SIG{ALRM} = sub { die 'alarm' };
+    my $a = (int(100 * (3 * $l) / $speed) || 1);
+    $a = 10 if $a > 10;
+    alarm $a;
+    msend $msg => $pid, $speed;
+    waitpid $pid, 0;
+   };
+   alarm 0;
+   if ($@) {
+    kill SIGINT,  $pid;
+    kill SIGTERM, $pid;
+    kill SIGKILL, $pid;
+    close $rdr or die "$desc: close() failed : $!";
+    print STDERR " timeout\n";
+    next TRY;
+   }
+   my $recv = do { local $/; <$rdr> };
+   close $rdr or die "$desc: close() failed : $!";
+   if ($recv) {
+    chomp $recv;
+    if ($msg eq $recv) {
+     ++$ok;
+    } else {
+     print STDERR " transfer error\n";
+     last TRY;
+    }
+   } else {
+    print STDERR " transfer failure\n";
+    last TRY;
+   }
+  }
+ }
+ if ($speed) {
+  print STDERR " OK\n\n";
+  $desc = "$l bytes sent $n times";
+  push @res, "$desc at $speed bits/s";
+ }
+}
+
+tryspeed 4, 1;
+tryspeed 4, 5;
+tryspeed 4, 10;
+tryspeed 4, 50;
+tryspeed 16, 1;
+tryspeed 16, 5;
+tryspeed 16, 10;
+tryspeed 64, 1;
+tryspeed 64, 5;
+tryspeed 64, 10;
+tryspeed 256, 1;
+tryspeed 256, 5;
+tryspeed 1024, 1;
+
+print STDERR "=== Summary ===\n";
+print STDERR "$_\n" for @res;
diff --git a/t/02-sigusr.t b/t/02-sigusr.t
new file mode 100644
index 0000000..0adb3c6
--- /dev/null
+++ b/t/02-sigusr.t
@@ -0,0 +1,35 @@
+#!perl -T
+
+use Test::More tests => 2;
+
+use POSIX qw/SIGTERM SIGKILL EXIT_FAILURE EXIT_SUCCESS/;
+
+sub trysig {
+ my ($n, $s) = @_;
+ my $pid = fork;
+ if (!defined $pid) {
+  die "$s: fork() failed : $!";
+ } elsif ($pid == 0) {
+  local $SIG{$s} = sub { exit EXIT_SUCCESS };
+  1 while 1;
+ }
+ my $ret = EXIT_FAILURE;
+ eval {
+  local $SIG{ALRM} = sub { die };
+  alarm 1;
+  kill $n, $pid;
+  waitpid $pid, 0;
+  $ret = $?;
+  alarm 0;
+ };
+ if ($@) {
+  kill SIGINT,  $pid;
+  kill SIGTERM, $pid;
+  kill SIGKILL, $pid;
+  die "$s: $@";
+ }
+ ok($ret == EXIT_SUCCESS, $s);
+}
+
+trysig SIGUSR1, 'USR1';
+trysig SIGUSR2, 'USR2';
diff --git a/t/10-base.t b/t/10-base.t
index 628e8f0..153cffe 100644
--- a/t/10-base.t
+++ b/t/10-base.t
@@ -1,38 +1,43 @@
 #!perl -T
 
-use Test::More tests => 6;
+use Test::More tests => 7 * 5;
 
-use POSIX qw/SIGTERM SIGKILL EXIT_SUCCESS/;
+use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS/;
 
 use IPC::MorseSignals qw/msend mrecv/;
 
-sub try2send {
+my $speed = 128;
+
+sub trysend {
  my ($msg, $desc) = @_;
- pipe $rdr, $wtr or die "pipe() failed : $!";
+ pipe my $rdr, my $wtr or die "$desc: pipe() failed : $!";
  my $pid = fork;
  if (!defined $pid) {
-  die "fork() failed : $!";
+  die "$desc: fork() failed : $!";
  } elsif ($pid == 0) {
   close $rdr;
   local @SIG{qw/USR1 USR2/} = mrecv sub {
    print $wtr $_[0], "\n";
+   close $wtr;
    exit EXIT_SUCCESS;
   };
   1 while 1;
  }
- close $wtr or die "close() failed : $!";
- msend $msg => $pid, 100;
+ close $wtr or die "$desc: close() failed : $!";
  eval {
-  local $SIG{ALRM} = sub { die };
-  alarm 5;
+  local $SIG{ALRM} = sub { die 'timeout' };
+  my $a = (int(100 * (3 * length $msg) / $speed) || 1);
+  $a = 10 if $a > 10;
+  alarm $a;
+  msend $msg => $pid, $speed;
   waitpid $pid, 0;
-  alarm 0;
  };
+ alarm 0;
  if ($@) {
   kill SIGINT,  $pid;
   kill SIGTERM, $pid;
   kill SIGKILL, $pid;
-  die "$@ in $desc";
+  die "$desc: died ($@)";
  }
  my $recv = do { local $/; <$rdr> };
  close $rdr;
@@ -40,9 +45,12 @@ sub try2send {
  ok($msg eq $recv, $desc);
 }
 
-try2send 'hello', 'ascii';
-try2send 'éàùçà', 'extended';
-try2send '€€€', 'unicode';
-try2send 'a€bécàd€e', 'mixed';
-try2send "\x{FF}", 'lots of bits';
-try2send "a\0b", 'null character';
+for (1 .. 5) {
+ trysend 'hello', 'ascii';
+ trysend 'éàùçà', 'extended';
+ trysend '€€€', 'unicode';
+ trysend 'a€bécàd€e', 'mixed';
+ trysend "\0" x 10, 'few bits';
+ trysend "\x{FF}" x 10, 'lots of bits';
+ trysend "a\0b", 'null character';
+}
diff --git a/t/11-speed.t b/t/11-speed.t
new file mode 100644
index 0000000..2593fd4
--- /dev/null
+++ b/t/11-speed.t
@@ -0,0 +1,81 @@
+#!perl -T
+
+use Test::More tests => 12;
+
+use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS/;
+
+use IPC::MorseSignals qw/msend mrecv/;
+
+my @res;
+
+sub tryspeed {
+ my ($l, $n) = @_;
+ my $speed = 2 ** 16;
+ my $ok = 0;
+ my $msg = join '', map { chr int rand 256 } 1 .. $l;
+ my $desc;
+ while (($speed >= 1) && ($ok < $n)) {
+  $desc = "$n sends of $l bytes at $speed bits/s";
+  $speed /= 2;
+  $ok = 0;
+  diag("try $desc...");
+TRY:
+  for (1 .. $n) {
+   pipe my $rdr, my $wtr or die "$desc: pipe() failed : $!";
+   my $pid = fork;
+   if (!defined $pid) {
+    die "$desc: fork() failed : $!";
+   } elsif ($pid == 0) {
+    close $rdr;
+    local @SIG{qw/USR1 USR2/} = mrecv sub {
+     print $wtr $_[0], "\n";
+     close $wtr;
+     exit EXIT_SUCCESS;
+    };
+    1 while 1;
+   }
+   close $wtr or die "$desc: close() failed : $!";
+   eval {
+    local $SIG{ALRM} = sub { die 'alarm' };
+    my $a = (int(100 * (3 * $l) / $speed) || 1);
+    $a = 10 if $a > 10;
+    alarm $a;
+    msend $msg => $pid, $speed;
+    waitpid $pid, 0;
+   };
+   alarm 0;
+   if ($@) {
+    kill SIGINT,  $pid;
+    kill SIGTERM, $pid;
+    kill SIGKILL, $pid;
+    close $rdr or die "$desc: close() failed : $!";
+    last TRY;
+   }
+   my $recv = do { local $/; <$rdr> };
+   close $rdr or die "$desc: close() failed : $!";
+   last TRY unless $recv;
+   chomp $recv;
+   last TRY unless $msg eq $recv;
+   ++$ok;
+  }
+ }
+ $desc = "$l bytes sent $n times";
+ ok($speed, $desc);
+ push @res, $desc . (($speed) ? ' at ' . $speed . ' bits/s' : ' failed');
+}
+
+tryspeed 4, 1;
+tryspeed 4, 5;
+tryspeed 4, 10;
+tryspeed 4, 50;
+tryspeed 16, 1;
+tryspeed 16, 5;
+tryspeed 16, 10;
+tryspeed 64, 1;
+tryspeed 64, 5;
+tryspeed 64, 10;
+tryspeed 256, 1;
+tryspeed 1024, 1;
+
+diag '=== Summary ===';
+diag $_ for @res;