X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FIPC%2FMorseSignals.pm;h=50cb85e7754cd48c02bbc211c163520d8c2258dd;hb=accfcdfb12dc278650d05fed5f14d78291e66d97;hp=098dfba19fdf843d81e5a50e809fdb7df9eeb512;hpb=5231a0009f35e98b287dc9633b67bb1de52a23ab;p=perl%2Fmodules%2FIPC-MorseSignals.git

diff --git a/lib/IPC/MorseSignals.pm b/lib/IPC/MorseSignals.pm
index 098dfba..50cb85e 100644
--- a/lib/IPC/MorseSignals.pm
+++ b/lib/IPC/MorseSignals.pm
@@ -6,6 +6,7 @@ use warnings;
 use utf8;
 
 use Carp qw/croak/;
+use Encode;
 use POSIX qw/SIGUSR1 SIGUSR2/;
 use Time::HiRes qw/usleep/;
 
@@ -17,11 +18,11 @@ IPC::MorseSignals - Communicate between processes with Morse signals.
 
 =head1 VERSION
 
-Version 0.06
+Version 0.09
 
 =cut
 
-our $VERSION = '0.06';
+our $VERSION = '0.09';
 
 =head1 SYNOPSIS
 
@@ -50,10 +51,11 @@ But, seriously, use something else for your IPC. :)
 
 =head2 C<msend>
 
-    msend $msg, $pid [, speed => $speed, utf8 => $utf8, sign => $sign ]
+    msend $msg, $pid [, speed => $speed, sign => $sign ]
 
 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. Default speed is 512, don't set it too low or the target will miss bits and the whole message will be crippled.
-If the C<utf8> flag is set (default is unset), the string will first be encoded in UTF-8. The C<utf8> bit of the packet message is turned on, so that the receiver is aware of it. If the C<sign> flag is unset (default is set), the PID of the sender won't be shipped with the packet.
+If the C<sign> flag is unset (default is set), the PID of the sender won't be shipped with the packet.
+UTF-8 encoded strings are automatically detected. The C<utf8> bit of the packet message is turned on, so that the receiver can encode them appropriately.
 
 =cut
 
@@ -65,27 +67,24 @@ sub msend {
  croak 'Optional arguments must be passed as key => value pairs' if @o % 2;
  my %opts = @o;
  $opts{speed} ||= 512;
- $opts{utf8}  ||= 0;
  $opts{sign}    = 1 unless defined $opts{sign};
+ $opts{utf8}    = Encode::is_utf8 $msg;
  my $delay = int(1_000_000 / $opts{speed});
 
- my @head = (
+ # Form the header
+ my @bits = (
   ($opts{utf8} ? 1 : 0),
   ($opts{sign} ? 1 : 0),
  );
  if ($opts{sign}) {
   my $n = 2 ** PID_BITS;
-  push @head, ($$ & $n) ? 1 : 0 while ($n /= 2) >= 1;
+  push @bits, ($$ & $n) ? 1 : 0 while ($n /= 2) >= 1;
  }
 
  my $tpl = 'B*';
- if ($opts{utf8}) {
-  utf8::encode $msg;
-  $tpl = 'U0' . $tpl;
- }
- my @bits = split //, unpack $tpl, $msg;
+ $tpl = 'U0' . $tpl if $opts{utf8};
+ push @bits, split //, unpack $tpl, $msg;
 
- unshift @bits, @head;
  my ($c, $n, @l) = (2, 0, 0, 0, 0);
  for (@bits) {
   if ($c == $_) {
@@ -114,7 +113,7 @@ sub msend {
 
 Takes as its first argument the C<%SIG> hash and returns a hash reference that represent the current state of the receiver. C<%SIG>'s fields C<'USR1'> and C<'USR2'> will be replaced by the receiver's callbacks. C<cb> specifies the callback to trigger each time a complete message has arrived. Basically, you want to use it like this :
 
-    my $rv = mrecv local %SIG, cb => sub { ... };
+    my $rcv = mrecv local %SIG, cb => sub { ... };
 
 In the callback, C<$_[0]> is the sender's PID (or C<0> if the sender wanted to stay anonymous) and C<$_[1]> is the message received.
 
@@ -141,6 +140,7 @@ sub mrecv (\%@) {
     $tpl = 'U0' . $tpl if $s->{utf8};
     $s->{msg} = pack $tpl, $s->{bits};
     mreset $s;
+#    Encode::_utf8_off $s->{msg} if !$s->{utf8}; # Workaround a bug in 5.8.x
     $s->{cb}->(@{$s}{qw/sender msg/}) if $s->{cb};
    }
 
@@ -193,6 +193,7 @@ Resets the state of the receiver C<$rcv>. Useful to abort transfers.
 
 sub mreset {
  my ($rcv) = @_;
+ croak 'Invalid receiver' unless defined $rcv;
  @{$rcv}{qw/state c n bits end utf8 sign/} = (0, undef, 0, '', '', 0, 0);
 }
 
@@ -206,12 +207,13 @@ Returns true if the receiver C<$rcv> is currently busy with incoming data, or fa
 
 sub mbusy {
  my ($rcv) = @_;
+ croak 'Invalid receiver' unless defined $rcv;
  return $rcv->{state} > 0;
 }
 
 =head2 C<mlastsender>
 
-    mlastmsg $rcv
+    mlastsender $rcv
 
 Holds the PID of the last process that sent data to the receiver C<$rcv>, C<0> if that process was anonymous, or C<undef> if no message has arrived yet. It isn't cleared by L</mreset>.
 
@@ -219,6 +221,7 @@ Holds the PID of the last process that sent data to the receiver C<$rcv>, C<0> i
 
 sub mlastsender {
  my ($rcv) = @_;
+ croak 'Invalid receiver' unless defined $rcv;
  return $rcv->{sender};
 }
 
@@ -232,6 +235,7 @@ Holds the last message received by C<$rcv>, or C<undef> if no message has arrive
 
 sub mlastmsg {
  my ($rcv) = @_;
+ croak 'Invalid receiver' unless defined $rcv;
  return $rcv->{msg};
 }
 
@@ -258,9 +262,9 @@ The emitter computes then the longuest sequence of successives 0 (say, m) and 1
 
 =over 4
 
-=item - If m > n, we take n+1 times 1 follewed by one 0 ;
+=item - If m > n, we take n+1 times 1 followed by one 0 ;
 
-=item - Otherwise, we take m+1 times 0 follewed by one 1.
+=item - Otherwise, we take m+1 times 0 followed by one 1.
 
 =back
 
@@ -279,7 +283,7 @@ C<SIGUSR{1,2}> seem to interrupt sleep, so it's not a good idea to transfer data
 
 =head1 DEPENDENCIES
 
-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.
+L<Carp> (standard since perl 5), L<POSIX> (idem), L<utf8> (since perl 5.6), L<Encode> (since perl 5.7.3) and L<Time::HiRes> (idem) are required.
 
 =head1 SEE ALSO