1 package IPC::MorseSignals::Emitter;
7 use POSIX qw/SIGUSR1 SIGUSR2/;
8 use Time::HiRes qw/usleep/;
10 use Bit::MorseSignals::Emitter;
11 use base qw/Bit::MorseSignals::Emitter/;
15 IPC::MorseSignals::Emitter - Base class for IPC::MorseSignals emitters.
23 our $VERSION = '0.15';
27 use IPC::MorseSignals::Emitter;
29 my $deuce = new IPC::MorseSignals::Emitter speed => 1024;
30 $deuce->post('HLAGH') for 1 .. 3;
35 This module sends messages processed by an underlying L<Bit::MorseSignal> emitter to another process as a sequence of C<SIGUSR1> (for bits 0) and C<SIGUSR2> (for 1) signals.
40 croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
41 unless ref $_[0] and $_[0]->isa(__PACKAGE__);
46 =head2 C<< new < delay => $seconds, speed => $bauds, %bme_options > >>
48 Creates a new emitter object. C<delay> specifies the delay between two sends, in seconds, while C<speed> is the number of bits sent per second. The delay value has priority over the speed. Default delay is 1 second. Extra arguments are passed to L<Bit::MorseSignals::Emitter/new>.
54 $class = ref $class || $class || return;
55 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
57 # delay supersedes speed
58 my $delay = delete $opts{delay}; # fractional seconds
59 if (!defined $delay) {
60 my $speed = delete $opts{speed} || 0; # bauds
62 $delay = abs(1 / $speed) if $speed;
64 my $self = $class->SUPER::new(%opts);
65 $self->{delay} = abs($delay || 1 + 0.0);
71 Sends messages enqueued with L<Bit::MorseSignals::Emitter/post> to the process C<$pid> (or to all the C<@$pid> if C<$pid> is an array reference, in which case duplicated targets are stripped off).
76 my ($self, $dest) = @_;
78 return unless defined $dest;
80 my @dests = grep $_ > 0 && !$count{$_}++, # Remove duplicates.
81 ref $dest eq 'ARRAY' ? map int, grep defined, @$dest
84 while (defined(my $bit = $self->pop)) {
85 my @sigs = (SIGUSR1, SIGUSR2);
86 my $d = $self->{delay} * 1_000_000;
87 $d -= usleep $d while $d > 0;
88 kill $sigs[$bit] => @dests;
92 =head2 C<< delay < $seconds > >>
94 Returns the current delay in seconds, or set it if an argument is provided.
99 my ($self, $delay) = @_;
101 $self->{delay} = abs $delay if $delay and $delay += 0.0;
102 return $self->{delay};
105 =head2 C<< speed < $bauds > >>
107 Returns the current speed in bauds, or set it if an argument is provided.
112 my ($self, $speed) = @_;
114 $self->{delay} = 1 / (abs $speed) if $speed and $speed = int $speed;
115 return int(1 / $self->{delay});
120 IPC::MorseSignals::Emitter objects also inherit methods from L<Bit::MorseSignals::Emitter>.
124 An object module shouldn't export any function, and so does this one.
128 L<Bit::MorseSignals::Emitter>.
130 L<Carp> (standard since perl 5), L<POSIX> (idem) and L<Time::HiRes> (since perl 5.7.3) are required.
134 L<IPC::MorseSignals>, L<IPC::MorseSignals::Receiver>.
136 L<Bit::MorseSignals>, L<Bit::MorseSignals::Emitter>, L<Bit::MorseSignals::Receiver>.
138 L<perlipc> for information about signals in perl.
140 For truly useful IPC, search for shared memory, pipes and semaphores.
144 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
146 You can contact me by mail or on C<irc.perl.org> (vincent).
150 Please report any bugs or feature requests to C<bug-ipc-morsesignals-emitter at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IPC-MorseSignals>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
154 You can find documentation for this module with the perldoc command.
156 perldoc IPC::MorseSignals::Emitter
158 =head1 COPYRIGHT & LICENSE
160 Copyright 2007-2008 Vincent Pit, all rights reserved.
162 This program is free software; you can redistribute it and/or modify it
163 under the same terms as Perl itself.
167 1; # End of IPC::MorseSignals::Emitter