]> git.vpit.fr Git - perl/modules/Bit-MorseSignals.git/blob - MorseSignals/Receiver.pm
Update VPIT::TestHelpers to 15e8aee3
[perl/modules/Bit-MorseSignals.git] / MorseSignals / Receiver.pm
1 package Bit::MorseSignals::Receiver;
2
3 use strict;
4 use warnings;
5
6 use Carp     qw<croak>;
7 use Encode   qw<decode_utf8>;
8 use Storable qw<thaw>;
9
10 use Bit::MorseSignals qw<:consts>;
11
12 =head1 NAME
13
14 Bit::MorseSignals::Receiver - Base class for Bit::MorseSignals receivers.
15
16 =head1 VERSION
17
18 Version 0.08
19
20 =cut
21
22 our $VERSION = '0.08';
23
24 =head1 SYNOPSIS
25
26     use Bit::MorseSignals::Receiver;
27
28     my $pants = Bit::MorseSignals::Receiver->new(done => sub { print "received $_[1]!\n" });
29     while (...) {
30      my $bit = comes_from_somewhere_lets_say_signals();
31      $pants->push($bit);
32     }
33
34 =head1 DESCRIPTION
35
36 Base class for L<Bit::MorseSignals> receivers. Please refer to this module for more general information about the protocol.
37
38 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.
39
40 =cut
41
42 sub _check_self {
43  croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
44   unless ref $_[0] and $_[0]->isa(__PACKAGE__);
45 }
46
47 =head1 METHODS
48
49 =head2 C<< new < done => $cb > >>
50
51 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.
52
53 =cut
54
55 sub new {
56  my $class = shift;
57  return unless $class = ref $class || $class;
58  croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
59  my %opts = @_;
60  my $self = {
61   msg    => undef,
62   done   => $opts{done},
63  };
64  bless $self, $class;
65  $self->reset;
66  return $self;
67 }
68
69 =head2 C<push $bit>
70
71 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.
72
73 =cut
74
75 sub push {
76  my ($self, $bit) = @_;
77  _check_self($self);
78  if (!defined $bit) {
79   $bit = $_;
80   return unless defined $bit;
81  }
82  $bit = $bit ? 1 : 0;
83
84  if ($self->{state} == 3) { # data
85
86   vec($self->{buf}, $self->{len}, 1) = $bit;
87   ++$self->{len};
88   if ($self->{len} >= $self->{sig_len}) {
89    my $res = 1;
90    for (1 .. $self->{sig_len}) {
91     if (vec($self->{buf}, $self->{len} - $_, 1) != vec($self->{sig}, $_-1, 1)) {
92      $res = 0;
93      last;
94     }
95    }
96    if ($res) {
97     my $base = int $self->{sig_len} / 8 + $self->{sig_len} % 8 != 0;
98     substr $self->{buf}, -$base, $base, '';
99     my @demanglers = (sub { $_[0] }, \&decode_utf8, \&thaw  );
100     #        BM_DATA_{PLAIN,         UTF8,          STORABLE}
101     $self->{msg} = defined $demanglers[$self->{type}]
102                     ? do {
103                        local $SIG{__DIE__} = sub { warn @_ };
104                        $demanglers[$self->{type}]->($self->{buf})
105                       }
106                     : $self->{buf};
107     $self->reset;
108     $self->{done}->($self, $self->{msg}) if $self->{done};
109     return;
110    }
111   }
112
113  } elsif ($self->{state} == 2) { # header
114
115   vec($self->{buf}, $self->{len}++, 1) = $bit;
116   if ($self->{len} >= 3) {
117    my $type = 2 * vec($self->{buf}, 1, 1)
118                 + vec($self->{buf}, 0, 1);
119    $type = BM_DATA_PLAIN if vec($self->{buf}, 2, 1);
120    @{$self}{qw<state type buf len>} = (3, $type, '', 0);
121   }
122
123  } elsif ($self->{state} == 1) { # end of signature
124
125   if ($self->{sig_bit} != $bit) {
126    $self->{state} = 2;
127   }
128   vec($self->{sig}, $self->{sig_len}++, 1) = $bit;
129
130  } else { # first bit
131
132   @{$self}{qw<state sig sig_bit sig_len buf len>}
133            = (1,    '', $bit,   1,      '', 0  );
134   vec($self->{sig}, 0, 1) = $bit;
135
136  }
137
138  return $self;
139 }
140
141 =head2 C<reset>
142
143 Resets the current receiver state, obliterating any current message being received.
144
145 =cut
146
147 sub reset {
148  my ($self) = @_;
149  _check_self($self);
150  $self->{state} = 0;
151  @{$self}{qw<sig sig_bit sig_len type buf len>} = ();
152  return $self;
153 }
154
155 =head2 C<busy>
156
157 True when the receiver is in the middle of assembling a message.
158
159 =cut
160
161 sub busy {
162  my ($self) = @_;
163  _check_self($self);
164  return $self->{state} > 0;
165 }
166
167 =head2 C<msg>
168
169 The last message completed, or C<undef> when no message has been assembled yet.
170
171 =cut
172
173 sub msg {
174  my ($self) = @_;
175  _check_self($self);
176  return $self->{msg};
177 }
178
179 =head1 EXPORT
180
181 An object module shouldn't export any function, and so does this one.
182
183 =head1 DEPENDENCIES
184
185 L<Carp> (standard since perl 5), L<Encode> (since perl 5.007003), L<Storable> (idem).
186
187 =head1 SEE ALSO
188
189 L<Bit::MorseSignals>, L<Bit::MorseSignals::Emitter>.
190
191 =head1 AUTHOR
192
193 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
194
195 You can contact me by mail or on C<irc.perl.org> (vincent).
196
197 =head1 BUGS
198
199 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.
200
201 =head1 SUPPORT
202
203 You can find documentation for this module with the perldoc command.
204
205     perldoc Bit::MorseSignals::Receiver
206
207 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Bit-MorseSignals>.
208
209 =head1 COPYRIGHT & LICENSE
210
211 Copyright 2008 Vincent Pit, all rights reserved.
212
213 This program is free software; you can redistribute it and/or modify it
214 under the same terms as Perl itself.
215
216 =cut
217
218 1; # End of Bit::MorseSignals::Receiver