]> git.vpit.fr Git - perl/modules/IPC-MorseSignals.git/commitdiff
Importing IPC-MorseSignals-0.10.tar.gz
authorVincent Pit <vince@profvince.com>
Sun, 29 Jun 2008 16:36:54 +0000 (18:36 +0200)
committerVincent Pit <vince@profvince.com>
Sun, 29 Jun 2008 16:36:54 +0000 (18:36 +0200)
28 files changed:
Changes [new file with mode: 0644]
MANIFEST [new file with mode: 0644]
META.yml [new file with mode: 0644]
Makefile.PL [new file with mode: 0644]
README [new file with mode: 0644]
lib/IPC/MorseSignals.pm [new file with mode: 0644]
lib/IPC/MorseSignals/Emitter.pm [new file with mode: 0644]
lib/IPC/MorseSignals/Receiver.pm [new file with mode: 0644]
samples/bench.pl [new file with mode: 0755]
samples/try.pl [new file with mode: 0755]
t/00-load.t [new file with mode: 0644]
t/02-can.t [new file with mode: 0644]
t/10-sigusr.t [new file with mode: 0644]
t/20-emitter-obj.t [new file with mode: 0644]
t/30-receiver-obj.t [new file with mode: 0644]
t/50-self-plain.t [new file with mode: 0644]
t/51-self-utf8.t [new file with mode: 0644]
t/52-self-storable.t [new file with mode: 0644]
t/60-fork-plain.t [new file with mode: 0644]
t/61-fork-utf8.t [new file with mode: 0644]
t/62-fork-storable.t [new file with mode: 0644]
t/70-speed.t [new file with mode: 0644]
t/90-boilerplate.t [new file with mode: 0644]
t/91-pod.t [new file with mode: 0644]
t/92-pod-coverage.t [new file with mode: 0644]
t/95-portability-files.t [new file with mode: 0644]
t/99-kwalitee.t [new file with mode: 0644]
t/lib/IPC/MorseSignals/TestSuite.pm [new file with mode: 0644]

