File Coverage

File:blib/lib/Bit/MorseSignals/Receiver.pm
Coverage:100.0%

linestmtbrancondsubpodtimecode
1package Bit::MorseSignals::Receiver;
2
3
10
10
10
10
45
19
44
use strict;
4
10
10
10
10
56
21
51
use warnings;
5
6
10
10
10
10
60
15
69
use Carp qw/croak/;
7
10
10
10
10
67
16
86
use Encode qw/decode_utf8/;
8
10
10
10
10
61
16
65
use Storable qw/thaw/;
9
10
10
10
10
10
65
16
56
use Bit::MorseSignals qw/:consts/;
11
12 - 20
=head1 NAME

Bit::MorseSignals::Receiver - Base class for Bit::MorseSignals receivers.

=head1 VERSION

Version 0.06

=cut
21
22our $VERSION = '0.06';
23
24 - 40
=head1 SYNOPSIS

    use Bit::MorseSignals::Receiver;

    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
41
42sub _check_self {
43
5692
100
100
5692
63302
 croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
44  unless ref $_[0] and $_[0]->isa(__PACKAGE__);
45}
46
47 - 53
=head1 METHODS

=head2 C<< new < done => $cb > >>

L<Bit::MorseSignals::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
54
55sub new {
56
10
10
1
112
 my $class = shift;
57
10
100
100
104
 return unless $class = ref $class || $class;
58
9
100
61
 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
59
8
31
 my %opts = @_;
60
8
45
 my $self = {
61  msg => undef,
62  done => $opts{done},
63 };
64
8
56
 bless $self, $class;
65
8
30
 $self->reset;
66
8
32
 return $self;
67}
68
69 - 73
=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
74
75sub push {
76
5648
5648
1
19495
 my ($self, $bit) = @_;
77
5648
17812
 _check_self($self);
78
5646
100
22906
 if (!defined $bit) {
79
5623
13340
  $bit = $_;
80
5623
100
21387
  return unless defined $bit;
81 }
82
5645
100
19805
 $bit = $bit ? 1 : 0;
83
84
5645
100
100
100
25610
 if ($self->{state} == 3) { # data
85
86
5397
25932
  vec($self->{buf}, $self->{len}, 1) = $bit;
87
5397
15203
  ++$self->{len};
88
5397
100
29758
  if ($self->{len} >= $self->{sig_len}) {
89
5249
12417
   my $res = 1;
90
5249
23556
   for (1 .. $self->{sig_len}) {
91
9731
100
87631
    if (vec($self->{buf}, $self->{len} - $_, 1) != vec($self->{sig}, $_-1, 1)) {
92
5224
11998
     $res = 0;
93
5224
10676
     last;
94    }
95   }
96
5249
100
20475
   if ($res) {
97
25
178
    my $base = int $self->{sig_len} / 8 + $self->{sig_len} % 8 != 0;
98
25
119
    substr $self->{buf}, -$base, $base, '';
99
25
9
9
164
44
    my @demanglers = (sub { $_[0] }, \&decode_utf8, \&thaw );
100    # BM_DATA_{PLAIN, UTF8, STORABLE}
101    $self->{msg} = defined $demanglers[$self->{type}]
102
25
100
133
                    ? do {
103
24
2
2
148
3
                       local $SIG{__DIE__} = sub { warn @_ };
104
24
153
                       $demanglers[$self->{type}]->($self->{buf})
105                      }
106                    : $self->{buf};
107
24
386
    $self->reset;
108
24
100
191
    $self->{done}->($self, $self->{msg}) if $self->{done};
109
24
206
    return;
110   }
111  }
112
113 } elsif ($self->{state} == 2) { # header
114
115
75
385
  vec($self->{buf}, $self->{len}++, 1) = $bit;
116
75
100
363
  if ($self->{len} >= 3) {
117
25
168
   my $type = 2 * vec($self->{buf}, 1, 1)
118                + vec($self->{buf}, 0, 1);
119
25
100
125
   $type = BM_DATA_PLAIN if vec($self->{buf}, 2, 1);
120
25
25
132
112
   @{$self}{qw/state type buf len/} = (3, $type, '', 0);
121  }
122
123 } elsif ($self->{state} == 1) { # end of signature
124
125
148
100
693
  if ($self->{sig_bit} != $bit) {
126
25
85
   $self->{state} = 2;
127  }
128
148
818
  vec($self->{sig}, $self->{sig_len}++, 1) = $bit;
129
130 } else { # first bit
131
132
25
25
149
121
  @{$self}{qw/state sig sig_bit sig_len buf len/}
133           = (1, '', $bit, 1, '', 0 );
134
25
126
  vec($self->{sig}, 0, 1) = $bit;
135
136 }
137
138
5620
31058
 return $self;
139}
140
141 - 145
=head2 C<reset>

Resets the current receiver state, obliterating any current message being received.

=cut
146
147sub reset {
148
35
35
1
119
 my ($self) = @_;
149
35
118
 _check_self($self);
150
33
110
 $self->{state} = 0;
151
33
33
151
139
 @{$self}{qw/sig sig_bit sig_len type buf len/} = ();
152
33
90
 return $self;
153}
154
155 - 159
=head2 C<busy>

True when the receiver is in the middle of assembling a message.

=cut
160
161sub busy {
162
5
5
1
20
 my ($self) = @_;
163
5
18
 _check_self($self);
164
3
20
 return $self->{state} > 0;
165}
166
167 - 171
=head2 C<msg>

The last message completed, or C<undef> when no message has been assembled yet.

=cut
172
173sub msg {
174
4
4
1
21
 my ($self) = @_;
175
4
12
 _check_self($self);
176
2
12
 return $self->{msg};
177}
178
179 - 216
=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> >>, L<http://www.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

Tests code coverage report is available at L<http://www.profvince.com/perl/cover/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
217
2181; # End of Bit::MorseSignals::Receiver