From: Vincent Pit Date: Sun, 29 Jun 2008 16:35:32 +0000 (+0200) Subject: Importing IPC-MorseSignals-0.04.tar.gz X-Git-Tag: v0.04^0 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FIPC-MorseSignals.git;a=commitdiff_plain;h=eccac2c27337a828907205353fc7907da4c3e4a4 Importing IPC-MorseSignals-0.04.tar.gz --- diff --git a/Changes b/Changes index b0b881a..4b26a56 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,15 @@ Revision history for IPC-MorseSignals +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 : 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. + 0.03 2007-08-16 16:20 UTC + Chg : Better t/10-base.t... Or at least, I hope so. diff --git a/MANIFEST b/MANIFEST index 2590699..9230d64 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4,13 +4,14 @@ META.yml # Will be created by "make dist" Makefile.PL README lib/IPC/MorseSignals.pm -samples/tryityourself.pl samples/bench.pl +samples/tryityourself.pl t/00-load.t t/01-import.t t/02-sigusr.t t/10-base.t -t/11-speed.t +t/11-unicode.t +t/12-speed.t t/boilerplate.t t/kwalitee.t t/pod-coverage.t diff --git a/META.yml b/META.yml index b7d2982..0950b53 100644 --- a/META.yml +++ b/META.yml @@ -1,6 +1,6 @@ --- #YAML:1.0 name: IPC-MorseSignals -version: 0.03 +version: 0.04 abstract: Communicate between processes with Morse signals. license: perl generated_by: ExtUtils::MakeMaker version 6.36 diff --git a/Makefile.PL b/Makefile.PL index 35d469a..6e26a00 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -2,6 +2,24 @@ 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"; +} + WriteMakefile( NAME => 'IPC::MorseSignals', AUTHOR => 'Vincent Pit ', diff --git a/README b/README index 32ad19f..222504f 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ NAME IPC::MorseSignals - Communicate between processes with Morse signals. VERSION - Version 0.03 + Version 0.04 SYNOPSIS use IPC::MorseSignals qw/msend mrecv/; @@ -29,23 +29,28 @@ DESCRIPTION FUNCTIONS "msend" - msend $msg, $pid [, $speed ] + msend $msg, $pid [, speed => $speed, utf8 => $utf8 ] 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 - 512, don't set it too low or the target will miss bits and the whole - message will be crippled. + if $pid is an array ref) at $speed bits per second. If the "utf8" flag + 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; "mrecv" - mrecv $callback + mrecv $callback [, utf => $utf8 ] - Takes as its sole argument the callback triggered when a complete + 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 : local @SIG{qw/USR1 USR2/} = mrecv sub { ... }; + Turn on the utf8 flag if you know that the incoming strings are expected + to be in UTF-8. This flag is turned off by default. + EXPORT This module exports on request its two only functions, "msend" and "mrecv". @@ -53,7 +58,7 @@ EXPORT 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 + 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 : @@ -82,7 +87,7 @@ DEPENDENCIES SEE ALSO perlipc for information about signals in perl. - For truely useful IPC, search for shared memory, pipes and semaphores. + For truly useful IPC, search for shared memory, pipes and semaphores. AUTHOR Vincent Pit, "" diff --git a/lib/IPC/MorseSignals.pm b/lib/IPC/MorseSignals.pm index 498cd07..5f61e31 100644 --- a/lib/IPC/MorseSignals.pm +++ b/lib/IPC/MorseSignals.pm @@ -3,6 +3,8 @@ package IPC::MorseSignals; use strict; use warnings; +use utf8; + use Time::HiRes qw/usleep/; use POSIX qw/SIGUSR1 SIGUSR2/; @@ -12,11 +14,11 @@ IPC::MorseSignals - Communicate between processes with Morse signals. =head1 VERSION -Version 0.03 +Version 0.04 =cut -our $VERSION = '0.03'; +our $VERSION = '0.04'; =head1 SYNOPSIS @@ -45,19 +47,27 @@ But, seriously, use something else for your IPC. :) =head2 C - msend $msg, $pid [, $speed ] + 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. Default speed is 512, 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. If the C flag is set, the string will first be encoded in UTF-8. In this case, you must turn it on for L 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 flag is turned off by default; =cut sub msend { - my ($msg, $pid, $speed) = @_; + my ($msg, $pid, @o) = @_; my @pid = (ref $pid eq 'ARRAY') ? @$pid : $pid; - return unless @pid && $msg; - $speed ||= 512; - my $delay = int(1_000_000 / $speed); - my @bits = split //, unpack 'B*', $msg; + return unless @pid && $msg && !(@o % 2); + my %opts = @o; + $opts{speed} ||= 512; + $opts{utf8} ||= 0; + my $delay = int(1_000_000 / $opts{speed}); + my $tpl = 'B*'; + if ($opts{utf8}) { + utf8::encode $msg; + $tpl = 'U0' . $tpl; + } + my @bits = split //, unpack $tpl, $msg; my ($c, $n, @l) = (2, 0, 0, 0, 0); for (@bits) { if ($c == $_) { @@ -81,24 +91,31 @@ sub msend { =head2 C - mrecv $callback + mrecv $callback [, utf => $utf8 ] -Takes as its sole 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 SIGUSR1 and SIGUSR2 signal handlers. Basically, you want to use it like this : local @SIG{qw/USR1 USR2/} = mrecv sub { ... }; +Turn on the utf8 flag if you know that the incoming strings are expected to be in UTF-8. This flag is turned off by default. + =cut sub mrecv { - my ($cb) = @_; - return unless $cb; + my ($cb, @o) = @_; + return unless $cb && !(@o % 2); + my %opts = @o; + $opts{utf8} ||= 0; my ($bits, $state, $c, $n, $end) = ('', 0, undef, 0, ''); my $sighandler = sub { my ($b) = @_; if ($state == 2) { if (defined $bits && (substr $bits, -$n) eq $end) { # done substr $bits, -$n, $n, ''; - $cb->(pack 'B*', $bits); + my $tpl = 'B*'; + $tpl = 'U0' . $tpl if $opts{utf8}; + my $msg = pack $tpl, $bits; + $cb->($msg); } } elsif ($state == 1) { if ($c != $b) { @@ -137,7 +154,7 @@ $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) and 1 (C). 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, C) and 1 (C). A signature is then chosen : =over 4 @@ -165,7 +182,7 @@ L (standard since perl 5) and L (standard since perl 5.7.3) L for information about signals in perl. -For truely useful IPC, search for shared memory, pipes and semaphores. +For truly useful IPC, search for shared memory, pipes and semaphores. =head1 AUTHOR diff --git a/samples/bench.pl b/samples/bench.pl index 45b485b..d45e950 100755 --- a/samples/bench.pl +++ b/samples/bench.pl @@ -3,7 +3,7 @@ use strict; use warnings; -use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS/; +use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS EXIT_FAILURE WIFEXITED WEXITSTATUS/; use lib qw{blib/lib}; @@ -16,67 +16,59 @@ sub tryspeed { my $speed = 2 ** 16; my $ok = 0; my $desc; - while ($speed && $ok < $n) { - $desc = "$n sends of $l bytes at $speed bits/s"; +SPEED: + while (($speed > 1) && ($ok < $n)) { $speed /= 2; + $desc = "$n sends of $l bytes at $speed bits/s"; $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; + exit(($msg eq $_[0]) ? EXIT_SUCCESS : EXIT_FAILURE); }; 1 while 1; + exit EXIT_FAILURE; } - close $wtr or die "$desc: close() failed : $!"; + my $next = 0; eval { local $SIG{ALRM} = sub { die 'timeout' }; my $a = (int(100 * (3 * $l) / $speed) || 1); $a = 10 if $a > 10; alarm $a; - msend $msg => $pid, $speed; + msend $msg => $pid, speed => $speed; waitpid $pid, 0; + if (WIFEXITED($?) && (WEXITSTATUS($?) == EXIT_SUCCESS)) { + ++$ok; + } else { + print STDERR " transfer error\n"; + $next = 1; + } }; 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; + $next = 1; } + next SPEED if $next; } } - if ($speed) { + $desc = "$l bytes sent $n times"; + if ($speed >= 1) { print STDERR " OK\n\n"; - $desc = "$l bytes sent $n times"; push @res, "$desc at $speed bits/s"; + } else { + print STDERR " FAILED\n\n"; + push @res, "$desc FAILED"; } } diff --git a/samples/tryityourself.pl b/samples/tryityourself.pl index 94b90de..8e64510 100755 --- a/samples/tryityourself.pl +++ b/samples/tryityourself.pl @@ -16,5 +16,5 @@ if (!defined $pid) { 1 while 1; } -msend "This message was sent with IPC::MorseSignals\n" => $pid, 1000; +msend "This message was sent with IPC::MorseSignals\n" => $pid; waitpid $pid, 0; diff --git a/t/02-sigusr.t b/t/02-sigusr.t index 8a048e9..abe8376 100644 --- a/t/02-sigusr.t +++ b/t/02-sigusr.t @@ -2,7 +2,7 @@ use Test::More tests => 2; -use POSIX qw/SIGTERM SIGKILL EXIT_FAILURE EXIT_SUCCESS/; +use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS EXIT_FAILURE WIFEXITED WEXITSTATUS/; sub trysig { my ($n, $s) = @_; @@ -12,14 +12,16 @@ sub trysig { } elsif ($pid == 0) { local $SIG{$s} = sub { exit EXIT_SUCCESS }; 1 while 1; + exit EXIT_FAILURE; } - my $ret = EXIT_FAILURE; + sleep 1; + my $ret = 0; eval { local $SIG{ALRM} = sub { die }; alarm 1; kill $n, $pid; waitpid $pid, 0; - $ret = $?; + $ret = (WIFEXITED($?) && (WEXITSTATUS($?) == EXIT_SUCCESS)); alarm 0; }; if ($@) { @@ -28,9 +30,8 @@ sub trysig { kill SIGKILL, $pid; die "$s: $@"; } - ok($ret == EXIT_SUCCESS, $s); + ok($ret, $s); } -sleep 1; trysig SIGUSR1, 'USR1'; trysig SIGUSR2, 'USR2'; diff --git a/t/10-base.t b/t/10-base.t index bc55f14..3eb877c 100644 --- a/t/10-base.t +++ b/t/10-base.t @@ -1,8 +1,8 @@ #!perl -T -use Test::More tests => 7 * 5; +use Test::More tests => 4 * 5; -use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS/; +use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS EXIT_FAILURE WIFEXITED WEXITSTATUS/; use IPC::MorseSignals qw/msend mrecv/; @@ -13,51 +13,37 @@ sub trysend { SPEED: while (($speed > 1) && !$ok) { $speed /= 2; - 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; + exit(($msg eq $_[0]) ? EXIT_SUCCESS : EXIT_FAILURE); }; 1 while 1; + exit EXIT_FAILURE; } - close $wtr or die "$desc: close() failed : $!"; eval { 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; + msend $msg => $pid, speed => $speed; waitpid $pid, 0; + $ok = (WIFEXITED($?) && (WEXITSTATUS($?) == EXIT_SUCCESS)); }; alarm 0; if ($@) { kill SIGINT, $pid; kill SIGTERM, $pid; kill SIGKILL, $pid; - close $rdr or die "$desc: close() failed : $!"; - next SPEED; } - my $recv = do { local $/; <$rdr> }; - close $rdr or die "$desc: close() failed : $!"; - next SPEED unless $recv; - chomp $recv; - next SPEED unless $msg eq $recv; - $ok = 1; } ok($speed >= 1, $desc); } 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-unicode.t b/t/11-unicode.t new file mode 100644 index 0000000..f0c19e4 --- /dev/null +++ b/t/11-unicode.t @@ -0,0 +1,57 @@ +#!perl -T + +use Test::More tests => 7 * 5; + +use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS EXIT_FAILURE WIFEXITED WEXITSTATUS/; + +use IPC::MorseSignals qw/msend mrecv/; + +use utf8; + +sub trysend8 { + my ($msg, $desc) = @_; + my $speed = 2 ** 16; + my $ok = 0; + $desc .= ' (unicode)'; +SPEED: + while (($speed > 1) && !$ok) { + $speed /= 2; + my $pid = fork; + if (!defined $pid) { + die "$desc: fork() failed : $!"; + } elsif ($pid == 0) { + local @SIG{qw/USR1 USR2/} = mrecv sub { + exit(($msg eq $_[0]) ? EXIT_SUCCESS : EXIT_FAILURE); + }, utf8 => 1; + 1 while 1; + exit EXIT_FAILURE; + } + my $ret = EXIT_FAILURE; + eval { + 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 => $speed, utf8 => 1; + waitpid $pid, 0; + $ok = (WIFEXITED($?) && (WEXITSTATUS($?) == EXIT_SUCCESS)); + }; + alarm 0; + if ($@) { + kill SIGINT, $pid; + kill SIGTERM, $pid; + kill SIGKILL, $pid; + } + } + ok($speed >= 1, $desc); +} + +for (1 .. 5) { + trysend8 'hello', 'ascii'; + trysend8 "\0" x 10, 'few bits'; + trysend8 "\x{FF}" x 10, 'lots of bits'; + trysend8 "a\0b", 'null character'; + trysend8 'éàùçà', 'extended'; + trysend8 '€€€', 'unicode'; + trysend8 'a€bécàd€e', 'mixed'; +} diff --git a/t/12-speed.t b/t/12-speed.t new file mode 100644 index 0000000..7d035b3 --- /dev/null +++ b/t/12-speed.t @@ -0,0 +1,72 @@ +#!perl -T + +use Test::More tests => 12; + +use POSIX qw/SIGINT SIGTERM SIGKILL EXIT_SUCCESS EXIT_FAILURE WIFEXITED WEXITSTATUS/; + +use IPC::MorseSignals qw/msend mrecv/; + +my @res; + +sub tryspeed { + my ($l, $n) = @_; + 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; + $desc = "$n sends of $l bytes at $speed bits/s"; + $ok = 0; + diag("try $desc..."); +TRY: + for (1 .. $n) { + my $pid = fork; + if (!defined $pid) { + die "$desc: fork() failed : $!"; + } elsif ($pid == 0) { + local @SIG{qw/USR1 USR2/} = mrecv sub { + exit(($msg eq $_[0]) ? EXIT_SUCCESS : EXIT_FAILURE); + }; + 1 while 1; + exit EXIT_FAILURE; + } + eval { + local $SIG{ALRM} = sub { die 'timeout' }; + my $a = (int(100 * (3 * $l) / $speed) || 1); + $a = 10 if $a > 10; + alarm $a; + msend $msg => $pid, speed => $speed; + waitpid $pid, 0; + $ok += (WIFEXITED($?) && (WEXITSTATUS($?) == EXIT_SUCCESS)); + }; + alarm 0; + if ($@) { + kill SIGINT, $pid; + kill SIGTERM, $pid; + kill SIGKILL, $pid; + last TRY; + } + } + } + $desc = "$l bytes sent $n times"; + ok($speed >= 1, $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;