diff --git a/Changes b/Changes
new file mode 100644 (file)
index 0000000..383375b
--- /dev/null
+++ b/Changes
@@ -0,0 +1,70 @@
+Revision history for IPC-MorseSignals
+
+0.10    2008-03-05 16:35 UTC
+        IPC::MorseSignals now uses Bit::MorseSignals as backend. Major rewrite.
+
+0.09    2008-02-03 18:25 UTC
+        + Tst : Fix a race in child creation : the parent could send the message
+                before the child was ready to receive it.
+        + Tst : Turn autoflush on onto the reader end of the pipe.
+        + Tst : Renamed IPCMTest to IPC::MorseSignals::TestSuite
+        + Tst : Prefix author tests by 9*-.
+        + Tst : New optional author test : 95-portability-files.t, that uses
+                Test::Portability::Files when it's present.
+
+0.08    2007-09-05 09:40 UTC
+        + Chg : The sender detects now automatically if the message is encoded
+                in UTF-8, thanks to Encode::is_utf8. You no longer need to pass
+                the utf8 option to msend. The Encode module is a prerequisite.
+        + Chg : Tests that used to die now report correct failure.
+        + Fix : Tests are now strict.
+        + Fix : Miscount in t/13-speed.t
+
+0.07    2007-08-28 11:30 UTC
+        + Chg : Common test code was factored into a module.
+        + Chg : Tests were lightened again.
+        + Doc : Typos in POD.
+
+0.06    2007-08-21 08:15 UTC
+        + Add : The protocol now carries the UTF-8 flag (hence you no longer
+                need to specify it to mrecv()) and the sender's PID (but you can
+                mask it).
+        + Add : New functions : mreset(), mlastmsg(), mlastsender().
+        + Chg : msend() accepts now the sign option, to specify is the sender
+                can put its PID into the message packet or not (default is yes).
+        + Chg : mrecv() now returns a hash reference that holds the receiver's
+                state. %SIG has to be passed as the first argument. The callback
+                is no longer mandatory and should be passed with the cb key. The
+                utf8 key was removed.
+        + Chg : The tests call fork() only one time.
+
+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}.
+        + Chg : The speed must now be passed to msend() by speed => $speed.
+        + Chg : Tests no longer pass their result with pipes.
+        + 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!).
+        + 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.
+
+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
new file mode 100644 (file)
index 0000000..c20c85d
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,28 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/IPC/MorseSignals.pm
+lib/IPC/MorseSignals/Emitter.pm
+lib/IPC/MorseSignals/Receiver.pm
+samples/bench.pl
+samples/try.pl
+t/00-load.t
+t/02-can.t
+t/10-sigusr.t
+t/20-emitter-obj.t
+t/30-receiver-obj.t
+t/50-self-plain.t
+t/51-self-utf8.t
+t/52-self-storable.t
+t/60-fork-plain.t
+t/61-fork-utf8.t
+t/62-fork-storable.t
+t/70-speed.t
+t/90-boilerplate.t
+t/91-pod.t
+t/92-pod-coverage.t
+t/95-portability-files.t
+t/99-kwalitee.t
+t/lib/IPC/MorseSignals/TestSuite.pm
+META.yml                                 Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
new file mode 100644 (file)
index 0000000..3b5779a
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,25 @@
+--- #YAML:1.0
+name:                IPC-MorseSignals
+version:             0.10
+abstract:            Communicate between processes with Morse signals.
+license:             perl
+author:              
+    - Vincent Pit <perl@profvince.com>
+generated_by:        ExtUtils::MakeMaker version 6.44
+distribution_type:   module
+requires:     
+    Carp:                          0
+    Exporter:                      0
+    POSIX:                         0
+    Test::More:                    0
+    Time::HiRes:                   0
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3
+build_requires:
+    Data::Dumper:                  0
+    Exporter:                      0
+    ExtUtils::MakeMaker:           0
+    POSIX:                         0
+    Test::More:                    0
+    utf8:                          0
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644 (file)
index 0000000..341a6ca
--- /dev/null
@@ -0,0 +1,62 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+BEGIN {
+ eval { require Config };
+ die "You need the Config module to install this distribution, that's what happened" if $@;
+ Config->import qw/%Config/;
+}   
+    
+my %sigs;
+@sigs{split ' ', $Config{sig_name}} = ();
+    
+for (qw/USR1 USR2/) {
+ print "Checking if you have SIG$_... ";
+ unless (exists $sigs{$_}) {
+  print "no\n";
+  die "Installation stops right here,";
+ }
+ print "yes\n";
+}
+
+my $BUILD_REQUIRES = {
+ 'utf8'                => 0,
+ 'Data::Dumper'        => 0,
+ 'Exporter'            => 0,
+ 'ExtUtils::MakeMaker' => 0,
+ 'POSIX'               => 0,
+ 'Test::More'          => 0,
+};
+
+sub build_req {
+ my $tometa = ' >> $(DISTVNAME)/META.yml;';
+ my $build_req = 'echo "build_requires:" ' . $tometa;
+ foreach my $mod ( sort { lc $a cmp lc $b } keys %$BUILD_REQUIRES ) {
+  my $ver = $BUILD_REQUIRES->{$mod};
+  $build_req .= sprintf 'echo "    %-30s %s" %s', "$mod:", $ver, $tometa;
+ }
+ return $build_req;
+}
+
+WriteMakefile(
+    NAME                => 'IPC::MorseSignals',
+    AUTHOR              => 'Vincent Pit <perl@profvince.com>',
+    LICENSE             => 'perl',
+    VERSION_FROM        => 'lib/IPC/MorseSignals.pm',
+    ABSTRACT_FROM       => 'lib/IPC/MorseSignals.pm',
+    PL_FILES            => {},
+    PREREQ_PM => {
+        'Carp'        => 0,
+        'Exporter'    => 0,
+        'POSIX'       => 0,
+        'Test::More'  => 0,
+        'Time::HiRes' => 0,
+    },
+    dist                => {
+        PREOP => 'pod2text lib/IPC/MorseSignals.pm > $(DISTVNAME)/README; '
+                 . build_req,
+        COMPRESS => 'gzip -9f', SUFFIX => 'gz',
+    },
+    clean               => { FILES => 'IPC-MorseSignals-*' },
+);
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..aa1abb9
--- /dev/null
+++ b/README
@@ -0,0 +1,79 @@
+NAME
+    IPC::MorseSignals - Communicate between processes with Morse signals.
+
+VERSION
+    Version 0.10
+
+SYNOPSIS
+        # In the sender process
+        use IPC::MorseSignals::Emitter;
+
+        my $deuce = new IPC::MorseSignals::Emitter speed => 1024;
+        $deuce->post('HLAGH') for 1 .. 3;
+        $deuce->send($pid);
+
+        ...
+
+        # In the receiver process
+        use IPC::MorseSignals::Receiver;
+
+        local %SIG;
+        my $pants = new IPC::MorseSignals::Receiver \%SIG, done => sub {
+         print STDERR "GOT $_[1]\n";
+        };
+
+    head1 DESCRIPTION
+
+    This module implements a rare form of IPC by sending Morse-like signals
+    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.
+
+    IPC::MorseSignals::Emitter is a base class for emitters ;
+    IPC::MorseSignals::Receiver is a base class for receivers ;
+
+    But, seriously, use something else for your IPC. :)
+
+DEPENDENCIES
+    You need the complete Bit::MorseSignals distribution.
+
+    Carp (standard since perl 5), POSIX (idem) and Time::HiRes (since perl
+    5.7.3) are also required.
+
+SEE ALSO
+    IPC::MorseSignals::Emitter, IPC::MorseSignals::Receiver.
+
+    Bit::MorseSignals, Bit::MorseSignals::Emitter,
+    Bit::MorseSignals::Receiver.
+
+    perlipc for information about signals in perl.
+
+    For truly useful IPC, search for shared memory, pipes and semaphores.
+
+AUTHOR
+    Vincent Pit, "<perl at profvince.com>", <http://www.profvince.com>.
+
+    You can contact me by mail or on #perl @ FreeNode (vincent or
+    Prof_Vince).
+
+BUGS
+    Please report any bugs or feature requests to "bug-ipc-morsesignals at
+    rt.cpan.org", or through the web interface at
+    <http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IPC-MorseSignals>. I
+    will be notified, and then you'll automatically be notified of progress
+    on your bug as I make changes.
+
+SUPPORT
+    You can find documentation for this module with the perldoc command.
+
+        perldoc IPC::MorseSignals
+
+ACKNOWLEDGEMENTS
+    Thanks for the inspiration, mofino ! I hope this module will fill all
+    your IPC needs. :)
+
+COPYRIGHT & LICENSE
+    Copyright 2007-2008 Vincent Pit, all rights reserved.
+
+    This program is free software; you can redistribute it and/or modify it
+    under the same terms as Perl itself.
+
diff --git a/lib/IPC/MorseSignals.pm b/lib/IPC/MorseSignals.pm
new file mode 100644 (file)
index 0000000..8389e5a
--- /dev/null
@@ -0,0 +1,96 @@
+package IPC::MorseSignals;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+IPC::MorseSignals - Communicate between processes with Morse signals.
+
+=head1 VERSION
+
+Version 0.10
+
+=cut
+
+our $VERSION = '0.10';
+
+=head1 SYNOPSIS
+
+    # In the sender process
+    use IPC::MorseSignals::Emitter;
+
+    my $deuce = new IPC::MorseSignals::Emitter speed => 1024;
+    $deuce->post('HLAGH') for 1 .. 3;
+    $deuce->send($pid);
+
+    ...
+
+    # In the receiver process
+    use IPC::MorseSignals::Receiver;
+
+    local %SIG;
+    my $pants = new IPC::MorseSignals::Receiver \%SIG, done => sub {
+     print STDERR "GOT $_[1]\n";
+    };
+
+head1 DESCRIPTION
+
+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.
+
+=over 4
+
+=item L<IPC::MorseSignals::Emitter> is a base class for emitters ;
+
+=item L<IPC::MorseSignals::Receiver> is a base class for receivers ;
+
+=back
+
+But, seriously, use something else for your IPC. :)
+
+=head1 DEPENDENCIES
+
+You need the complete L<Bit::MorseSignals> distribution.
+
+L<Carp> (standard since perl 5), L<POSIX> (idem) and L<Time::HiRes> (since perl 5.7.3) are also required.
+
+=head1 SEE ALSO
+
+L<IPC::MorseSignals::Emitter>, L<IPC::MorseSignals::Receiver>.
+
+L<Bit::MorseSignals>, L<Bit::MorseSignals::Emitter>, L<Bit::MorseSignals::Receiver>.
+
+L<perlipc> for information about signals in perl.
+
+For truly useful IPC, search for shared memory, pipes and semaphores.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-ipc-morsesignals at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IPC-MorseSignals>.  I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc IPC::MorseSignals
+
+=head1 ACKNOWLEDGEMENTS
+
+Thanks for the inspiration, mofino ! I hope this module will fill all your IPC needs. :)
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007-2008 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of IPC::MorseSignals
diff --git a/lib/IPC/MorseSignals/Emitter.pm b/lib/IPC/MorseSignals/Emitter.pm
new file mode 100644 (file)
index 0000000..99fa22f
--- /dev/null
@@ -0,0 +1,165 @@
+package IPC::MorseSignals::Emitter;
+
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+use POSIX qw/SIGUSR1 SIGUSR2/;
+use Time::HiRes qw/usleep/;
+
+use Bit::MorseSignals::Emitter;
+use base qw/Bit::MorseSignals::Emitter/;
+
+=head1 NAME
+
+IPC::MorseSignals::Emitter - Base class for IPC::MorseSignals emitters.
+
+=head1 VERSION
+
+Version 0.10
+
+=cut
+
+our $VERSION = '0.10';
+
+=head1 SYNOPSIS
+
+    use IPC::MorseSignals::Emitter;
+
+    my $deuce = new IPC::MorseSignals::Emitter speed => 1024;
+    $deuce->post('HLAGH') for 1 .. 3;
+    $deuce->send($pid);
+
+=head1 DESCRIPTION
+
+This module sends messages processed by a L<Bit::MorseSignal> emitter to another process as C<SIGUSR1> (for bits 0) and C<SIGUSR2> (for 1) signals.
+
+=cut
+
+sub _check_self {
+ croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
+  unless ref $_[0] and $_[0]->isa(__PACKAGE__);
+}
+
+=head1 METHODS
+
+=head2 C<< new < delay => $seconds, speed => $bauds, %bme_options > >>
+
+Creates a new emitter object. C<delay> specifies the delay between two sends, in seconds, while C<speed> is the number of bits sent per second. The delay value has priority over the speed. Extra arguments are passed to L<Bit::MorseSignals::Emitter/new>.
+
+=cut
+
+sub new {
+ my $class = shift;
+ $class = ref $class || $class || return;
+ croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
+ my %opts = @_;
+ # delay supersedes speed
+ my $delay = delete $opts{delay};       # fractional seconds
+ if (!defined $delay) {
+  my $speed = delete $opts{speed} || 0; # bauds
+  $speed = int $speed;
+  $delay = abs(1 / $speed) if $speed;
+ }
+ my $self = $class->SUPER::new(%opts);
+ $self->{delay} = abs($delay || 1 + 0.0);
+ bless $self, $class;
+}
+
+=head2 C<send $pid>
+
+Sends messages enqueued with L<Bit::MorseSignals::Emitter/post> to the process C<$pid> (or to all the C<@$pid> if C<$pid> is an array reference).
+
+=cut
+
+sub send {
+ my ($self, $dest) = @_;
+ _check_self($self);
+ return unless defined $dest;
+ my @dests = grep $_ > 0, ref $dest eq 'ARRAY' ? map int, grep defined, @$dest
+                                               : int $dest;
+ while (defined(my $bit = $self->pop)) {
+  my @sigs = (SIGUSR1, SIGUSR2);
+  my $d = $self->{delay} * 1_000_000;
+  $d -= usleep $d while $d > 0;
+  kill $sigs[$bit] => @dests;
+ }
+ return unless @dests;
+}
+
+=head2 C<< delay < $seconds > >>
+
+Returns the current delay in seconds, or set it if an argument is provided.
+
+=cut
+
+sub delay {
+ my ($self, $delay) = @_;
+ _check_self($self);
+ $self->{delay} = abs $delay if $delay and $delay += 0.0;
+ return $self->{delay};
+}
+
+=head2 C<< speed < $bauds > >>
+
+Returns the current speed in bauds, or set it if an argument is provided.
+
+=cut
+
+sub speed {
+ my ($self, $speed) = @_;
+ _check_self($self);
+ $self->{delay} = 1 / (abs $speed) if $speed and $speed = int $speed;
+ return int(1 / $self->{delay});
+}
+
+=pod
+
+IPC::MorseSignals::Emitter objects also inherit methods from L<Bit::MorseSignals::Emitter>.
+
+=head1 EXPORT
+
+An object module shouldn't export any function, and so does this one.
+
+=head1 DEPENDENCIES
+
+L<Bit::MorseSignals::Emitter>.
+
+L<Carp> (standard since perl 5), L<POSIX> (idem) and L<Time::HiRes> (since perl 5.7.3) are required.
+
+=head1 SEE ALSO
+
+L<IPC::MorseSignals>, L<IPC::MorseSignals::Receiver>.
+
+L<Bit::MorseSignals>, L<Bit::MorseSignals::Emitter>, L<Bit::MorseSignals::Receiver>.
+
+L<perlipc> for information about signals in perl.
+
+For truly useful IPC, search for shared memory, pipes and semaphores.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-ipc-morsesignals-emitter at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IPC-MorseSignals>.  I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc IPC::MorseSignals::Emitter
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007-2008 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of IPC::MorseSignals::Emitter
diff --git a/lib/IPC/MorseSignals/Receiver.pm b/lib/IPC/MorseSignals/Receiver.pm
new file mode 100644 (file)
index 0000000..4ca5c10
--- /dev/null
@@ -0,0 +1,104 @@
+package IPC::MorseSignals::Receiver;
+
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+
+use Bit::MorseSignals::Receiver;
+use base qw/Bit::MorseSignals::Receiver/;
+
+=head1 NAME
+
+IPC::MorseSignals::Receiver - Base class for IPC::MorseSignals receivers.
+
+=head1 VERSION
+
+Version 0.10
+
+=cut
+
+our $VERSION = '0.10';
+
+=head1 SYNOPSIS
+
+    use IPC::MorseSignals::Receiver;
+
+    local %SIG;
+    my $pants = new IPC::MorseSignals::Receiver \%SIG, done => sub {
+     print STDERR "GOT $_[1]\n";
+    };
+
+=head1 DESCRIPTION
+
+This module installs C<$SIG{qw/USR1 USR2/}> handlers and forwards the bits received to a L<Bit::MorseSignal> receiver.
+
+=head1 METHODS
+
+=head2 C<new>
+
+Creates a new receiver object. Its arguments are passed to L<Bit::MorseSignals::Receiver/new>, in particular the C<done> callback.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $sig   = shift;
+ $class = ref $class || $class || return;
+ croak 'The first argument must be a hash reference to the %SIG hash'
+  unless $sig and ref $sig eq 'HASH';
+ my $self = bless $class->SUPER::new(@_), $class;
+ @{$sig}{qw/USR1 USR2/} = (sub { $self->push(0) }, sub { $self->push(1) });
+ return $self;
+}
+
+=pod
+
+IPC::MorseSignals::Receiver objects also inherit methods from L<Bit::MorseSignals::Receiver>.
+
+=head1 EXPORT
+
+An object module shouldn't export any function, and so does this one.
+
+=head1 DEPENDENCIES
+
+L<Bit::MorseSignals::Receiver>.
+
+L<Carp> (standard since perl 5) is also required.
+
+=head1 SEE ALSO
+
+L<IPC::MorseSignals>, L<IPC::MorseSignals::Emitter>.
+
+L<Bit::MorseSignals>, L<Bit::MorseSignals::Emitter>, L<Bit::MorseSignals::Receiver>.
+
+L<perlipc> for information about signals in perl.
+
+For truly useful IPC, search for shared memory, pipes and semaphores.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
+
+You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-ipc-morsesignals-receiver at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IPC-MorseSignals>.  I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc IPC::MorseSignals::Receiver
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007-2008 Vincent Pit, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of IPC::MorseSignals::Receiver
diff --git a/samples/bench.pl b/samples/bench.pl
new file mode 100755 (executable)
index 0000000..2f7daae
--- /dev/null
@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use POSIX qw/SIGINT SIGTERM SIGKILL SIGHUP EXIT_FAILURE/;
+
+use lib qw{blib/lib t/lib};
+
+use IPC::MorseSignals::TestSuite qw/init bench cleanup/;
+
+my $diag = sub { print STDERR "@_\n" };
+my @res;
+
+init 100;
+
+bench 4,    1,   $diag, \@res;
+bench 4,    4,   $diag, \@res;
+bench 4,    16,  $diag, \@res;
+bench 4,    64,  $diag, \@res;
+bench 4,    256, $diag, \@res;
+bench 16,   1,   $diag, \@res;
+bench 16,   4,   $diag, \@res;
+bench 16,   16,  $diag, \@res;
+bench 16,   64,  $diag, \@res;
+bench 64,   1,   $diag, \@res;
+bench 64,   4,   $diag, \@res;
+bench 64,   16,  $diag, \@res;
+bench 256,  1,   $diag, \@res;
+bench 256,  4,   $diag, \@res;
+bench 1024, 1,   $diag, \@res;
+
+cleanup;
+
+print STDERR "=== Summary ===\n";
+print STDERR "$_\n" for @res;
diff --git a/samples/try.pl b/samples/try.pl
new file mode 100755 (executable)
index 0000000..68388c8
--- /dev/null
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use POSIX qw/pause EXIT_SUCCESS EXIT_FAILURE/;
+
+use lib qw{blib/lib};
+
+use IPC::MorseSignals::Emitter;
+use IPC::MorseSignals::Receiver;
+
+my $pid = fork;
+if (!defined $pid) {
+ die "fork() failed : $!";
+} elsif ($pid == 0) {
+ local %SIG;
+ my $rcv = new IPC::MorseSignals::Receiver \%SIG, done => sub {
+  print STDERR "I, the child, recieved this : $_[1]\n";
+  exit EXIT_SUCCESS;
+ };
+ print STDERR "I'm $$ (the child), and I'm waiting for data...\n";
+ pause while 1;
+ exit EXIT_FAILURE;
+}
+
+print STDERR "I'm $$ (the parent), and I'm gonna send a message to my child $pid.\n";
+
+my $snd = new IPC::MorseSignals::Emitter speed => 1000;
+$snd->post("This message was sent with IPC::MorseSignals");
+$snd->send($pid);
+waitpid $pid, 0;
diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644 (file)
index 0000000..a1bc3b7
--- /dev/null
@@ -0,0 +1,14 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+BEGIN {
+       use_ok( 'IPC::MorseSignals' );
+ use_ok( 'IPC::MorseSignals::Emitter' );
+ use_ok( 'IPC::MorseSignals::Receiver' );
+}
+
+diag( "Testing IPC::MorseSignals $IPC::MorseSignals::VERSION, Perl $], $^X" );
diff --git a/t/02-can.t b/t/02-can.t
new file mode 100644 (file)
index 0000000..a78573e
--- /dev/null
@@ -0,0 +1,19 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 10 + 7;
+
+require IPC::MorseSignals::Emitter;
+
+for (qw/new post pop reset flush busy queued/, qw/new send delay speed/) {
+ ok(IPC::MorseSignals::Emitter->can($_), 'IME can ' . $_);
+}
+
+require IPC::MorseSignals::Receiver;
+
+for (qw/new push reset busy msg/, qw/new/) {
+ ok(IPC::MorseSignals::Receiver->can($_), 'IMR can ' . $_);
+}
+
diff --git a/t/10-sigusr.t b/t/10-sigusr.t
new file mode 100644 (file)
index 0000000..bfe2dc2
--- /dev/null
@@ -0,0 +1,19 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+use POSIX qw/SIGUSR1 SIGUSR2/;
+
+my ($a, $b) = (0, 0);
+
+local $SIG{'USR1'} = sub { ++$a };
+local $SIG{'USR2'} = sub { ++$b };
+
+kill SIGUSR1 => $$;
+ok(($a == 1) && ($b == 0), 'SIGUSR1');
+
+kill SIGUSR2 => $$;
+ok(($a == 1) && ($b == 1), 'SIGUSR2');
diff --git a/t/20-emitter-obj.t b/t/20-emitter-obj.t
new file mode 100644 (file)
index 0000000..97204fe
--- /dev/null
@@ -0,0 +1,51 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 19;
+
+use IPC::MorseSignals::Emitter;
+
+my $deuce = new IPC::MorseSignals::Emitter;
+ok(defined $deuce, 'BME object is defined');
+ok(ref $deuce eq 'IPC::MorseSignals::Emitter', 'IME object is valid');
+ok($deuce->isa('Bit::MorseSignals::Emitter'), 'IME is a BME');
+
+my $fake = { };
+bless $fake, 'IPC::MorseSignal::Hlagh';
+eval { IPC::MorseSignals::Emitter::speed($fake) };
+ok($@ && $@ =~ /^First\s+argument/, "IME methods only apply to IME objects");
+eval { Bit::MorseSignals::Emitter::reset($fake) };
+ok($@ && $@ =~ /^First\s+argument/, "BME methods only apply to BME objects");
+
+ok($deuce->delay == 1, 'default delay is 1');
+ok($deuce->speed == 1, 'default speed is 1');
+
+$deuce->delay(0.1);
+ok(abs($deuce->delay - 0.1) < 0.01, 'set delay is 0.1');
+ok($deuce->speed == 10, 'resulting speed is 10');
+
+$deuce->speed(100);
+ok($deuce->speed == 100, 'set speed is 100');
+ok(abs($deuce->delay - 0.01) < 0.001, 'resulting speed is 0.01');
+
+$deuce = new IPC::MorseSignals::Emitter delay => 0.25;
+ok(abs($deuce->delay - 0.25) < 0.025, 'initial delay is 0.25');
+ok($deuce->speed == 4, 'resulting initial speed is 4');
+
+$deuce = new IPC::MorseSignals::Emitter speed => 40;
+ok($deuce->speed == 40, 'initial speed is 40');
+ok(abs($deuce->delay - 0.025) < 0.0025, 'resulting initial delay is 0.025');
+
+$deuce = new IPC::MorseSignals::Emitter delay => 0.25, speed => 40;
+ok(abs($deuce->delay - 0.25) < 0.025, 'delay supersedes speed');
+
+$deuce = new IPC::MorseSignals::Emitter delay => 0;
+ok($deuce->delay == 1, 'wrong delay results in 1');
+
+$deuce = new IPC::MorseSignals::Emitter speed => 0.1;
+ok($deuce->delay == 1, 'wrong speed results in 1');
+
+$deuce = new IPC::MorseSignals::Emitter delay => 0, speed => -0.1;
+ok($deuce->delay == 1, 'wrong delay and speed result in 1');
diff --git a/t/30-receiver-obj.t b/t/30-receiver-obj.t
new file mode 100644 (file)
index 0000000..a2e4f19
--- /dev/null
@@ -0,0 +1,18 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use IPC::MorseSignals::Receiver;
+
+my $pants = new IPC::MorseSignals::Receiver \%SIG;
+ok(defined $pants, 'IMR object is defined');
+ok(ref $pants eq 'IPC::MorseSignals::Receiver', 'IMR object is valid');
+ok($pants->isa('Bit::MorseSignals::Receiver'), 'IMR is a BMR');
+
+my $fake = { };
+bless $fake, 'IPC::MorseSignal::Hlagh';
+eval { Bit::MorseSignals::Receiver::reset($fake) };
+ok($@ && $@ =~ /^First\s+argument/, "BMR methods only apply to BMR objects");
diff --git a/t/50-self-plain.t b/t/50-self-plain.t
new file mode 100644 (file)
index 0000000..d503113
--- /dev/null
@@ -0,0 +1,26 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+use IPC::MorseSignals::Emitter;
+use IPC::MorseSignals::Receiver;
+
+my @msgs = qw/hlagh hlaghlaghlagh HLAGH HLAGHLAGHLAGH \x{0dd0}\x{00}
+              h\x{00}la\x{00}gh \x{00}\x{ff}\x{ff}\x{00}\x{00}\x{ff}/;
+
+my $deuce = new IPC::MorseSignals::Emitter speed => 1024;
+my $pants = new IPC::MorseSignals::Receiver \%SIG, done => sub {
+ my $cur = shift @msgs;
+ ok($_[1] eq $cur, 'got ' . $_[1] . ', received ' . $cur)
+};
+
+$deuce->post($_) for @msgs;
+$deuce->send($$);
+
+ok(!$deuce->busy, 'emitter is no longer busy after all the messages have been sent');
+ok(!$pants->busy, 'receiver is no longer busy after all the messages have been got');
+
+ok(0, "didn't got $_") for @msgs;
diff --git a/t/51-self-utf8.t b/t/51-self-utf8.t
new file mode 100644 (file)
index 0000000..1b69273
--- /dev/null
@@ -0,0 +1,29 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 7;
+
+use IPC::MorseSignals::Emitter;
+use IPC::MorseSignals::Receiver;
+
+my @msgs = qw/€éèë 月語 x tata たTÂ/;
+
+sub cp { join '.', map ord, split //, $_[0] }
+
+my $deuce = new IPC::MorseSignals::Emitter speed => 1024;
+my $pants = new IPC::MorseSignals::Receiver \%SIG, done => sub {
+ my $cur = shift @msgs;
+ ok($_[1] eq $cur, 'got ' . cp($_[1]) . ', expected ' . cp($cur))
+};
+
+$deuce->post($_) for @msgs;
+$deuce->send($$);
+
+ok(!$deuce->busy, 'emitter is no longer busy after all the messages have been sent');
+ok(!$pants->busy, 'receiver is no longer busy after all the messages have been got');
+
+ok(0, 'didn\'t got ' . cp($_)) for @msgs;
diff --git a/t/52-self-storable.t b/t/52-self-storable.t
new file mode 100644 (file)
index 0000000..6f3933c
--- /dev/null
@@ -0,0 +1,34 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 10;
+
+use IPC::MorseSignals::Emitter;
+use IPC::MorseSignals::Receiver;
+
+my @msgs = (
+ \(undef, -273, 1.4159, 'yes', '¥€$'),
+ [ 5, 6, 7 ],
+ { hlagh => 1, HLAGH => 2 },
+ { lol => [ 'bleh', undef, 4684324 ] },
+);
+$msgs[7]->{wut} = { dong => [ 0 .. 9 ], recurse => $msgs[7] };
+my $i = 0;
+
+my $deuce = new IPC::MorseSignals::Emitter speed => 1024;
+my $pants = new IPC::MorseSignals::Receiver \%SIG, done => sub {
+ my $cur = shift @msgs;
+ is_deeply($_[1], $cur, 'got object ' . $i++);
+};
+
+$deuce->post($_) for @msgs;
+$deuce->send($$);
+
+ok(!$deuce->busy, 'emitter is no longer busy after all the messages have been sent');
+ok(!$pants->busy, 'receiver is no longer busy after all the messages have been got');
+
+ok(0, 'didn\'t got object ' . $i++) for @msgs;
diff --git a/t/60-fork-plain.t b/t/60-fork-plain.t
new file mode 100644 (file)
index 0000000..54b73a7
--- /dev/null
@@ -0,0 +1,25 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+use lib 't/lib';
+use IPC::MorseSignals::TestSuite qw/try init cleanup/;
+
+sub test {
+ my ($desc, @args) = @_;
+ eval { ok(try(@args), $desc) };
+ fail($desc . " (died : $@)") if $@;
+}
+
+my @msgs = qw/hlagh hlaghlaghlagh HLAGH HLAGHLAGHLAGH \x{0dd0}\x{00}
+              h\x{00}la\x{00}gh \x{00}\x{ff}\x{ff}\x{00}\x{00}\x{ff}/;
+
+init 6;
+
+test 'plain' => $_ for @msgs;
+
+cleanup;
+
diff --git a/t/61-fork-utf8.t b/t/61-fork-utf8.t
new file mode 100644 (file)
index 0000000..8ad2011
--- /dev/null
@@ -0,0 +1,26 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 5;
+
+use lib 't/lib';
+use IPC::MorseSignals::TestSuite qw/try init cleanup/;
+
+sub test {
+ my ($desc, @args) = @_;
+ eval { ok(try(@args), $desc) };
+ fail($desc . " (died : $@)") if $@;
+}
+
+my @msgs = qw/€éèë 月語 x tata たTÂ/;
+
+init 6;
+
+test 'plain' => $_ for @msgs;
+
+cleanup;
+
diff --git a/t/62-fork-storable.t b/t/62-fork-storable.t
new file mode 100644 (file)
index 0000000..aeab377
--- /dev/null
@@ -0,0 +1,32 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 8;
+
+use lib 't/lib';
+use IPC::MorseSignals::TestSuite qw/try init cleanup/;
+
+sub test {
+ my ($desc, @args) = @_;
+ eval { ok(try(@args), $desc) };
+ fail($desc . " (died : $@)") if $@;
+}
+
+my @msgs = (
+ \(undef, -273, 1.1, 'yes', '¥€$'),
+ [ 5, 6 ],
+ { hlagh => 1, HLAGH => 2 },
+ { x => -3.573 },
+);
+$msgs[7]->{y} = $msgs[7];
+
+init 6;
+
+test 'plain' => $_ for @msgs;
+
+cleanup;
+
diff --git a/t/70-speed.t b/t/70-speed.t
new file mode 100644 (file)
index 0000000..fc6f031
--- /dev/null
@@ -0,0 +1,29 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 3;
+
+use lib 't/lib';
+use IPC::MorseSignals::TestSuite qw/bench init cleanup/;
+
+my $diag = sub { diag @_ };
+my @res;
+
+init 12;
+
+ok(bench(4,  1, $diag, \@res));
+ok(bench(4,  4, $diag, \@res));
+ok(bench(16, 1, $diag, \@res));
+
+cleanup;
+
+diag '=== Summary ===';
+diag $_ for sort {
+ my ($l1, $n1) = $a =~ /(\d+)\D+(\d+)/;
+ my ($l2, $n2) = $b =~ /(\d+)\D+(\d+)/;
+ $l1 <=> $l2 || $n1 <=> $n2
+} @res;
diff --git a/t/90-boilerplate.t b/t/90-boilerplate.t
new file mode 100644 (file)
index 0000000..ad8c282
--- /dev/null
@@ -0,0 +1,51 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+sub not_in_file_ok {
+    my ($filename, %regex) = @_;
+    open( my $fh, '<', $filename )
+        or die "couldn't open $filename for reading: $!";
+
+    my %violated;
+
+    while (my $line = <$fh>) {
+        while (my ($desc, $regex) = each %regex) {
+            if ($line =~ $regex) {
+                push @{$violated{$desc}||=[]}, $.;
+            }
+        }
+    }
+
+    if (%violated) {
+        fail("$filename contains boilerplate text");
+        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+    } else {
+        pass("$filename contains no boilerplate text");
+    }
+}
+
+sub module_boilerplate_ok {
+    my ($module) = @_;
+    not_in_file_ok($module =>
+        'the great new $MODULENAME'   => qr/ - The great new /,
+        'boilerplate description'     => qr/Quick summary of what the module/,
+        'stub function definition'    => qr/function[12]/,
+    );
+}
+
+not_in_file_ok(README =>
+  "The README is used..."       => qr/The README is used/,
+  "'version information here'"  => qr/to provide version information/,
+);
+
+not_in_file_ok(Changes =>
+  "placeholder date/time"       => qr(Date/time)
+);
+
+module_boilerplate_ok('lib/IPC/MorseSignals.pm');
+module_boilerplate_ok('lib/IPC/MorseSignals/Emitter.pm');
+module_boilerplate_ok('lib/IPC/MorseSignals/Receiver.pm');
diff --git a/t/91-pod.t b/t/91-pod.t
new file mode 100644 (file)
index 0000000..62d2d7f
--- /dev/null
@@ -0,0 +1,13 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();
diff --git a/t/92-pod-coverage.t b/t/92-pod-coverage.t
new file mode 100644 (file)
index 0000000..13665e8
--- /dev/null
@@ -0,0 +1,23 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
+    if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
+    if $@;
+
+all_pod_coverage_ok(
+# also_private => [ qr/^_/ ]
+);
diff --git a/t/95-portability-files.t b/t/95-portability-files.t
new file mode 100644 (file)
index 0000000..ab541f3
--- /dev/null
@@ -0,0 +1,10 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Portability::Files";
+plan skip_all => "Test::Portability::Files required for testing filenames portability" if $@;
+run_tests();
diff --git a/t/99-kwalitee.t b/t/99-kwalitee.t
new file mode 100644 (file)
index 0000000..2bf8079
--- /dev/null
@@ -0,0 +1,11 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+plan(skip_all => 'XXX Testing with 5.8') if $^V lt v5.10;
+
+eval { require Test::Kwalitee; Test::Kwalitee->import() };
+plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
diff --git a/t/lib/IPC/MorseSignals/TestSuite.pm b/t/lib/IPC/MorseSignals/TestSuite.pm
new file mode 100644 (file)
index 0000000..e11025b
--- /dev/null
@@ -0,0 +1,162 @@
+package IPC::MorseSignals::TestSuite;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use POSIX qw/pause SIGINT SIGTERM SIGKILL SIGHUP EXIT_FAILURE/;
+
+use IPC::MorseSignals::Emitter;
+use IPC::MorseSignals::Receiver;
+
+use base qw/Exporter/;
+
+our @EXPORT_OK = qw/try bench init cleanup/;
+
+$Data::Dumper::Indent = 0;
+
+my ($lives, $pid, $rdr);
+
+sub spawn {
+ --$lives;
+ die 'forked too many times' if $lives < 0;
+ pipe $rdr, my $wtr or die "pipe() failed: $!";
+ $pid = fork;
+ if (!defined $pid) {
+  die "fork() failed: $!";
+ } elsif ($pid == 0) {
+  local %SIG;
+  close $rdr or die "close() failed: $!";
+  select $wtr;
+  $| = 1;
+  $SIG{__WARN__} = sub { print $wtr "!warn\n"; };
+  my $rcv = new IPC::MorseSignals::Receiver \%SIG, done => sub {
+   print $wtr Dumper($_[1]), "\n";
+  };
+  my $ppid = getppid;
+  $SIG{ALRM} = sub { alarm 1; kill SIGHUP => $ppid };
+  alarm 1;
+  $SIG{HUP}  = sub { alarm 0; $rcv->reset }; # We can reset the alarm here.
+  pause while 1;
+  exit EXIT_FAILURE;
+ }
+ my $ready = 0;
+ local $SIG{HUP} = sub { $ready = 1 };
+ sleep 1 until $ready;
+ close $wtr or die "close() failed: $!";
+ my $oldfh = select $rdr;
+ $| = 1;
+ select $oldfh;
+}
+
+sub slaughter {
+ if (defined $rdr) {
+  close $rdr or die "close() falied: $!";
+  undef $rdr;
+ }
+ if (defined $pid) {
+  kill SIGINT  => $pid;
+  kill SIGTERM => $pid;
+  kill SIGKILL => $pid;
+  waitpid $pid, 0;
+  undef $pid;
+ }
+}
+
+sub init {
+ ($lives) = @_;
+ $lives ||= 10;
+ undef $pid;
+ undef $rdr;
+ spawn;
+}
+
+sub cleanup { slaughter }
+
+my $snd = new IPC::MorseSignals::Emitter;
+
+sub try {
+ my ($msg) = @_;
+ my $speed = 2 ** 16;
+ my $ok = 0;
+ my @ret;
+ while (!$ok && (($speed /= 2) >= 1)) {
+  my $r = '';
+  my $dump = Dumper($msg);
+  1 while chomp $dump;
+  eval {
+   local $SIG{ALRM} = sub { die 'timeout' };
+   local $SIG{__WARN__} = sub { alarm 0; die 'do not want warnings' };
+   my $a = (int(100 * (3 * length $msg) / $speed) || 1);
+   $a = 10 if $a > 10;
+   alarm $a;
+   kill SIGHUP => $pid;
+   $snd->post($msg);
+   $snd->speed($speed);
+   $snd->send($pid);
+   $r = <$rdr>;
+   alarm 0;
+  };
+  if (!defined $r) { # Something bad happened, respawn
+   slaughter;
+   spawn;
+  } else {
+   1 while chomp $r;
+   if ($r eq $dump) {
+    $ok = 1;
+   } else {
+    kill SIGHUP => $pid;
+   }
+  }
+ }
+ return ($ok) ? $speed : 0;
+}
+
+sub bench {
+ my ($l, $n, $diag, $res) = @_;
+ my $speed = 2 ** 16;
+ my $ok = 0;
+ my @alpha = ('a' .. 'z');
+ my $msg = join '', map { $alpha[rand @alpha] } 1 .. $l;
+ my $dump = Dumper($msg);
+ my $desc_base = "$l bytes sent $n time" . ('s' x ($n != 1));
+ while (($ok < $n) && (($speed /= 2) >= 1)) {
+  $ok = 0;
+  my $desc = "$desc_base at $speed bits/s";
+  $diag->("try $desc...");
+TRY:
+  for (1 .. $n) {
+   my $r = '';
+   eval {
+    local $SIG{ALRM} = sub { die 'timeout' };
+    local $SIG{__WARN__} = sub { alarm 0; die 'do not want warnings' };
+    my $a = (int(100 * (3 * $l) / $speed) || 1);
+    $a = 10 if $a > 10;
+    alarm $a;
+    kill SIGHUP => $pid;
+    $snd->post($msg);
+    $snd->speed($speed);
+    $snd->send($pid);
+    $r = <$rdr>;
+    alarm 0;
+   };
+   if (!defined $r) { # Something bad happened, respawn
+    slaughter;
+    spawn;
+    last TRY;
+   } else {
+    1 while chomp $r;
+    if ($r eq $dump) {
+     ++$ok;
+    } else {
+     kill SIGHUP => $pid;
+     last TRY;
+    }
+   }
+  }
+ }
+ push @$res, $desc_base . (($speed) ? ' at ' . $speed . ' bits/s' : ' failed');
+ return ($ok == $n);
+}
+
+1;