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.03';
26 use Bit::MorseSignals::Emitter;
28 my $deuce = new Bit::MorseSignals::Emitter;
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 L<Bit::MorseSignals::Emitter> object constructor. Currently does not take any optional argument.
73 $class = ref $class || $class || return;
74 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
84 =head2 C<< post $msg, [ type => $type ] >>
86 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>
94 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
97 my $type = $opts{type};
101 my @manglers = (sub { $_[0] }, \&encode_utf8, \&freeze);
102 # BM_DATA_{PLAIN, UTF8, STORABLE}
103 $type = BM_DATA_AUTO unless defined $type and exists $manglers[$type];
105 return if { map { $_ => 1 } qw/CODE GLOB/ }->{ref $msg};
106 $type = BM_DATA_STORABLE;
107 } elsif ($type == BM_DATA_AUTO) {
108 $type = is_utf8($msg) ? BM_DATA_UTF8 : BM_DATA_PLAIN;
110 $msg = $manglers[$type]->($msg);
112 if ($self->{state}) { # Busy/queued, can't handle this message right now.
113 push @{$self->{queue}}, [ $msg, $type ];
114 return -1 if $self->{state} == 2; # Currently sending
115 ($msg, $type) = @{shift @{$self->{queue}}}; # Otherwise something's queued
118 } elsif ($self->{state} == 1) { # No msg was given, but the queue isn't empty.
120 ($msg, $type) = @{shift @{$self->{queue}}};
122 } else { # Either unused or busy sending.
131 vec($head, 0, 1) = ($type & 2) >> 1;
132 vec($head, 1, 1) = ($type & 1);
133 vec($head, 2, 1) = 0;
136 my $len = 8 * length $msg;
138 my ($cur, $seq) = _count_bits $head, $hlen, 2, 0, \@lng;
139 ($cur, $seq) = _count_bits $msg, $len, $cur, $seq, \@lng;
140 ($cur, $seq) = ($lng[0] > $lng[1]) ? (1, $lng[1])
141 : (0, $lng[0]); # Take the smallest.
144 $self->{len} = 1 + $seq + $hlen + $len + $seq + 1;
146 my ($i, $j, $k) = (0, 0, 0);
147 vec($self->{buf}, $i++, 1) = $cur for 1 .. $seq;
148 vec($self->{buf}, $i++, 1) = 1 - $cur;
149 vec($self->{buf}, $i++, 1) = vec($head, $j++, 1) for 1 .. $hlen;
150 vec($self->{buf}, $i++, 1) = vec($msg, $k++, 1) for 1 .. $len;
151 vec($self->{buf}, $i++, 1) = 1 - $cur;
152 vec($self->{buf}, $i++, 1) = $cur for 1 .. $seq;
161 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 :
163 while (defined(my $bit = $deuce->pop)) {
172 return if $self->{state} == 0;
173 $self->post if $self->{state} == 1;
174 my $bit = vec $self->{buf}, $self->{pos}++, 1;
175 $self->reset if $self->{pos} >= $self->{len};
181 Cancels the current transfer, but does not empty the queue.
188 $self->{state} = @{$self->{queue}} > 0;
189 @{$self}{qw/buf len pos/} = ();
195 Flushes the queue, but does not cancel the current transfer.
208 True when the emitter is busy, i.e. when a packet is being chunked.
215 return $self->{state} >= 2;
220 Returns the number of queued items.
227 return @{$self->{queue}};
232 An object module shouldn't export any function, and so does this one.
236 L<Carp> (standard since perl 5), L<Encode> (since perl 5.007003), L<Storable> (idem).
240 L<Bit::MorseSignals>, L<Bit::MorseSignals::Receiver>.
244 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
246 You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
250 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.
254 You can find documentation for this module with the perldoc command.
256 perldoc Bit::MorseSignals::Emitter
258 =head1 COPYRIGHT & LICENSE
260 Copyright 2008 Vincent Pit, all rights reserved.
262 This program is free software; you can redistribute it and/or modify it
263 under the same terms as Perl itself.
267 1; # End of Bit::MorseSignals::Emitter