From: Vincent Pit Date: Sun, 29 Jun 2008 16:35:05 +0000 (+0200) Subject: Importing IPC-MorseSignals-0.01.tar.gz X-Git-Tag: v0.01^0 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FIPC-MorseSignals.git;a=commitdiff_plain;h=3cadc28babc49dbbb76ef7ff7344add68f59c3c2 Importing IPC-MorseSignals-0.01.tar.gz --- diff --git a/Changes b/Changes new file mode 100644 index 0000000..46a37ea --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for IPC-MorseSignals + +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 index 0000000..7ce3c31 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,14 @@ +Changes +MANIFEST +META.yml # Will be created by "make dist" +Makefile.PL +README +lib/IPC/MorseSignals.pm +samples/tryityourself.pl +t/00-load.t +t/01-import.t +t/10-base.t +t/boilerplate.t +t/kwalitee.t +t/pod-coverage.t +t/pod.t diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..86062df --- /dev/null +++ b/META.yml @@ -0,0 +1,16 @@ +--- #YAML:1.0 +name: IPC-MorseSignals +version: 0.01 +abstract: Communicate between processes with Morse signals. +license: perl +generated_by: ExtUtils::MakeMaker version 6.36 +distribution_type: module +requires: + POSIX: 0 + Test::More: 0 + Time::HiRes: 0 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.2.html + version: 1.2 +author: + - Vincent Pit diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..35d469a --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,22 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'IPC::MorseSignals', + AUTHOR => 'Vincent Pit ', + LICENSE => 'perl', + VERSION_FROM => 'lib/IPC/MorseSignals.pm', + ABSTRACT_FROM => 'lib/IPC/MorseSignals.pm', + PL_FILES => {}, + PREREQ_PM => { + 'POSIX' => 0, + 'Test::More' => 0, + 'Time::HiRes' => 0, + }, + dist => { + PREOP => 'pod2text lib/IPC/MorseSignals.pm > $(DISTVNAME)/README', + COMPRESS => 'gzip -9f', SUFFIX => 'gz', + }, + clean => { FILES => 'IPC-MorseSignals-*' }, +); diff --git a/README b/README new file mode 100644 index 0000000..221958f --- /dev/null +++ b/README @@ -0,0 +1,86 @@ +NAME + IPC::MorseSignals - Communicate between processes with Morse signals. + +VERSION + Version 0.01 + +SYNOPSIS + use IPC::MorseSignals qw/msend mrecv/; + + my $pid = fork; + if (!defined $pid) { + die "fork() failed: $!"; + } elsif ($pid == 0) { + local @SIG{qw/USR1 USR2/} = mrecv sub { print STDERR "recieved $_[0]!\n" }; + 1 while 1; + } + msend "hello!\n" => $pid; + waitpid $pid, 0; + +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. + + But, seriously, use something else for your IPC. :) + +FUNCTIONS + "msend" + msend $msg, $pid [, $speed ] + + 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 + message will be crippled. + + "mrecv" + mrecv $callback + + 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 : + + local @SIG{qw/USR1 USR2/} = mrecv sub { ... }; + +EXPORT + This module exports on request its two only functions, "msend" and + "mrecv". + +DEPENDENCIES + POSIX (standard since perl 5) and Time::HiRes (standard since perl + 5.7.3) are required. + +SEE ALSO + perlipc for information about signals. + + For truely useful IPC, search for shared memory, pipes and semaphores. + +AUTHOR + Vincent Pit, "" + + You can contact me by mail or on #perl @ FreeNode (Prof_Vince). + +BUGS + Please report any bugs or feature requests to "bug-ipc-morsesignals at + rt.cpan.org", or through the web interface at + . 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 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 index 0000000..ded0f02 --- /dev/null +++ b/lib/IPC/MorseSignals.pm @@ -0,0 +1,177 @@ +package IPC::MorseSignals; + +use strict; +use warnings; + +use Time::HiRes qw/usleep/; +use POSIX qw/SIGUSR1 SIGUSR2/; + +=head1 NAME + +IPC::MorseSignals - Communicate between processes with Morse signals. + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION = '0.01'; + +=head1 SYNOPSIS + + use IPC::MorseSignals qw/msend mrecv/; + + my $pid = fork; + if (!defined $pid) { + die "fork() failed: $!"; + } elsif ($pid == 0) { + local @SIG{qw/USR1 USR2/} = mrecv sub { print STDERR "recieved $_[0]!\n" }; + 1 while 1; + } + msend "hello!\n" => $pid; + waitpid $pid, 0; + +=head1 DESCRIPTION + +This module implements a rare form of IPC by sending Morse-like signals through C and C. It uses both signals C and C, 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. :) + +=head1 FUNCTIONS + +=head2 C + + 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. + +=cut + +sub msend { + my ($msg, $pid, $speed) = @_; + my @pid = (ref $pid eq 'ARRAY') ? @$pid : $pid; + return unless @pid && $msg; + $speed ||= 1000; + my $delay = int(1_000_000 / $speed); + my @bits = split //, unpack 'B*', $msg; + my ($c, $n, @l) = (2, 0, 0, 0, 0); + for (@bits) { + if ($c == $_) { + ++$n; + } else { + if ($n > $l[$c]) { $l[$c] = $n; } + $n = 1; + $c = $_; + } + } + if ($n > $l[$c]) { $l[$c] = $n; } + ($c, $n) = ($l[0] > $l[1]) ? (1, $l[1]) : (0, $l[0]); # Take the smallest + ++$n; + @bits = (($c) x $n, 1 - $c, @bits, 1 - $c, ($c) x $n); + for (@bits) { + my $sig = ($_ == 0) ? SIGUSR1 : SIGUSR2; + usleep $delay; + kill $sig, @pid; + } +} + +=head2 C + + mrecv $callback + +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 : + + local @SIG{qw/USR1 USR2/} = mrecv sub { ... }; + +=cut + +sub mrecv { + my ($cb) = @_; + my ($bits, $state, $c, $n, $end) = ('', 0, undef, 0, undef); + my $sighandler = sub { + my ($b) = @_; + if ($state == 2) { + if ((substr $bits, -$n) eq $end) { # done + substr $bits, -$n, $n, ''; + $cb->(pack 'B*', $bits); + } + } elsif ($state == 1) { + if ($c != $b) { + $state = 2; + $end = (1 - $c) . $c x $n; + $bits = ''; + } + ++$n; + } else { + $c = $b; + $n = 1; + $state = 1; + } + }; + return sub { + $bits .= 0; + $sighandler->(0); + }, sub { + $bits .= 1; + $sighandler->(1); + }; +} + +=head1 EXPORT + +This module exports on request its two only functions, L and L. + +=cut + +use base qw/Exporter/; + +our @EXPORT = (); +our %EXPORT_TAGS = ( 'funcs' => [ qw/msend mrecv/ ] ); +our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; +$EXPORT_TAGS{'all'} = \@EXPORT_OK; + +=head1 DEPENDENCIES + +L (standard since perl 5) and L (standard since perl 5.7.3) are required. + +=head1 SEE ALSO + +L for information about signals. + +For truely useful IPC, search for shared memory, pipes and semaphores. + +=head1 AUTHOR + +Vincent Pit, C<< >> + +You can contact me by mail or on #perl @ FreeNode (Prof_Vince). + +=head1 BUGS + +Please report any bugs or feature requests to +C, or through the web interface at +L. +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 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/samples/tryityourself.pl b/samples/tryityourself.pl new file mode 100755 index 0000000..94b90de --- /dev/null +++ b/samples/tryityourself.pl @@ -0,0 +1,20 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use lib qw!blib/lib!; + +use IPC::MorseSignals qw/msend mrecv/; + +my $pid = fork; +if (!defined $pid) { + die "fork() failed : $!"; +} elsif ($pid == 0) { + local @SIG{qw/USR1 USR2/} = mrecv sub { print STDERR "recieved: $_[0]"; exit }; + print STDERR "child wait for data...\n"; + 1 while 1; +} + +msend "This message was sent with IPC::MorseSignals\n" => $pid, 1000; +waitpid $pid, 0; diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..0138a80 --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,9 @@ +#!perl -T + +use Test::More tests => 1; + +BEGIN { + use_ok( 'IPC::MorseSignals' ); +} + +diag( "Testing IPC::MorseSignals $IPC::MorseSignals::VERSION, Perl $], $^X" ); diff --git a/t/01-import.t b/t/01-import.t new file mode 100644 index 0000000..ec45887 --- /dev/null +++ b/t/01-import.t @@ -0,0 +1,10 @@ +#!perl -T + +use Test::More tests => 2; + +require IPC::MorseSignals; + +for (qw/msend mrecv/) { + eval { Variable::Magic->import($_) }; + ok(!$@, 'import ' . $_); +} diff --git a/t/10-base.t b/t/10-base.t new file mode 100644 index 0000000..628e8f0 --- /dev/null +++ b/t/10-base.t @@ -0,0 +1,48 @@ +#!perl -T + +use Test::More tests => 6; + +use POSIX qw/SIGTERM SIGKILL EXIT_SUCCESS/; + +use IPC::MorseSignals qw/msend mrecv/; + +sub try2send { + my ($msg, $desc) = @_; + pipe $rdr, $wtr or die "pipe() failed : $!"; + my $pid = fork; + if (!defined $pid) { + die "fork() failed : $!"; + } elsif ($pid == 0) { + close $rdr; + local @SIG{qw/USR1 USR2/} = mrecv sub { + print $wtr $_[0], "\n"; + exit EXIT_SUCCESS; + }; + 1 while 1; + } + close $wtr or die "close() failed : $!"; + msend $msg => $pid, 100; + eval { + local $SIG{ALRM} = sub { die }; + alarm 5; + waitpid $pid, 0; + alarm 0; + }; + if ($@) { + kill SIGINT, $pid; + kill SIGTERM, $pid; + kill SIGKILL, $pid; + die "$@ in $desc"; + } + my $recv = do { local $/; <$rdr> }; + close $rdr; + chomp $recv; + 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'; diff --git a/t/boilerplate.t b/t/boilerplate.t new file mode 100644 index 0000000..0e13af4 --- /dev/null +++ b/t/boilerplate.t @@ -0,0 +1,48 @@ +#!perl -T + +use strict; +use warnings; +use Test::More tests => 3; + +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"); + } +} + +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) +); + +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]/, + ); +} + +module_boilerplate_ok('lib/IPC/MorseSignals.pm'); diff --git a/t/kwalitee.t b/t/kwalitee.t new file mode 100644 index 0000000..1e95c3d --- /dev/null +++ b/t/kwalitee.t @@ -0,0 +1,6 @@ +#!perl + +use Test::More; + +eval { require Test::Kwalitee; Test::Kwalitee->import() }; +plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@; diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..703f91d --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,6 @@ +#!perl -T + +use Test::More; +eval "use Test::Pod::Coverage 1.04"; +plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; +all_pod_coverage_ok(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..976d7cd --- /dev/null +++ b/t/pod.t @@ -0,0 +1,6 @@ +#!perl -T + +use Test::More; +eval "use Test::Pod 1.14"; +plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; +all_pod_files_ok();