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.
37 Please refer to this module for more general information about the protocol.
39 The emitter object enqueues messages and prepares them one by one into L<Bit::MorseSignals> packets.
40 It gives then back the bits of the packet in the order they should be sent.
45 croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
46 unless ref $_[0] and $_[0]->isa(__PACKAGE__);
50 my ($len, $cur, $seq, $lng) = @_[1 .. 4];
51 for (my $i = 0; $i < $len; ++$i) {
52 my $bit = vec $_[0], $i, 1;
56 $lng->[$cur] = $seq if $seq > $lng->[$cur];
61 $lng->[$cur] = $seq if $seq > $lng->[$cur];
69 my $bme = Bit::MorseSignals::Emitter->new;
71 L<Bit::MorseSignals::Emitter> object constructor.
72 Currently does not take any optional argument.
78 return unless $class = ref $class || $class;
79 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
91 $bme->post($msg, type => $type);
93 Adds C<$msg> to the message queue and, if no other message is currently processed, dequeue the oldest item and prepare it.
94 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>
102 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
105 my $type = $opts{type};
109 my @manglers = (sub { $_[0] }, \&encode_utf8, \&freeze);
110 # BM_DATA_{PLAIN, UTF8, STORABLE}
111 $type = BM_DATA_AUTO unless defined $type and exists $manglers[$type];
113 return if { map { $_ => 1 } qw<CODE GLOB> }->{ref $msg};
114 $type = BM_DATA_STORABLE;
115 } elsif ($type == BM_DATA_AUTO) {
116 $type = is_utf8($msg) ? BM_DATA_UTF8 : BM_DATA_PLAIN;
118 $msg = $manglers[$type]->($msg);
120 if ($self->{state}) { # Busy/queued, can't handle this message right now.
121 push @{$self->{queue}}, [ $msg, $type ];
122 return -1 if $self->{state} == 2; # Currently sending
123 ($msg, $type) = @{shift @{$self->{queue}}}; # Otherwise something's queued
126 } elsif ($self->{state} == 1) { # No msg was given, but the queue isn't empty.
128 ($msg, $type) = @{shift @{$self->{queue}}};
130 } else { # Either unused or busy sending.
139 vec($head, 0, 1) = ($type & 1);
140 vec($head, 1, 1) = ($type & 2) >> 1;
141 vec($head, 2, 1) = 0;
144 my $len = 8 * length $msg;
146 my ($cur, $seq) = _count_bits $head, $hlen, 2, 0, \@lng;
147 ($cur, $seq) = _count_bits $msg, $len, $cur, $seq, \@lng;
148 ($cur, $seq) = ($lng[0] > $lng[1]) ? (1, $lng[1])
149 : (0, $lng[0]); # Take the smallest.
152 $self->{len} = 1 + $seq + $hlen + $len + $seq + 1;
154 my ($i, $j, $k) = (0, 0, 0);
155 vec($self->{buf}, $i++, 1) = $cur for 1 .. $seq;
156 vec($self->{buf}, $i++, 1) = 1 - $cur;
157 vec($self->{buf}, $i++, 1) = vec($head, $j++, 1) for 1 .. $hlen;
158 vec($self->{buf}, $i++, 1) = vec($msg, $k++, 1) for 1 .. $len;
159 vec($self->{buf}, $i++, 1) = 1 - $cur;
160 vec($self->{buf}, $i++, 1) = $cur for 1 .. $seq;
169 If a message is being processed, pops the next bit in the packet.
170 When the message is over, the next in the queue is immediatly prepared and the first bit of the new packet is given back.
171 If the queue is empty, C<undef> is returned.
172 You may want to use this method with the idiom :
174 while (defined(my $bit = $deuce->pop)) {
183 return if $self->{state} == 0;
184 $self->post if $self->{state} == 1;
185 my $bit = vec $self->{buf}, $self->{pos}++, 1;
186 $self->reset if $self->{pos} >= $self->{len};
192 The length of the currently posted message.
204 The number of bits that have already been sent for the current message.
216 Cancels the current transfer, but does not empty the queue.
223 $self->{state} = @{$self->{queue}} > 0;
224 @{$self}{qw<buf len pos>} = ();
230 Flushes the queue, but does not cancel the current transfer.
243 True when the emitter is busy, i.e. when a packet is being chunked.
250 return $self->{state} >= 2;
255 Returns the number of queued items.
262 return @{$self->{queue}};
267 An object module shouldn't export any function, and so does this one.
271 L<Carp> (standard since perl 5), L<Encode> (since perl 5.7.3), L<Storable> (idem).
275 L<Bit::MorseSignals>, L<Bit::MorseSignals::Receiver>.
279 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
281 You can contact me by mail or on C<irc.perl.org> (vincent).
285 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>.
286 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
290 You can find documentation for this module with the perldoc command.
292 perldoc Bit::MorseSignals::Emitter
294 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Bit-MorseSignals>.
296 =head1 COPYRIGHT & LICENSE
298 Copyright 2008 Vincent Pit, all rights reserved.
300 This program is free software; you can redistribute it and/or modify it
301 under the same terms as Perl itself.
305 1; # End of Bit::MorseSignals::Emitter