Dave Cross: Still Munging Data With Perl: Online event - Mar 17 Learn more

VPIT / IPC-MorseSignals-0.10 / lib / IPC / MorseSignals / Emitter.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
—
12
13
14
15
16
17
18
19
20
21
22
23
—
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
—
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
—
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
—
89
90
91
92
93
94
95
96
97
98
99
100
101
—
102
103
104
105
106
107
108
109
110
111
112
113
114
—
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165

              
package IPC::MorseSignals::Emitter;
use strict;
use warnings;
use Carp qw/croak/;
use POSIX qw/SIGUSR1 SIGUSR2/;
use Time::HiRes qw/usleep/;
use Bit::MorseSignals::Emitter;
use base qw/Bit::MorseSignals::Emitter/;
=head1 NAME
IPC::MorseSignals::Emitter - Base class for IPC::MorseSignals emitters.
=head1 VERSION
Version 0.10
=cut
our $VERSION = '0.10';
=head1 SYNOPSIS
    use IPC::MorseSignals::Emitter;
    my $deuce = new IPC::MorseSignals::Emitter speed => 1024;
    $deuce->post('HLAGH') for 1 .. 3;
    $deuce->send($pid);
=head1 DESCRIPTION
This module sends messages processed by a L<Bit::MorseSignal> emitter to another process as C<SIGUSR1> (for bits 0) and C<SIGUSR2> (for 1) signals.
=cut
sub _check_self {
 croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
  unless ref $_[0] and $_[0]->isa(__PACKAGE__);
}
=head1 METHODS
=head2 C<< new < delay => $seconds, speed => $bauds, %bme_options > >>
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. Extra arguments are passed to L<Bit::MorseSignals::Emitter/new>.
=cut
sub new {
 my $class = shift;
 $class = ref $class || $class || return;
 croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
 my %opts = @_;
 # delay supersedes speed
 my $delay = delete $opts{delay};       # fractional seconds
 if (!defined $delay) {
  my $speed = delete $opts{speed} || 0; # bauds
  $speed = int $speed;
  $delay = abs(1 / $speed) if $speed;
 }
 my $self = $class->SUPER::new(%opts);
 $self->{delay} = abs($delay || 1 + 0.0);
 bless $self, $class;
}
=head2 C<send $pid>
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).
=cut
sub send {
 my ($self, $dest) = @_;
 _check_self($self);
 return unless defined $dest;
 my @dests = grep $_ > 0, ref $dest eq 'ARRAY' ? map int, grep defined, @$dest
                                               : int $dest;
 while (defined(my $bit = $self->pop)) {
  my @sigs = (SIGUSR1, SIGUSR2);
  my $d = $self->{delay} * 1_000_000;
  $d -= usleep $d while $d > 0;
  kill $sigs[$bit] => @dests;
 }
 return unless @dests;
}
=head2 C<< delay < $seconds > >>
Returns the current delay in seconds, or set it if an argument is provided.
=cut
sub delay {
 my ($self, $delay) = @_;
 _check_self($self);
 $self->{delay} = abs $delay if $delay and $delay += 0.0;
 return $self->{delay};
}
=head2 C<< speed < $bauds > >>
Returns the current speed in bauds, or set it if an argument is provided.
=cut
sub speed {
 my ($self, $speed) = @_;
 _check_self($self);
 $self->{delay} = 1 / (abs $speed) if $speed and $speed = int $speed;
 return int(1 / $self->{delay});
}
=pod
IPC::MorseSignals::Emitter objects also inherit methods from L<Bit::MorseSignals::Emitter>.
=head1 EXPORT
An object module shouldn't export any function, and so does this one.
=head1 DEPENDENCIES
L<Bit::MorseSignals::Emitter>.
L<Carp> (standard since perl 5), L<POSIX> (idem) and L<Time::HiRes> (since perl 5.7.3) are required.
=head1 SEE ALSO
L<IPC::MorseSignals>, L<IPC::MorseSignals::Receiver>.
L<Bit::MorseSignals>, L<Bit::MorseSignals::Emitter>, L<Bit::MorseSignals::Receiver>.
L<perlipc> for information about signals in perl.
For truly useful IPC, search for shared memory, pipes and semaphores.
=head1 AUTHOR
Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
=head1 BUGS
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.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
    perldoc IPC::MorseSignals::Emitter
=head1 COPYRIGHT & LICENSE
Copyright 2007-2008 Vincent Pit, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of IPC::MorseSignals::Emitter