Revision history for IPC-MorseSignals
+0.05 2007-08-18 16:50 UTC
+ + Add : m{send,recv} will croak() if any of their arguments is invalid.
+ + Chg : The requirements to pass the speed test were lowered.
+ + Doc : Typos in POD.
+ + Fix : You can now send "0" as a valid message.
+ + Fix : I lied, t/02-sigusr.t wasn't really gone.
+ + Fix : while ($speed > 1) { $speed /= 2 } ok($speed >= 1); never fails.
+
0.04 2007-08-17 14:45 UTC
+ Add : Test for SUGUSR{1,2} in Makefile.PL.
+ Add : Unicode support. Enabled by passing utf8 => 1 to m{send,recv}.
+ Doc : <apeiron> Prof_Vince, 'truely' isn't a word.
+ Fix : t/11-speed.t didn't fail properly (as if those tests don't fail
enough yet!).
- + Rem : t/02-sigusr.t, as it just seems to fail everywhere.
+ + Fix : t/02-sigusr.t didn't check properly the returned value.
0.03 2007-08-16 16:20 UTC
+ Chg : Better t/10-base.t... Or at least, I hope so.
--- #YAML:1.0
name: IPC-MorseSignals
-version: 0.04
+version: 0.05
abstract: Communicate between processes with Morse signals.
license: perl
generated_by: ExtUtils::MakeMaker version 6.36
distribution_type: module
requires:
+ Carp: 0
POSIX: 0
Test::More: 0
Time::HiRes: 0
+ utf8: 0
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.2.html
version: 1.2
ABSTRACT_FROM => 'lib/IPC/MorseSignals.pm',
PL_FILES => {},
PREREQ_PM => {
+ 'Carp' => 0,
'POSIX' => 0,
'Test::More' => 0,
'Time::HiRes' => 0,
+ 'utf8' => 0,
},
dist => {
PREOP => 'pod2text lib/IPC/MorseSignals.pm > $(DISTVNAME)/README',
IPC::MorseSignals - Communicate between processes with Morse signals.
VERSION
- Version 0.04
+ Version 0.05
SYNOPSIS
use IPC::MorseSignals qw/msend mrecv/;
is set, the string will first be encoded in UTF-8. In this case, you
must turn it on for "mrecv" as well. Default speed is 512, don't set it
too low or the target will miss bits and the whole message will be
- crippled. The "utf8" flag is turned off by default;
+ crippled. The "utf8" flag is turned off by default.
"mrecv"
mrecv $callback [, utf => $utf8 ]
Takes as its first argument the callback triggered when a complete
message is received, and returns two code references that should replace
- SIGUSR1 and SIGUSR2 signal handlers. Basically, you want to use it like
+ "USR1" and "USR2" signal handlers. Basically, you want to use it like
this :
local @SIG{qw/USR1 USR2/} = mrecv sub { ... };
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 string. The emitter
- computes then the longuest sequence of successives 0 (say, "m") and 1
- ("n"). A signature is then chosen :
+ 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.
+ - If m > n, we take n+1 times 1 follewed by one 0 ;
+ - Otherwise, we take m+1 times 0 follewed by one 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
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.
+ "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.
+ Carp (standard since perl 5), POSIX (idem), Time::HiRes (since perl
+ 5.7.3) and utf8 (since perl 5.6) are required.
SEE ALSO
perlipc for information about signals in perl.
use utf8;
-use Time::HiRes qw/usleep/;
+use Carp qw/croak/;
use POSIX qw/SIGUSR1 SIGUSR2/;
+use Time::HiRes qw/usleep/;
=head1 NAME
=head1 VERSION
-Version 0.04
+Version 0.05
=cut
-our $VERSION = '0.04';
+our $VERSION = '0.05';
=head1 SYNOPSIS
msend $msg, $pid [, speed => $speed, utf8 => $utf8 ]
-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. If the C<utf8> flag is set, the string will first be encoded in UTF-8. In this case, you must turn it on for L</mrecv> as well.
-Default speed is 512, don't set it too low or the target will miss bits and the whole message will be crippled. The C<utf8> flag is turned off by default;
+Sends the string C<$msg> to the process C<$pid> (or to all the processes C<@$pid> if C<$pid> is an array ref) at C<$speed> bits per second. If the C<utf8> flag is set, the string will first be encoded in UTF-8. In this case, you must turn it on for L</mrecv> as well.
+Default speed is 512, don't set it too low or the target will miss bits and the whole message will be crippled. The C<utf8> flag is turned off by default.
=cut
sub msend {
my ($msg, $pid, @o) = @_;
my @pid = (ref $pid eq 'ARRAY') ? @$pid : $pid;
- return unless @pid && $msg && !(@o % 2);
+ return unless defined $msg && length $msg;
+ croak 'No PID was supplied' unless @pid;
+ croak 'Optional arguments must be passed as key => value pairs' if @o % 2;
my %opts = @o;
$opts{speed} ||= 512;
$opts{utf8} ||= 0;
mrecv $callback [, utf => $utf8 ]
-Takes as its first argument the callback triggered when a complete message is received, and returns two code references that should replace SIGUSR1 and SIGUSR2 signal handlers. Basically, you want to use it like this :
+Takes as its first argument the callback triggered when a complete message is received, and returns two code references that should replace C<USR1> and C<USR2> signal handlers. Basically, you want to use it like this :
local @SIG{qw/USR1 USR2/} = mrecv sub { ... };
sub mrecv {
my ($cb, @o) = @_;
- return unless $cb && !(@o % 2);
+ croak 'No callback was specified' unless $cb;
+ croak 'Optional arguments must be passed as key => value pairs' if @o % 2;
my %opts = @o;
$opts{utf8} ||= 0;
my ($bits, $state, $c, $n, $end) = ('', 0, undef, 0, '');
=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 string. The emitter computes then the longuest sequence of successives 0 (say, C<m>) and 1 (C<n>). A signature is then chosen :
+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 string. The emitter computes then the longuest sequence of successives 0 (say, m) and 1 (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 - If m > n, we take n+1 times 1 follewed by one 0 ;
-=item Otherwise, we take C<m+1> times 0 follewed by C<1> 1.
+=item - Otherwise, we take m+1 times 0 follewed by one 1.
=back
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.
+C<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.
+L<Carp> (standard since perl 5), L<POSIX> (idem), L<Time::HiRes> (since perl 5.7.3) and L<utf8> (since perl 5.6) are required.
=head1 SEE ALSO
}
tryspeed 4, 1;
-tryspeed 4, 5;
-tryspeed 4, 10;
-tryspeed 4, 50;
+tryspeed 4, 4;
+tryspeed 4, 16;
+tryspeed 4, 64;
+tryspeed 4, 256;
tryspeed 16, 1;
-tryspeed 16, 5;
-tryspeed 16, 10;
+tryspeed 16, 4;
+tryspeed 16, 16;
+tryspeed 16, 64;
tryspeed 64, 1;
-tryspeed 64, 5;
-tryspeed 64, 10;
+tryspeed 64, 4;
+tryspeed 64, 16;
tryspeed 256, 1;
-tryspeed 256, 5;
+tryspeed 256, 4;
tryspeed 1024, 1;
print STDERR "=== Summary ===\n";
my $speed = 2 ** 16;
my $ok = 0;
SPEED:
- while (($speed > 1) && !$ok) {
- $speed /= 2;
+ while ((($speed /= 2) >= 1) && !$ok) {
my $pid = fork;
if (!defined $pid) {
die "$desc: fork() failed : $!";
my $ok = 0;
$desc .= ' (unicode)';
SPEED:
- while (($speed > 1) && !$ok) {
- $speed /= 2;
+ while ((($speed /= 2) >= 1) && !$ok) {
my $pid = fork;
if (!defined $pid) {
die "$desc: fork() failed : $!";
#!perl -T
-use Test::More tests => 12;
+use Test::More tests => 6;
use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS EXIT_FAILURE WIFEXITED WEXITSTATUS/;
my @res;
sub tryspeed {
- my ($l, $n) = @_;
+ my ($l, $n, $optional) = @_;
my $speed = 2 ** 16;
my $ok = 0;
my @alpha = ('a' .. 'z');
my $msg = join '', map { $alpha[rand @alpha] } 1 .. $l;
my $desc;
- while (($speed > 1) && ($ok < $n)) {
- $speed /= 2;
+ while ((($speed /= 2) >= 1) && ($ok < $n)) {
$desc = "$n sends of $l bytes at $speed bits/s";
+ $desc .= ' (mandatory)' unless $optional;
$ok = 0;
diag("try $desc...");
TRY:
}
}
$desc = "$l bytes sent $n times";
- ok($speed >= 1, $desc);
+ ok($speed >= 1, $desc) unless $optional;
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;
+tryspeed 4, 1;
+tryspeed 4, 4;
+tryspeed 4, 16;
+tryspeed 16, 1;
+tryspeed 16, 4;
+tryspeed 64, 1;
+
+tryspeed 4, 64, 1;
+tryspeed 16, 16, 1;
+tryspeed 64, 4, 1;
+tryspeed 256, 1, 1;
+tryspeed 1024, 1, 1;
diag '=== Summary ===';
-diag $_ for @res;
+diag $_ for sort {
+ my ($l1, $n1) = $a =~ /(\d+)\D+(\d+)/;
+ my ($l2, $n2) = $b =~ /(\d+)\D+(\d+)/;
+ $l1 <=> $l2 || $n1 <=> $n2
+} @res;