Bit-MorseSignals
view release on metacpan or search on metacpan
lib/Bit/MorseSignals/Emitter.pm view on Meta::CPAN
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 & 1);
vec($head, 1, 1) = ($type & 2) >> 1;
lib/Bit/MorseSignals/Emitter.pm view on Meta::CPAN
=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
lib/Bit/MorseSignals/Receiver.pm view on Meta::CPAN
=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
#!perl -T
use strict;
use warnings;
use Test::More tests => 9 + 5;
require Bit::MorseSignals::Emitter;
for (qw<new post pop len pos 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 ' . $_);
}
t/20-emitter-obj.t view on Meta::CPAN
my $deuce2 = $deuce->new;
ok(defined $deuce2, 'BME::new called as an object method works' );
is(ref $deuce2, 'Bit::MorseSignals::Emitter', 'BME::new called as an object method works is valid');
ok(!defined Bit::MorseSignals::Emitter::new(), 'BME::new called without a class is invalid');
eval { $deuce2 = Bit::MorseSignals::Emitter->new(qw<a b c>) };
like($@, qr/Optional\s+arguments/, 'BME::new gets parameters as key => value pairs');
my $fake = { };
bless $fake, 'Bit::MorseSignal::Hlagh';
for (qw<post pop len pos reset flush busy queued>) {
eval "Bit::MorseSignals::Emitter::$_('Bit::MorseSignals::Emitter')";
like($@, qr/^First\s+argument/, "BME::$_ isn't a class method");
eval "Bit::MorseSignals::Emitter::$_(\$fake)";
like($@, qr/^First\s+argument/, "BME::$_ only applies to BME objects");
}
eval { $deuce->post('foo', qw<a b c>) };
like($@, qr/Optional\s+arguments/, 'BME::post gets parameters after the first as key => value pairs');
ok(!defined($deuce->post(sub { 1 })), 'BME::post doesn\'t take CODE references');
ok(!defined($deuce->post(\*STDERR)), 'BME::post doesn\'t take GLOB references');
t/21-emitter-plain.t view on Meta::CPAN
my $deuce = Bit::MorseSignals::Emitter->new;
sub test_msg {
my ($desc, $exp, $try_post) = @_;
my $len = @$exp;
my $last = pop @$exp;
my $i = 0;
for (@$exp) {
is($deuce->pos, $deuce->busy ? $i : undef, "$desc: BME position is correct");
my $b = $deuce->pop;
if ($try_post) {
ok(!defined($deuce->post), "$desc: posting undef while sending returns undef");
is($deuce->post('what'), -1, "$desc: posting while sending enqueues");
$deuce->flush;
is($deuce->queued, 0, "$desc: flushing dequeues");
}
is($deuce->len, $len, "$desc: BME length is correct");
ok($deuce->busy, "$desc: BME object is busy after pop $i");
is($b, $_, "$desc: bit $i is correct");
++$i;
}
my $b = $deuce->pop;
ok(!$deuce->busy, "$desc: BME object is no longer busy when over");
is($b, $last, "$desc: last bit is correct");
}
my $msg = 'x';
my @exp = split //, '111110' . '000' . '00011110' . '011111';
my $ret = eval { $deuce->post($msg, type => 4675412) }; # defaults to PLAIN
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 ], 1;
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");
my $exp1 = join '', @exp;
my $msg2 = 'y';
my $exp2 = '00001' . '000' . '10011110' . '10000';
my $msg3 = 'z';
my $exp3 = '000001' . '000' . '01011110' . '100000';
$deuce->post($msg);
$deuce->post($msg2);
my $s = ''; $s .= $deuce->pop for 1 .. length $exp1;
is($s, $exp1, 'first send successful');
ok(!$deuce->busy, 'after the first send, the emitter isn\'t busy anymore' );
is($deuce->queued, 1, 'after the fist send, the emitter has still one item queued');
isnt($deuce->post($msg3), -1, 'posting between the two messages doesn\'t return -1');
ok($deuce->busy, 'after the new post, the emitter is busy, ready to send');
is($deuce->queued, 1, 'after the new post, there\'s a new element in the queue');
$s = ''; $s .= $deuce->pop for 1 .. length $exp2;
is($s, $exp2, 'second send successful');
$s = ''; $s .= $deuce->pop for 1 .. length $exp3;
is($s, $exp3, 'third send successful');
t/22-emitter-utf8.t view on Meta::CPAN
my $deuce = Bit::MorseSignals::Emitter->new(utf8 => 'DO WANT');
sub test_msg {
my ($desc, $exp) = @_;
my $last = pop @$exp;
my $i = 0;
for (@$exp) {
my $b = $deuce->pop;
ok($deuce->busy, "$desc: BME object is busy after pop $i");
is($b, $_, "$desc: bit $i is correct");
}
my $b = $deuce->pop;
ok(!$deuce->busy, "$desc: BME object is no longer busy when over");
is($b, $last, "$desc: last bit is correct");
}
my $msg = 'é';
my @exp = split //, '11110' . '100' . '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");
t/30-receiver-obj.t view on Meta::CPAN
my $pants2 = $pants->new;
ok(defined $pants2, 'BMR::new called as an object method works' );
is(ref $pants2, 'Bit::MorseSignals::Receiver', 'BMR::new called as an object method works is valid');
ok(!defined Bit::MorseSignals::Receiver::new(), 'BMR::new called without a class is invalid');
eval { $pants2 = Bit::MorseSignals::Receiver->new(qw<a b c>) };
like($@, qr/Optional\s+arguments/, 'BME::new gets parameters as key => value pairs');
my $fake = { };
bless $fake, 'Bit::MorseSignal::Hlagh';
for (qw<push reset busy msg>) {
eval "Bit::MorseSignals::Receiver::$_('Bit::MorseSignals::Receiver')";
like($@, qr/^First\s+argument/, "BMR::$_ isn't a class method");
eval "Bit::MorseSignals::Receiver::$_(\$fake)";
like($@, qr/^First\s+argument/, "BMR::$_ only applies to BMR objects");
}
{
local $_;
ok(!defined($pants->push), 'BMR::push returns undef when \$_ isn\'t defined');
}
t/50-chitchat-plain.t view on Meta::CPAN
my $deuce = Bit::MorseSignals::Emitter->new;
my $pants = Bit::MorseSignals::Receiver->new(done => sub {
my $cur = shift @msgs;
is($_[1], $cur, 'received message is correct');
});
$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;
t/51-chitchat-utf8.t view on Meta::CPAN
my $deuce = Bit::MorseSignals::Emitter->new;
my $pants = Bit::MorseSignals::Receiver->new(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;
t/52-chitchat-storable.t view on Meta::CPAN
my $deuce = Bit::MorseSignals::Emitter->new;
my $pants = Bit::MorseSignals::Receiver->new(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;
( run in 0.426 second using v1.01-cache-2.11-cpan-87723dcf8b7 )