]> git.vpit.fr Git - perl/modules/IPC-MorseSignals.git/blob - lib/IPC/MorseSignals/Emitter.pm
Switch qw delimiters to <>
[perl/modules/IPC-MorseSignals.git] / lib / IPC / MorseSignals / Emitter.pm
1 package IPC::MorseSignals::Emitter;
2
3 use strict;
4 use warnings;
5
6 use Carp        qw<croak>;
7 use POSIX       qw<SIGUSR1 SIGUSR2>;
8 use Time::HiRes qw<usleep>;
9
10 use Bit::MorseSignals::Emitter;
11 use base qw<Bit::MorseSignals::Emitter>;
12
13 =head1 NAME
14
15 IPC::MorseSignals::Emitter - Base class for IPC::MorseSignals emitters.
16
17 =head1 VERSION
18
19 Version 0.16
20
21 =cut
22
23 our $VERSION = '0.16';
24
25 =head1 SYNOPSIS
26
27     use IPC::MorseSignals::Emitter;
28
29     my $deuce = IPC::MorseSignals::Emitter->new(speed => 1024);
30     $deuce->post('HLAGH') for 1 .. 3;
31     $deuce->send($pid);
32
33 =head1 DESCRIPTION
34
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.
36
37 =cut
38
39 sub _check_self {
40  croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
41   unless ref $_[0] and $_[0]->isa(__PACKAGE__);
42 }
43
44 =head1 METHODS
45
46 =head2 C<new>
47
48     my $ime = IPC::MorseSignals::Emitter->new(
49      delay => $seconds,
50      speed => $bauds,
51      %bme_options,
52     );
53
54 Creates a new emitter object.
55 C<delay> specifies the delay between two sends, in seconds, while C<speed> is the number of bits sent per second.
56 The delay value has priority over the speed, and defaults to 1 second.
57 Extra arguments are passed to L<Bit::MorseSignals::Emitter/new>.
58
59 =cut
60
61 sub new {
62  my $class = shift;
63  $class = ref $class || $class || return;
64  croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
65  my %opts = @_;
66  # delay supersedes speed
67  my $delay = delete $opts{delay};       # fractional seconds
68  if (!defined $delay) {
69   my $speed = delete $opts{speed} || 0; # bauds
70   $speed = int $speed;
71   $delay = abs(1 / $speed) if $speed;
72  }
73  my $self = $class->SUPER::new(%opts);
74  $self->{delay} = abs($delay || 1 + 0.0);
75  bless $self, $class;
76 }
77
78 =head2 C<send>
79
80     $ime->send($pid);
81
82 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).
83
84 =cut
85
86 sub send {
87  my ($self, $dest) = @_;
88  _check_self($self);
89  return unless defined $dest;
90  my %count;
91  my @dests = grep $_ > 0 && !$count{$_}++, # Remove duplicates.
92               ref $dest eq 'ARRAY' ? map int, grep defined, @$dest
93                                    : int $dest;
94  return unless @dests;
95  while (defined(my $bit = $self->pop)) {
96   my @sigs = (SIGUSR1, SIGUSR2);
97   my $d = $self->{delay} * 1_000_000;
98   $d -= usleep $d while $d > 0;
99   kill $sigs[$bit] => @dests;
100  }
101 }
102
103 =head2 C<delay>
104
105     my $delay = $ime->delay;
106     $ime->delay($seconds);
107
108 Returns the current delay in seconds, or set it if an argument is provided.
109
110 =cut
111
112 sub delay {
113  my ($self, $delay) = @_;
114  _check_self($self);
115  $self->{delay} = abs $delay if $delay and $delay += 0.0;
116  return $self->{delay};
117 }
118
119 =head2 C<speed>
120
121     my $speed = $ime->speed;
122     $ime->speed($bauds);
123
124 Returns the current speed in bauds, or set it if an argument is provided.
125
126 =cut
127
128 sub speed {
129  my ($self, $speed) = @_;
130  _check_self($self);
131  $self->{delay} = 1 / (abs $speed) if $speed and $speed = int $speed;
132  return int(1 / $self->{delay});
133 }
134
135 =pod
136
137 IPC::MorseSignals::Emitter objects also inherit methods from L<Bit::MorseSignals::Emitter>.
138
139 =head1 EXPORT
140
141 An object module shouldn't export any function, and so does this one.
142
143 =head1 DEPENDENCIES
144
145 L<Bit::MorseSignals::Emitter>.
146
147 L<Carp> (standard since perl 5), L<POSIX> (idem) and L<Time::HiRes> (since perl 5.7.3) are required.
148
149 =head1 SEE ALSO
150
151 L<IPC::MorseSignals>, L<IPC::MorseSignals::Receiver>.
152
153 L<Bit::MorseSignals>, L<Bit::MorseSignals::Emitter>, L<Bit::MorseSignals::Receiver>.
154
155 L<perlipc> for information about signals in perl.
156
157 For truly useful IPC, search for shared memory, pipes and semaphores.
158
159 =head1 AUTHOR
160
161 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
162
163 You can contact me by mail or on C<irc.perl.org> (vincent).
164
165 =head1 BUGS
166
167 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>.
168 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
169
170 =head1 SUPPORT
171
172 You can find documentation for this module with the perldoc command.
173
174     perldoc IPC::MorseSignals::Emitter
175
176 =head1 COPYRIGHT & LICENSE
177
178 Copyright 2007,2008,2013 Vincent Pit, all rights reserved.
179
180 This program is free software; you can redistribute it and/or modify it
181 under the same terms as Perl itself.
182
183 =cut
184
185 1; # End of IPC::MorseSignals::Emitter