1 package IPC::MorseSignals;
9 use POSIX qw/SIGUSR1 SIGUSR2/;
10 use Time::HiRes qw/usleep/;
14 IPC::MorseSignals - Communicate between processes with Morse signals.
22 our $VERSION = '0.05';
26 use IPC::MorseSignals qw/msend mrecv/;
30 die "fork() failed: $!";
32 local @SIG{qw/USR1 USR2/} = mrecv sub {
33 print STDERR "received $_[0]!\n";
38 msend "hello!\n" => $pid;
43 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.
45 But, seriously, use something else for your IPC. :)
51 msend $msg, $pid [, speed => $speed, utf8 => $utf8 ]
53 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.
54 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.
59 my ($msg, $pid, @o) = @_;
60 my @pid = (ref $pid eq 'ARRAY') ? @$pid : $pid;
61 return unless defined $msg && length $msg;
62 croak 'No PID was supplied' unless @pid;
63 croak 'Optional arguments must be passed as key => value pairs' if @o % 2;
67 my $delay = int(1_000_000 / $opts{speed});
73 my @bits = split //, unpack $tpl, $msg;
74 my ($c, $n, @l) = (2, 0, 0, 0, 0);
79 if ($n > $l[$c]) { $l[$c] = $n; }
84 if ($n > $l[$c]) { $l[$c] = $n; }
85 ($c, $n) = ($l[0] > $l[1]) ? (1, $l[1]) : (0, $l[0]); # Take the smallest
87 @bits = (($c) x $n, 1 - $c, @bits, 1 - $c, ($c) x $n);
89 my $sig = ($_ == 0) ? SIGUSR1 : SIGUSR2;
97 mrecv $callback [, utf => $utf8 ]
99 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 :
101 local @SIG{qw/USR1 USR2/} = mrecv sub { ... };
103 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.
109 croak 'No callback was specified' unless $cb;
110 croak 'Optional arguments must be passed as key => value pairs' if @o % 2;
113 my ($bits, $state, $c, $n, $end) = ('', 0, undef, 0, '');
114 my $sighandler = sub {
117 if (defined $bits && (substr $bits, -$n) eq $end) { # done
118 substr $bits, -$n, $n, '';
120 $tpl = 'U0' . $tpl if $opts{utf8};
121 my $msg = pack $tpl, $bits;
124 } elsif ($state == 1) {
127 $end = (1 - $c) . $c x $n;
148 This module exports on request its two only functions, L</msend> and L</mrecv>.
152 use base qw/Exporter/;
155 our %EXPORT_TAGS = ( 'funcs' => [ qw/msend mrecv/ ] );
156 our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
157 $EXPORT_TAGS{'all'} = \@EXPORT_OK;
161 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 :
165 =item - If m > n, we take n+1 times 1 follewed by one 0 ;
167 =item - Otherwise, we take m+1 times 0 follewed by one 1.
171 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 reverse order).
173 The receiver knows that the signature has been sent when it has catched at least one 0 and one 1. The signal is completely transferred when it has received for the first time the whole reversed signature.
177 This type of IPC is highly unreliable. Send little data at slow speed if you want it to reach its goal.
179 C<SIGUSR{1,2}> seem to interrupt sleep, so it's not a good idea to transfer data to a sleeping process.
183 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.
187 L<perlipc> for information about signals in perl.
189 For truly useful IPC, search for shared memory, pipes and semaphores.
193 Vincent Pit, C<< <perl at profvince.com> >>
195 You can contact me by mail or on #perl @ FreeNode (Prof_Vince).
199 Please report any bugs or feature requests to
200 C<bug-ipc-morsesignals at rt.cpan.org>, or through the web interface at
201 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IPC-MorseSignals>.
202 I will be notified, and then you'll automatically be notified of progress on
203 your bug as I make changes.
207 You can find documentation for this module with the perldoc command.
209 perldoc IPC::MorseSignals
211 =head1 ACKNOWLEDGEMENTS
213 Thanks for the inspiration, mofino ! I hope this module will fill all your IPC needs. :)
215 =head1 COPYRIGHT & LICENSE
217 Copyright 2007 Vincent Pit, all rights reserved.
219 This program is free software; you can redistribute it and/or modify it
220 under the same terms as Perl itself.
224 1; # End of IPC::MorseSignals