lib/IPC/MorseSignals.pm

   1 package IPC::MorseSignals;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Time::HiRes qw/usleep/;
   7 use POSIX qw/SIGUSR1 SIGUSR2/;
   8
   9 =head1 NAME
  10
  11 IPC::MorseSignals - Communicate between processes with Morse signals.
  12
  13 =head1 VERSION
  14
  15 Version 0.02
  16
  17 =cut
  18
  19 our $VERSION = '0.02';
  20
  21 =head1 SYNOPSIS
  22
  23     use IPC::MorseSignals qw/msend mrecv/;
  24
  25     my $pid = fork;
  26     if (!defined $pid) {
  27      die "fork() failed: $!";
  28     } elsif ($pid == 0) {
  29      local @SIG{qw/USR1 USR2/} = mrecv sub {
  30       print STDERR "received $_[0]!\n";
  31       exit
  32      };
  33      1 while 1;
  34     }
  35     msend "hello!\n" => $pid;
  36     waitpid $pid, 0;
  37
  38 =head1 DESCRIPTION
  39
  40 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.
  41
  42 But, seriously, use something else for your IPC. :)
  43
  44 =head1 FUNCTIONS
  45
  46 =head2 C<msend>
  47
  48     msend $msg, $pid [, $speed ]
  49
  50 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.
  51
  52 =cut
  53
  54 sub msend {
  55  my ($msg, $pid, $speed) = @_;
  56  my @pid = (ref $pid eq 'ARRAY') ? @$pid : $pid;
  57  return unless @pid && $msg;
  58  $speed ||= 512;
  59  my $delay = int(1_000_000 / $speed);
  60  my @bits = split //, unpack 'B*', $msg;
  61  my ($c, $n, @l) = (2, 0, 0, 0, 0);
  62  for (@bits) {
  63   if ($c == $_) {
  64    ++$n;
  65   } else {
  66    if ($n > $l[$c]) { $l[$c] = $n; }
  67    $n = 1;
  68    $c = $_;
  69   }
  70  }
  71  if ($n > $l[$c]) { $l[$c] = $n; }
  72  ($c, $n) = ($l[0] > $l[1]) ? (1, $l[1]) : (0, $l[0]); # Take the smallest
  73  ++$n;
  74  @bits = (($c) x $n, 1 - $c, @bits, 1 - $c, ($c) x $n);
  75  for (@bits) {
  76   my $sig = ($_ == 0) ? SIGUSR1 : SIGUSR2;
  77   usleep $delay;
  78   kill $sig, @pid;
  79  }
  80 }
  81
  82 =head2 C<mrecv>
  83
  84     mrecv $callback
  85
  86 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 :
  87
  88     local @SIG{qw/USR1 USR2/} = mrecv sub { ... };
  89
  90 =cut
  91
  92 sub mrecv {
  93  my ($cb) = @_;
  94  return unless $cb;
  95  my ($bits, $state, $c, $n, $end) = ('', 0, undef, 0, '');
  96  my $sighandler = sub {
  97   my ($b) = @_;
  98   if ($state == 2) {
  99    if (defined $bits && (substr $bits, -$n) eq $end) { # done
 100     substr $bits, -$n, $n, '';
 101     $cb->(pack 'B*', $bits);
 102    }
 103   } elsif ($state == 1) {
 104    if ($c != $b) {
 105     $state = 2;
 106     $end = (1 - $c) . $c x $n;
 107     $bits = '';
 108    }
 109    ++$n;
 110   } else {
 111    $c = $b;
 112    $n = 1;
 113    $state = 1;
 114   }
 115  };
 116  return sub {
 117   $bits .= 0;
 118   $sighandler->(0);
 119  }, sub {
 120   $bits .= 1;
 121   $sighandler->(1);
 122  };
 123 }
 124
 125 =head1 EXPORT
 126
 127 This module exports on request its two only functions, L</msend> and L</mrecv>.
 128
 129 =cut
 130
 131 use base qw/Exporter/;
 132
 133 our @EXPORT         = ();
 134 our %EXPORT_TAGS    = ( 'funcs' => [ qw/msend mrecv/ ] );
 135 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 136 $EXPORT_TAGS{'all'} = \@EXPORT_OK;
 137
 138 =head1 PROTOCOL
 139
 140 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<m>) and 1 (C<n>). A signature is then chosen :
 141
 142 =over 4
 143
 144 =item If C(m > n), we take C<n+1> times 1 follewed by C<1> 0 ;
 145
 146 =item Otherwise, we take C<m+1> times 0 follewed by C<1> 1.
 147
 148 =back
 149
 150 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).
 151
 152 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.
 153
 154 =head1 CAVEATS
 155
 156 This type of IPC is highly unreliable. Send little data at slow speed if you want it to reach its goal.
 157
 158 SIGUSR{1,2} seem to interrupt sleep, so it's not a good idea to transfer data to a sleeping process.
 159
 160 =head1 DEPENDENCIES
 161
 162 L<POSIX> (standard since perl 5) and L<Time::HiRes> (standard since perl 5.7.3) are required.
 163
 164 =head1 SEE ALSO
 165
 166 L<perlipc> for information about signals in perl.
 167
 168 For truely useful IPC, search for shared memory, pipes and semaphores.
 169
 170 =head1 AUTHOR
 171
 172 Vincent Pit, C<< <perl at profvince.com> >>
 173
 174 You can contact me by mail or on #perl @ FreeNode (Prof_Vince).
 175
 176 =head1 BUGS
 177
 178 Please report any bugs or feature requests to
 179 C<bug-ipc-morsesignals at rt.cpan.org>, or through the web interface at
 180 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IPC-MorseSignals>.
 181 I will be notified, and then you'll automatically be notified of progress on
 182 your bug as I make changes.
 183
 184 =head1 SUPPORT
 185
 186 You can find documentation for this module with the perldoc command.
 187
 188     perldoc IPC::MorseSignals
 189
 190 =head1 ACKNOWLEDGEMENTS
 191
 192 Thanks for the inspiration, mofino ! I hope this module will fill all your IPC needs. :)
 193
 194 =head1 COPYRIGHT & LICENSE
 195
 196 Copyright 2007 Vincent Pit, all rights reserved.
 197
 198 This program is free software; you can redistribute it and/or modify it
 199 under the same terms as Perl itself.
 200
 201 =cut
 202
 203 1; # End of IPC::MorseSignals