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