--- /dev/null
+Revision history for IPC-MorseSignals
+
+0.01 2007-08-15 21:20 UTC
+ First version, released on an unsuspecting world.
+
--- /dev/null
+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
--- /dev/null
+--- #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 <perl@profvince.com>
--- /dev/null
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+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 => {
+ '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-*' },
+);
--- /dev/null
+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, "<perl at profvince.com>"
+
+ 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
+ <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 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.
+
--- /dev/null
+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<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.
+
+But, seriously, use something else for your IPC. :)
+
+=head1 FUNCTIONS
+
+=head2 C<msend>
+
+ 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>
+
+ 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</msend> and L</mrecv>.
+
+=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<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.
+
+For truely useful IPC, search for shared memory, pipes and semaphores.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>
+
+You can contact me by mail or on #perl @ FreeNode (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 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
--- /dev/null
+#!/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;
--- /dev/null
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'IPC::MorseSignals' );
+}
+
+diag( "Testing IPC::MorseSignals $IPC::MorseSignals::VERSION, Perl $], $^X" );
--- /dev/null
+#!perl -T
+
+use Test::More tests => 2;
+
+require IPC::MorseSignals;
+
+for (qw/msend mrecv/) {
+ eval { Variable::Magic->import($_) };
+ ok(!$@, 'import ' . $_);
+}
--- /dev/null
+#!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';
--- /dev/null
+#!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');
--- /dev/null
+#!perl
+
+use Test::More;
+
+eval { require Test::Kwalitee; Test::Kwalitee->import() };
+plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
--- /dev/null
+#!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();
--- /dev/null
+#!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();
projects / perl / modules / IPC-MorseSignals.git / commitdiff