1 package Bit::MorseSignals::Emitter;
7 use Encode qw<encode_utf8 is_utf8>;
8 use Storable qw<freeze>;
10 use Bit::MorseSignals qw<:consts>;
14 Bit::MorseSignals::Emitter - Base class for Bit::MorseSignals emitters.
22 our $VERSION = '0.08';
26 use Bit::MorseSignals::Emitter;
28 my $deuce = Bit::MorseSignals::Emitter->new;
29 $deuce->post("hlagh") for 1 .. 3;
30 while (defined(my $bit = $deuce->pop)) {
31 sends_by_some_mean_lets_say_signals($bit);
36 Base class for L<Bit::MorseSignals> emitters. Please refer to this module for more general information about the protocol.
38 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.
43 croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
44 unless ref $_[0] and $_[0]->isa(__PACKAGE__);
48 my ($len, $cur, $seq, $lng) = @_[1 .. 4];
49 for (my $i = 0; $i < $len; ++$i) {
50 my $bit = vec $_[0], $i, 1;
54 $lng->[$cur] = $seq if $seq > $lng->[$cur];
59 $lng->[$cur] = $seq if $seq > $lng->[$cur];
67 my $bme = Bit::MorseSignals::Emitter->new;
69 L<Bit::MorseSignals::Emitter> object constructor. Currently does not take any optional argument.
75 return unless $class = ref $class || $class;
76 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
88 $bme->post($msg, type => $type);
90 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>
98 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
101 my $type = $opts{type};
105 my @manglers = (sub { $_[0] }, \&encode_utf8, \&freeze);
106 # BM_DATA_{PLAIN, UTF8, STORABLE}
107 $type = BM_DATA_AUTO unless defined $type and exists $manglers[$type];
109 return if { map { $_ => 1 } qw<CODE GLOB> }->{ref $msg};
110 $type = BM_DATA_STORABLE;
111 } elsif ($type == BM_DATA_AUTO) {
112 $type = is_utf8($msg) ? BM_DATA_UTF8 : BM_DATA_PLAIN;
114 $msg = $manglers[$type]->($msg);
116 if ($self->{state}) { # Busy/queued, can't handle this message right now.
117 push @{$self->{queue}}, [ $msg, $type ];
118 return -1 if $self->{state} == 2; # Currently sending
119 ($msg, $type) = @{shift @{$self->{queue}}}; # Otherwise something's queued
122 } elsif ($self->{state} == 1) { # No msg was given, but the queue isn't empty.
124 ($msg, $type) = @{shift @{$self->{queue}}};
126 } else { # Either unused or busy sending.
135 vec($head, 0, 1) = ($type & 1);
136 vec($head, 1, 1) = ($type & 2) >> 1;
137 vec($head, 2, 1) = 0;
140 my $len = 8 * length $msg;
142 my ($cur, $seq) = _count_bits $head, $hlen, 2, 0, \@lng;
143 ($cur, $seq) = _count_bits $msg, $len, $cur, $seq, \@lng;
144 ($cur, $seq) = ($lng[0] > $lng[1]) ? (1, $lng[1])
145 : (0, $lng[0]); # Take the smallest.
148 $self->{len} = 1 + $seq + $hlen + $len + $seq + 1;
150 my ($i, $j, $k) = (0, 0, 0);
151 vec($self->{buf}, $i++, 1) = $cur for 1 .. $seq;
152 vec($self->{buf}, $i++, 1) = 1 - $cur;
153 vec($self->{buf}, $i++, 1) = vec($head, $j++, 1) for 1 .. $hlen;
154 vec($self->{buf}, $i++, 1) = vec($msg, $k++, 1) for 1 .. $len;
155 vec($self->{buf}, $i++, 1) = 1 - $cur;
156 vec($self->{buf}, $i++, 1) = $cur for 1 .. $seq;
165 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 :
167 while (defined(my $bit = $deuce->pop)) {
176 return if $self->{state} == 0;
177 $self->post if $self->{state} == 1;
178 my $bit = vec $self->{buf}, $self->{pos}++, 1;
179 $self->reset if $self->{pos} >= $self->{len};
185 The length of the currently posted message.
197 The number of bits that have already been sent for the current message.
209 Cancels the current transfer, but does not empty the queue.
216 $self->{state} = @{$self->{queue}} > 0;
217 @{$self}{qw<buf len pos>} = ();
223 Flushes the queue, but does not cancel the current transfer.
236 True when the emitter is busy, i.e. when a packet is being chunked.
243 return $self->{state} >= 2;
248 Returns the number of queued items.
255 return @{$self->{queue}};
260 An object module shouldn't export any function, and so does this one.
264 L<Carp> (standard since perl 5), L<Encode> (since perl 5.007003), L<Storable> (idem).
268 L<Bit::MorseSignals>, L<Bit::MorseSignals::Receiver>.
272 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
274 You can contact me by mail or on C<irc.perl.org> (vincent).
278 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.
282 You can find documentation for this module with the perldoc command.
284 perldoc Bit::MorseSignals::Emitter
286 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Bit-MorseSignals>.
288 =head1 COPYRIGHT & LICENSE
290 Copyright 2008 Vincent Pit, all rights reserved.
292 This program is free software; you can redistribute it and/or modify it
293 under the same terms as Perl itself.
297 1; # End of Bit::MorseSignals::Emitter