--- /dev/null
+blib*
+pm_to_blib*
+
+Makefile{,.old}
+Build
+_build*
+
+*.tar.gz
+Bit-MorseSignals-*
+
+core.*
+*.{c,o,so,bs,out,def,exp}
+
+cover_db
+*.{gcda,gcov,gcno}
+
--- /dev/null
+Revision history for Bit-MorseSignals
+
+0.01 2008-03-01 10:40 GMT
+ First version, released on an unsuspecting world.
+
--- /dev/null
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/Bit/MorseSignals.pm
+lib/Bit/MorseSignals/Emitter.pm
+lib/Bit/MorseSignals/Receiver.pm
+t/00-load.t
+t/01-import.t
+t/02-can.t
+t/20-emitter-obj.t
+t/21-emitter-plain.t
+t/22-emitter-utf8.t
+t/30-receiver-obj.t
+t/31-receiver-plain.t
+t/32-receiver-utf8.t
+t/50-chitchat-plain.t
+t/51-chitchat-utf8.t
+t/52-chitchat-storable.t
+t/90-boilerplate.t
+t/91-pod.t
+t/92-pod-coverage.t
+t/95-portability-files.t
+t/99-kwalitee.t
+META.yml Module meta-data (added by MakeMaker)
--- /dev/null
+--- #YAML:1.0
+name: Bit-MorseSignals
+version: 0.01
+abstract: The MorseSignals protocol.
+license: perl
+author:
+ - Vincent Pit <perl@profvince.com>
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
+ Carp: 0
+ Encode: 0
+ Exporter: 0
+ Storable: 0
+ Test::More: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
--- /dev/null
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Bit::MorseSignals',
+ AUTHOR => 'Vincent Pit <perl@profvince.com>',
+ LICENSE => 'perl',
+ VERSION_FROM => 'lib/Bit/MorseSignals.pm',
+ ABSTRACT_FROM => 'lib/Bit/MorseSignals.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Carp' => 0,
+ 'Encode' => 0,
+ 'Exporter' => 0,
+ 'Storable' => 0,
+ 'Test::More' => 0,
+ },
+ dist => {
+ PREOP => 'pod2text lib/Bit/MorseSignals.pm > $(DISTVNAME)/README',
+ COMPRESS => 'gzip -9f', SUFFIX => 'gz'
+ },
+ clean => { FILES => 'Bit-MorseSignals-*' },
+);
--- /dev/null
+NAME
+ Bit::MorseSignals - The MorseSignals protocol.
+
+VERSION
+ Version 0.01
+
+DESCRIPTION
+ In unidirectionnal communication channels (such as networking or IPC),
+ the main issue is often to know the length of the message. Some possible
+ solutions are fixed-length messages (which is quite cumbersome) or a
+ special ending sequence (but it no longer can appear in the data). This
+ module proposes another solution, by using a begin/end signature
+ specialized for each message.
+
+ An actual implementation is also provided :
+
+ Bit::MorseSignals::Emitter is a base class for emitters ;
+ Bit::MorseSignals::Receiver is a base class for receivers ;
+
+ Go to those pages if you just want the stuff done and don't care about
+ how it gets there.
+
+PROTOCOL
+ Each byte of the data string is converted into its bits sequence, with
+ bits of lowest weight coming first. All those bits sequences are put
+ into the same order as the characters occur in the string.
+
+ The header is composed of three bits (lowest weight coming first) :
+
+ - The 2 first ones denotes the data type : a value of 0 is used for a
+ plain string, 1 for an UTF-8 encoded string, and 2 for a Storable
+ object. See also the "CONSTANTS" sections ;
+ - The third one is reserved. For compatibility reasons, the receiver
+ should for now enforce the message data type to plain when this bit is
+ lit.
+
+ The emitter computes then the longuest sequence of successives 0 (say,
+ m) and 1 (n) in the concatenation of the header and the data. A
+ signature is then chosen :
+
+ - If m > n, we take n+1 times 1 followed by one 0 ;
+ - Otherwise, we take m+1 times 0 followed by one 1.
+
+ The signal is then formed by concatenating the signature, the header,
+ the data bits and the reversed signature (i.e. the bits of the signature
+ in the reverse order).
+
+ a ... a b | t0 t1 r | ... data ... | b a ... a
+ signature | header | data | reversed signature
+
+ 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.
+
+CONSTANTS
+ "BM_DATA_AUTO"
+ Default for non-references messages. Try to guess if the given scalar is
+ an UTF-8 string with "Encode::is_utf8".
+
+ "BM_DATA_PLAIN"
+ Treats the data as a plain string. No extra mangling in done.
+
+ "BM_DATA_UTF8"
+ Treats the data as an UTF-8 string. The string is
+ "Encode::encode_utf8"'d in a binary string before sending, and
+ "Encode::decode_utf8"'d by the receiver.
+
+ "BM_DATA_STORABLE"
+ The scalar, array or hash reference given is "Storable::freeze"'d by the
+ sender and "Storable::thaw"'d by the receiver.
+
+EXPORT
+ The constants "BM_DATA_AUTO", "BM_DATA_PLAIN", "BM_DATA_UTF8" and
+ "BM_DATA_STORABLE" are only exported on request, either by specifying
+ their names or the ':consts' tag.
+
+DEPENDENCIES
+ Carp (standard since perl 5), Encode (since perl 5.007003), Storable
+ (idem).
+
+SEE ALSO
+ Bit::MorseSignals::Emitter, Bit::MorseSignals::Receiver.
+
+AUTHOR
+ Vincent Pit, "<perl at profvince.com>"
+
+ You can contact me by mail or on #perl @ FreeNode (vincent or
+ Prof_Vince).
+
+BUGS
+ Please report any bugs or feature requests to "bug-bit-morsesignals at
+ rt.cpan.org", or through the web interface at
+ <http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Bit-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 Bit::MorseSignals
+
+COPYRIGHT & LICENSE
+ Copyright 2008 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 Bit::MorseSignals;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+Bit::MorseSignals - The MorseSignals protocol.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 DESCRIPTION
+
+In unidirectionnal communication channels (such as networking or IPC), the main issue is often to know the length of the message. Some possible solutions are fixed-length messages (which is quite cumbersome) or a special ending sequence (but it no longer can appear in the data). This module proposes another solution, by using a begin/end signature specialized for each message.
+
+An actual implementation is also provided :
+
+=over 4
+
+=item L<Bit::MorseSignals::Emitter> is a base class for emitters ;
+
+=item L<Bit::MorseSignals::Receiver> is a base class for receivers ;
+
+=back
+
+Go to those pages if you just want the stuff done and don't care about how it gets there.
+
+=head1 PROTOCOL
+
+Each byte of the data string is converted into its bits sequence, with bits of lowest weight coming first. All those bits sequences are put into the same order as the characters occur in the string.
+
+The header is composed of three bits (lowest weight coming first) :
+
+=over 4
+
+=item - The 2 first ones denotes the data type : a value of 0 is used for a plain string, 1 for an UTF-8 encoded string, and 2 for a L<Storable> object. See also the L</CONSTANTS> sections ;
+
+=item - The third one is reserved. For compatibility reasons, the receiver should for now enforce the message data type to plain when this bit is lit.
+
+=back
+
+The emitter computes then the longuest sequence of successives 0 (say, m) and 1 (n) in the concatenation of the header and the data. A signature is then chosen :
+
+=over 4
+
+=item - If m > n, we take n+1 times 1 followed by one 0 ;
+
+=item - Otherwise, we take m+1 times 0 followed by one 1.
+
+=back
+
+The signal is then formed by concatenating the signature, the header, the data bits and the reversed signature (i.e. the bits of the signature in the reverse order).
+
+ a ... a b | t0 t1 r | ... data ... | b a ... a
+ signature | header | data | reversed signature
+
+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.
+
+=head1 CONSTANTS
+
+=cut
+
+use constant {
+ BM_DATA_AUTO => -1,
+ BM_DATA_PLAIN => 0,
+ BM_DATA_UTF8 => 1,
+ BM_DATA_STORABLE => 2,
+};
+
+=head2 C<BM_DATA_AUTO>
+
+Default for non-references messages. Try to guess if the given scalar is an UTF-8 string with C<Encode::is_utf8>.
+
+=head2 C<BM_DATA_PLAIN>
+
+Treats the data as a plain string. No extra mangling in done.
+
+=head2 C<BM_DATA_UTF8>
+
+Treats the data as an UTF-8 string. The string is C<Encode::encode_utf8>'d in a binary string before sending, and C<Encode::decode_utf8>'d by the receiver.
+
+=head2 C<BM_DATA_STORABLE>
+
+The scalar, array or hash reference given is C<Storable::freeze>'d by the sender and C<Storable::thaw>'d by the receiver.
+
+=head1 EXPORT
+
+The constants L</BM_DATA_AUTO>, L</BM_DATA_PLAIN>, L</BM_DATA_UTF8> and L</BM_DATA_STORABLE> are only exported on request, either by specifying their names or the C<':consts'> tag.
+
+=cut
+
+use base qw/Exporter/;
+
+our @EXPORT = ();
+our %EXPORT_TAGS = (
+ 'consts' => [ qw/BM_DATA_AUTO BM_DATA_PLAIN BM_DATA_UTF8 BM_DATA_STORABLE/ ]
+);
+our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
+$EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
+
+=head1 DEPENDENCIES
+
+L<Carp> (standard since perl 5), L<Encode> (since perl 5.007003), L<Storable> (idem).
+
+=head1 SEE ALSO
+
+L<Bit::MorseSignals::Emitter>, L<Bit::MorseSignals::Receiver>.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>
+
+You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-bit-morsesignals at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Bit-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 Bit::MorseSignals
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 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 Bit::MorseSignals
--- /dev/null
+package Bit::MorseSignals::Emitter;
+
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+use Encode qw/encode_utf8 is_utf8/;
+use Storable qw/freeze/;
+
+use Bit::MorseSignals qw/:consts/;
+
+=head1 NAME
+
+Bit::MorseSignals::Emitter - Base class for Bit::MorseSignals emitters.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+ use Bit::MorseSignals;
+
+ my $deuce = new Bit::MorseSignals::Emitter;
+ $deuce->post("hlagh") for 1 .. 3;
+ while (defined(my $bit = $deuce->pop)) {
+ sends_by_some_mean_lets_say_signals($bit);
+ }
+
+=head1 DESCRIPTION
+
+Base class for L<Bit::MorseSignals> emitters. Please refer to this module for more general information about the protocol.
+
+The emitter object enqueues messages and prepares them one by one into L<Bit::MorseSignals> packets. It gives then back the bits of the packet in the order they should be sent.
+
+=cut
+
+sub _check_self {
+ croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
+ unless ref $_[0] and $_[0]->isa(__PACKAGE__);
+}
+
+sub _count_bits {
+ my ($len, $cur, $seq, $lng) = @_[1 .. 4];
+ for (my $i = 0; $i < $len; ++$i) {
+ my $bit = vec $_[0], $i, 1;
+ if ($cur == $bit) {
+ ++$seq;
+ } else {
+ $lng->[$cur] = $seq if $seq > $lng->[$cur];
+ $seq = 1;
+ $cur = $bit;
+ }
+ }
+ $lng->[$cur] = $seq if $seq > $lng->[$cur];
+ return $cur, $seq;
+}
+
+=head1 METHODS
+
+=head2 C<new>
+
+L<Bit::MorseSignal::Emitter> object constructor. Currently does not take any optional argument.
+
+=cut
+
+sub new {
+ my $class = shift;
+ $class = ref $class || $class || return;
+ croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
+ my %opts = @_;
+ my $self = {
+ queue => [],
+ };
+ bless $self, $class;
+ $self->reset;
+ return $self;
+}
+
+=head2 C<< post $msg, [ type => $type ] >>
+
+Adds C<$msg> to the message queue and, if no other message is currently processed, dequeue the oldest item and prepare it. The type is automatically chosen, but you may want to try to force it with the C<type> option : C<$type> is then one of the C<BM_DATA_*> constants listed in L<Bit::MorseSignals/CONSTANTS>
+
+=cut
+
+sub post {
+ my $self = shift;
+ my $msg = shift;
+ _check_self($self);
+ croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
+ my %opts = @_;
+
+ my $type = $opts{type};
+
+ if (defined $msg) {
+
+ my @manglers = (sub { $_[0] }, \&encode_utf8, \&freeze);
+ # BM_DATA_{PLAIN, UTF8, STORABLE}
+ $type = BM_DATA_AUTO unless defined $type and exists $manglers[$type];
+ if (ref $msg) {
+ return if { map { $_ => 1 } qw/CODE GLOB/ }->{ref $msg};
+ $type = BM_DATA_STORABLE;
+ } elsif ($type == BM_DATA_AUTO) {
+ $type = is_utf8($msg) ? BM_DATA_UTF8 : BM_DATA_PLAIN;
+ }
+ $msg = $manglers[$type]->($msg);
+
+ if ($self->{state}) { # Busy/queued, can't handle this message right now.
+ push @{$self->{queue}}, [ $msg, $type ];
+ return -1 if $self->{state} == 2; # Currently sending
+ ($msg, $type) = @{shift @{$self->{queue}}}; # Otherwise something's queued
+ }
+
+ } elsif ($self->{state} == 1) { # No msg was given, but the queue isn't empty.
+
+ ($msg, $type) = @{shift @{$self->{queue}}};
+
+ } else { # Either unused or busy sending.
+
+ return;
+
+ }
+
+ $self->{state} = 2;
+
+ my $head = '';
+ vec($head, 0, 1) = ($type & 2) >> 1;
+ vec($head, 1, 1) = ($type & 1);
+ vec($head, 2, 1) = 0;
+ my $hlen = 3;
+
+ my $len = 8 * length $msg;
+ my @lng = (0, 0, 0);
+ my ($cur, $seq) = _count_bits $head, $hlen, 2, 0, \@lng;
+ ($cur, $seq) = _count_bits $msg, $len, $cur, $seq, \@lng;
+ ($cur, $seq) = ($lng[0] > $lng[1]) ? (1, $lng[1])
+ : (0, $lng[0]); # Take the smallest.
+ ++$seq;
+
+ $self->{len} = 1 + $seq + $hlen + $len + $seq + 1;
+ $self->{buf} = '';
+ my ($i, $j, $k) = (0, 0, 0);
+ vec($self->{buf}, $i++, 1) = $cur for 1 .. $seq;
+ vec($self->{buf}, $i++, 1) = 1 - $cur;
+ vec($self->{buf}, $i++, 1) = vec($head, $j++, 1) for 1 .. $hlen;
+ vec($self->{buf}, $i++, 1) = vec($msg, $k++, 1) for 1 .. $len;
+ vec($self->{buf}, $i++, 1) = 1 - $cur;
+ vec($self->{buf}, $i++, 1) = $cur for 1 .. $seq;
+
+ $self->{pos} = 0;
+
+ return 1;
+}
+
+=head2 C<pop>
+
+If a message is being processed, pops the next bit in the packet. When the message is over, the next in the queue is immediatly prepared and the first bit of the new packet is given back. If the queue is empty, C<undef> is returned. You may want to use this method with the idiom :
+
+ while (defined(my $bit = $deuce->pop)) {
+ ...
+ }
+
+=cut
+
+sub pop {
+ my ($self) = @_;
+ _check_self($self);
+ return if $self->{state} == 0;
+ $self->post if $self->{state} == 1;
+ my $bit = vec $self->{buf}, $self->{pos}++, 1;
+ $self->reset if $self->{pos} >= $self->{len};
+ return $bit;
+}
+
+=head2 C<reset>
+
+Cancels the current transfer, but does not empty the queue.
+
+=cut
+
+sub reset {
+ my ($self) = @_;
+ _check_self($self);
+ $self->{state} = @{$self->{queue}} > 0;
+ @{$self}{qw/buf len pos/} = ();
+ return $self;
+}
+
+=head2 C<flush>
+
+Flushes the queue, but does not cancel the current transfer.
+
+=cut
+
+sub flush {
+ my ($self) = @_;
+ _check_self($self);
+ $self->{queue} = [];
+ return $self;
+}
+
+=head2 C<busy>
+
+True when the emitter is busy, i.e. when a packet is being chunked.
+
+=cut
+
+sub busy {
+ my ($self) = @_;
+ _check_self($self);
+ return $self->{state} >= 2;
+}
+
+=head2 C<queued>
+
+Returns the number of queued items.
+
+=cut
+
+sub queued {
+ my ($self) = @_;
+ _check_self($self);
+ return @{$self->{queue}};
+}
+
+=head1 EXPORT
+
+An object module shouldn't export any function, and so does this one.
+
+=head1 DEPENDENCIES
+
+L<Carp> (standard since perl 5), L<Encode> (since perl 5.007003), L<Storable> (idem).
+
+=head1 SEE ALSO
+
+L<Bit::MorseSignals>, L<Bit::MorseSignals::Receiver>.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>
+
+You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-bit-morsesignals-emitter at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Bit-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 Bit::MorseSignals::Emitter
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 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 Bit::MorseSignals::Emitter
--- /dev/null
+package Bit::MorseSignals::Receiver;
+
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+use Encode qw/decode_utf8/;
+use Storable qw/thaw/;
+
+use Bit::MorseSignals qw/:consts/;
+
+=head1 NAME
+
+Bit::MorseSignals::Receiver - Base class for Bit::MorseSignals receivers.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+ use Bit::MorseSignals;
+
+ my $pants = new Bit::MorseSignals::Receiver done => sub { print "received $_[1]!\n" };
+ while (...) {
+ my $bit = comes_from_somewhere_lets_say_signals();
+ $pants->push($bit);
+ }
+
+=head1 DESCRIPTION
+
+Base class for L<Bit::MorseSignals> receivers. Please refer to this module for more general information about the protocol.
+
+Given a sequence of bits coming from the L<Bit::MorseSignals> protocol, the receiver object detects when a packet has been completed and then reconstructs the original message depending of the datatype specified in the header.
+
+=cut
+
+sub _check_self {
+ croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
+ unless ref $_[0] and $_[0]->isa(__PACKAGE__);
+}
+
+=head1 METHODS
+
+=head2 C<< new [ done => $cb ] >>
+
+L<Bit::MorseSignal::Receiver> object constructor. With the C<'done'> option, you can specify a callback that will be triggered every time a message is completed, and in which C<$_[0]> will be the receiver object and C<$_[1]> the message received.
+
+=cut
+
+sub new {
+ my $class = shift;
+ $class = ref $class || $class || return;
+ croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
+ my %opts = @_;
+ my $self = {
+ msg => undef,
+ done => $opts{done},
+ };
+ bless $self, $class;
+ $self->reset;
+ return $self;
+}
+
+=head2 C<push $bit>
+
+Tells the receiver that you have received the bit C<$bit>. Returns true while the message isn't completed, and C<undef> as soon as it is.
+
+=cut
+
+sub push {
+ my ($self, $bit) = @_;
+ _check_self($self);
+ if (!defined $bit) {
+ $bit = $_;
+ return unless defined $bit;
+ }
+ $bit = $bit ? 1 : 0;
+
+ if ($self->{state} == 3) { # data
+
+ vec($self->{buf}, $self->{len}, 1) = $bit;
+ ++$self->{len};
+ if ($self->{len} >= $self->{sig_len}) {
+ my $res = 1;
+ for (1 .. $self->{sig_len}) {
+ if (vec($self->{buf}, $self->{len} - $_, 1) != vec($self->{sig}, $_-1, 1)) {
+ $res = 0;
+ last;
+ }
+ }
+ if ($res) {
+ my $base = int $self->{sig_len} / 8 + $self->{sig_len} % 8 != 0;
+ substr $self->{buf}, -$base, $base, '';
+ my @demanglers = (sub { $_[0] }, \&decode_utf8, \&thaw );
+ # BM_DATA_{PLAIN, UTF8, STORABLE}
+ $self->{msg} = $demanglers[$self->{type}]->($self->{buf});
+ $self->reset;
+ $self->{done}->($self, $self->{msg}) if $self->{done};
+ return;
+ }
+ }
+
+ } elsif ($self->{state} == 2) { # header
+
+ vec($self->{buf}, $self->{len}++, 1) = $bit;
+ if ($self->{len} >= 3) {
+ my $type = 2 * vec($self->{buf}, 0, 1)
+ + vec($self->{buf}, 1, 1);
+ @{$self}{qw/state type buf len/} = (3, $type, '', 0);
+ }
+
+ } elsif ($self->{state} == 1) { # end of signature
+
+ if ($self->{sig_bit} != $bit) {
+ $self->{state} = 2;
+ }
+ vec($self->{sig}, $self->{sig_len}++, 1) = $bit;
+
+ } else { # first bit
+
+ @{$self}{qw/state sig sig_bit sig_len buf len/}
+ = (1, '', $bit, 1, '', 0 );
+ vec($self->{sig}, 0, 1) = $bit;
+
+ }
+
+ return $self;
+}
+
+=head2 C<reset>
+
+Resets the current receiver state, obliterating any current message being received.
+
+=cut
+
+sub reset {
+ my ($self) = @_;
+ _check_self($self);
+ $self->{state} = 0;
+ @{$self}{qw/sig sig_bit sig_len type buf len/} = ();
+ return $self;
+}
+
+=head2 C<busy>
+
+True when the receiver is in the middle of assembling a message.
+
+=cut
+
+sub busy {
+ my ($self) = @_;
+ _check_self($self);
+ return $self->{state} > 0;
+}
+
+=head2 C<msg>
+
+The last message completed, or C<undef> when no message has been assembled yet.
+
+=cut
+
+sub msg {
+ my ($self) = @_;
+ _check_self($self);
+ return $self->{msg};
+}
+
+=head1 EXPORT
+
+An object module shouldn't export any function, and so does this one.
+
+=head1 DEPENDENCIES
+
+L<Carp> (standard since perl 5), L<Encode> (since perl 5.007003), L<Storable> (idem).
+
+=head1 SEE ALSO
+
+L<Bit::MorseSignals>, L<Bit::MorseSignals::Emitter>.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>
+
+You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-bit-morsesignals-receiver at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Bit-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 Bit::MorseSignals::Receiver
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 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 Bit::MorseSignals::Receiver
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+BEGIN {
+ use_ok( 'Bit::MorseSignals' );
+ use_ok( 'Bit::MorseSignals::Emitter' );
+ use_ok( 'Bit::MorseSignals::Receiver' );
+}
+
+diag( "Testing Bit::MorseSignals $Bit::MorseSignals::VERSION, Perl $], $^X" );
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+require Bit::MorseSignals;
+
+for (qw/BM_DATA_AUTO BM_DATA_PLAIN BM_DATA_UTF8 BM_DATA_STORABLE/) {
+ eval { Bit::MorseSignals->import($_) };
+ ok(!$@, 'import ' . $_);
+}
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 7 + 5;
+
+require Bit::MorseSignals::Emitter;
+
+for (qw/new post pop reset flush busy queued/) {
+ ok(Bit::MorseSignals::Emitter->can($_), 'BME can ' . $_);
+}
+
+require Bit::MorseSignals::Receiver;
+
+for (qw/new push reset busy msg/) {
+ ok(Bit::MorseSignals::Receiver->can($_), 'BMR can ' . $_);
+}
+
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+use Bit::MorseSignals::Emitter;
+
+my $deuce = new Bit::MorseSignals::Emitter;
+ok(defined $deuce, 'BME object is defined');
+ok(ref $deuce eq 'Bit::MorseSignals::Emitter', 'BME object is valid');
+
+my $fake = { };
+bless $fake, 'Bit::MorseSignal::Hlagh';
+eval { Bit::MorseSignals::Emitter::reset($fake) };
+ok($@ && $@ =~ /^First\s+argument/, "BME methods only apply to BME objects");
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use Bit::MorseSignals::Emitter;
+
+my $deuce = new Bit::MorseSignals::Emitter;
+
+my $i;
+sub test_bit {
+ my ($desc, $b, $e) = @_;
+ ok(defined $b && $b == $e,
+ "$desc: bit $i : " . (defined $b ? "got $b, expected $e" : 'undef'));
+ ++$i;
+}
+
+sub test_msg {
+ my ($desc, $exp) = @_;
+ my $last = pop @$exp;
+
+ $i = 0;
+ for (@$exp) {
+ my $b = $deuce->pop;
+ ok($deuce->busy, "$desc: BME object is busy after pop $i");
+ test_bit $desc, $b, $_;
+ }
+
+ my $b = $deuce->pop;
+ ok(!$deuce->busy, "$desc: BME object is no longer busy when over");
+ test_bit $desc, $b, $last;
+}
+
+my $msg = 'x';
+my @exp = split //, '111110' . '000' . '00011110' . '011111';
+
+my $ret = eval { $deuce->post($msg) };
+ok(!$@, "simple post doesn't croak ($@)");
+ok(defined $ret && $ret > 0, 'simple post was successful');
+ok($deuce->busy, 'BME object is busy after simple post');
+ok(!$deuce->queued, 'BME object has no message queued after simple post');
+
+test_msg 'simple post', [ @exp ];
+ok(!defined $deuce->pop, "simple post: message is over");
+
+$ret = eval { $deuce->post($msg) };
+ok(!$@, "first double post doesn't croak ($@)");
+ok(defined $ret && $ret > 0, 'first double post was successful');
+ok($deuce->busy, 'BME object is busy after first double post');
+ok(!$deuce->queued, 'BME object has no message queued after first double post');
+
+$ret = eval { $deuce->post($msg) };
+ok(!$@, "second double post doesn't croak ($@)");
+ok(defined $ret && $ret < 0, 'second double post was queued');
+ok($deuce->busy, 'BME object is busy after second double post');
+ok($deuce->queued, 'BME object has a message queued after second double post');
+
+test_msg 'first double post', [ @exp ];
+ok(!$deuce->busy && $deuce->queued, 'first double post: BME object is no longer busy but still has something in queue between the two posts');
+test_msg 'second double post', [ @exp ];
+ok(!defined $deuce->pop, "second double post: message is over");
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More 'no_plan';
+
+use Bit::MorseSignals qw/BM_DATA_PLAIN/;
+use Bit::MorseSignals::Emitter;
+
+my $deuce = new Bit::MorseSignals::Emitter utf8 => 'DO WANT';
+
+my $i;
+sub test_bit {
+ my ($desc, $b, $e) = @_;
+ ok(defined $b && $b == $e,
+ "$desc: bit $i : " . (defined $b ? "got $b, expected $e" : 'undef'));
+ ++$i;
+}
+
+sub test_msg {
+ my ($desc, $exp) = @_;
+ my $last = pop @$exp;
+
+ $i = 0;
+ for (@$exp) {
+ my $b = $deuce->pop;
+ ok($deuce->busy, "$desc: BME object is busy after pop $i");
+ test_bit $desc, $b, $_;
+ }
+
+ my $b = $deuce->pop;
+ ok(!$deuce->busy, "$desc: BME object is no longer busy when over");
+ test_bit $desc, $b, $last;
+}
+
+my $msg = 'é';
+my @exp = split //, '11110' . '010' . '11000011' . '10010101' . '01111';
+
+my $ret = eval { $deuce->post($msg) };
+ok(!$@, "simple post doesn't croak ($@)");
+ok(defined $ret && $ret > 0, 'simple post was successful');
+ok($deuce->busy, 'BME object is busy after simple post');
+ok(!$deuce->queued, 'BME object has no message queued after simple post');
+
+test_msg 'simple post', [ @exp ];
+ok(!defined $deuce->pop, "simple post: message is over");
+
+$ret = eval { $deuce->post($msg) };
+ok(!$@, "first double post doesn't croak ($@)");
+ok(defined $ret && $ret > 0, 'first double post was successful');
+ok($deuce->busy, 'BME object is busy after first double post');
+ok(!$deuce->queued, 'BME object has no message queued after first double post');
+
+$ret = eval { $deuce->post($msg) };
+ok(!$@, "second double post doesn't croak ($@)");
+ok(defined $ret && $ret < 0, 'second double post was queued');
+ok($deuce->busy, 'BME object is busy after second double post');
+ok($deuce->queued, 'BME object has a message queued after second double post');
+
+test_msg 'first double post', [ @exp ];
+ok(!$deuce->busy && $deuce->queued, 'first double post: BME object is no longer busy but still has something in queue between the two posts');
+test_msg 'second double post', [ @exp ];
+ok(!defined $deuce->pop, "second double post: message is over");
+
+# Force non-utf8
+@exp = split //, '00001' . '000' . '10010111' . '10000';
+
+$ret = eval { $deuce->post($msg, type => BM_DATA_PLAIN); };
+ok(!$@, "forced non-utf8 post doesn't croak ($@)");
+ok(defined $ret && $ret > 0, 'forced non-utf8 post was successful');
+ok($deuce->busy, 'BME object is busy after forced non-utf8 post');
+ok(!$deuce->queued, 'BME object has no message queued after forced non-utf8 post');
+
+test_msg 'forced non-utf8 post', [ @exp ];
+ok(!defined $deuce->pop, "forced non-utf8 post: message is over");
+
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+use Bit::MorseSignals::Receiver;
+
+my $pants = new Bit::MorseSignals::Receiver;
+ok(defined $pants, 'BMR object is defined');
+ok(ref $pants eq 'Bit::MorseSignals::Receiver', 'BMR object is valid');
+
+my $fake = { };
+bless $fake, 'Bit::MorseSignal::Hlagh';
+eval { Bit::MorseSignals::Receiver::reset($fake) };
+ok($@ && $@ =~ /^First\s+argument/, "BMR methods only apply to BMR objects");
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+use Bit::MorseSignals::Receiver;
+
+my $hlagh;
+
+my $pants = new Bit::MorseSignals::Receiver done => sub { $hlagh = $_[1] };
+
+my $msg = 'x';
+my @bits = split //, '111110' . '000' . '00011110' . '011111';
+
+$pants->push for @bits;
+
+ok(defined $hlagh && $hlagh eq $msg, 'message properly received');
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More 'no_plan';
+
+use Bit::MorseSignals::Receiver;
+
+my $hlagh;
+
+my $pants = new Bit::MorseSignals::Receiver done => sub { $hlagh = $_[1] };
+
+my $msg = 'é';
+my @bits = split //, '11110' . '010' . '11000011' . '10010101' . '01111';
+
+$pants->push for @bits;
+
+ok(defined $hlagh && $hlagh eq $msg, 'message properly received');
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+use Bit::MorseSignals::Emitter;
+use Bit::MorseSignals::Receiver;
+
+my @msgs = qw/hlagh hlaghlaghlagh HLAGH HLAGHLAGHLAGH \x{0dd0}\x{00}
+ h\x{00}la\x{00}gh \x{00}\x{ff}\x{ff}\x{00}\x{00}\x{ff}/;
+
+my $deuce = new Bit::MorseSignals::Emitter;
+my $pants = new Bit::MorseSignals::Receiver
+ done => sub { ok($_[1] eq shift @msgs, "got $_[1]") };
+
+$deuce->post($_) for @msgs;
+$pants->push while defined ($_ = $deuce->pop); # ))<>((
+
+ok(!$deuce->busy, 'emitter is no longer busy after all the messages have been sent');
+ok(!$pants->busy, 'receiver is no longer busy after all the messages have been got');
+
+ok(0, "didn\'t got $_") for @msgs;
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 7;
+
+use Bit::MorseSignals::Emitter;
+use Bit::MorseSignals::Receiver;
+
+my @msgs = qw/€éèë 月語 x tata たTÂ/;
+
+sub cp { join '.', map ord, split //, $_[0] }
+
+my $deuce = new Bit::MorseSignals::Emitter;
+my $pants = new Bit::MorseSignals::Receiver done => sub {
+ my $cur = shift @msgs;
+ ok($_[1] eq $cur, 'got ' . cp($_[1]) . ', expected ' . cp($cur));
+};
+
+$deuce->post($_) for @msgs;
+$pants->push while defined ($_ = $deuce->pop); # ))<>((
+
+ok(!$deuce->busy, 'emitter is no longer busy after all the messages have been sent');
+ok(!$pants->busy, 'receiver is no longer busy after all the messages have been got');
+
+ok(0, 'didn\'t got ' . cp($_)) for @msgs;
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 10;
+
+use Bit::MorseSignals qw/BM_DATA_STORABLE/;
+use Bit::MorseSignals::Emitter;
+use Bit::MorseSignals::Receiver;
+
+my @msgs = (
+ \(undef, -273, 1.4159, 'yes', '¥€$'),
+ [ 5, 6, 7 ],
+ { hlagh => 1, HLAGH => 2 },
+ { lol => [ 'bleh', { pants => 0.9999999999, deuce => 1 }, undef, 4684324 ] },
+);
+$msgs[7]->{wut} = { dong => [ 0 .. 99 ], recurse => $msgs[7] };
+my $i = 0;
+
+my $deuce = new Bit::MorseSignals::Emitter;
+my $pants = new Bit::MorseSignals::Receiver done => sub {
+ my $cur = shift @msgs;
+ is_deeply($_[1], $cur, 'got object ' . $i++);
+};
+
+$deuce->post($_) for @msgs;
+$pants->push while defined ($_ = $deuce->pop); # ))<>((
+
+ok(!$deuce->busy, 'emitter is no longer busy after all the messages have been sent');
+ok(!$pants->busy, 'receiver is no longer busy after all the messages have been got');
+
+ok(0, 'didn\'t got object ' . $i++) for @msgs;
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+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");
+ }
+}
+
+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]/,
+ );
+}
+
+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)
+);
+
+module_boilerplate_ok('lib/Bit/MorseSignals.pm');
+module_boilerplate_ok('lib/Bit/MorseSignals/Emitter.pm');
+module_boilerplate_ok('lib/Bit/MorseSignals/Receiver.pm');
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
+ if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
+ if $@;
+
+all_pod_coverage_ok(
+ also_private => [ qr/^_/ ]
+);
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Portability::Files";
+plan skip_all => "Test::Portability::Files required for testing filenames portability" if $@;
+run_tests();
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval { require Test::Kwalitee; Test::Kwalitee->import() };
+plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
projects / perl / modules / Bit-MorseSignals.git / commitdiff