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. 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>.
  55
  56 =cut
  57
  58 sub new {
  59  my $class = shift;
  60  $class = ref $class || $class || return;
  61  croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
  62  my %opts = @_;
  63  # delay supersedes speed
  64  my $delay = delete $opts{delay};       # fractional seconds
  65  if (!defined $delay) {
  66   my $speed = delete $opts{speed} || 0; # bauds
  67   $speed = int $speed;
  68   $delay = abs(1 / $speed) if $speed;
  69  }
  70  my $self = $class->SUPER::new(%opts);
  71  $self->{delay} = abs($delay || 1 + 0.0);
  72  bless $self, $class;
  73 }
  74
  75 =head2 C<send>
  76
  77     $ime->send($pid);
  78
  79 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).
  80
  81 =cut
  82
  83 sub send {
  84  my ($self, $dest) = @_;
  85  _check_self($self);
  86  return unless defined $dest;
  87  my %count;
  88  my @dests = grep $_ > 0 && !$count{$_}++, # Remove duplicates.
  89               ref $dest eq 'ARRAY' ? map int, grep defined, @$dest
  90                                    : int $dest;
  91  return unless @dests;
  92  while (defined(my $bit = $self->pop)) {
  93   my @sigs = (SIGUSR1, SIGUSR2);
  94   my $d = $self->{delay} * 1_000_000;
  95   $d -= usleep $d while $d > 0;
  96   kill $sigs[$bit] => @dests;
  97  }
  98 }
  99
 100 =head2 C<delay>
 101
 102     my $delay = $ime->delay;
 103     $ime->delay($seconds);
 104
 105 Returns the current delay in seconds, or set it if an argument is provided.
 106
 107 =cut
 108
 109 sub delay {
 110  my ($self, $delay) = @_;
 111  _check_self($self);
 112  $self->{delay} = abs $delay if $delay and $delay += 0.0;
 113  return $self->{delay};
 114 }
 115
 116 =head2 C<speed>
 117
 118     my $speed = $ime->speed;
 119     $ime->speed($bauds);
 120
 121 Returns the current speed in bauds, or set it if an argument is provided.
 122
 123 =cut
 124
 125 sub speed {
 126  my ($self, $speed) = @_;
 127  _check_self($self);
 128  $self->{delay} = 1 / (abs $speed) if $speed and $speed = int $speed;
 129  return int(1 / $self->{delay});
 130 }
 131
 132 =pod
 133
 134 IPC::MorseSignals::Emitter objects also inherit methods from L<Bit::MorseSignals::Emitter>.
 135
 136 =head1 EXPORT
 137
 138 An object module shouldn't export any function, and so does this one.
 139
 140 =head1 DEPENDENCIES
 141
 142 L<Bit::MorseSignals::Emitter>.
 143
 144 L<Carp> (standard since perl 5), L<POSIX> (idem) and L<Time::HiRes> (since perl 5.7.3) are required.
 145
 146 =head1 SEE ALSO
 147
 148 L<IPC::MorseSignals>, L<IPC::MorseSignals::Receiver>.
 149
 150 L<Bit::MorseSignals>, L<Bit::MorseSignals::Emitter>, L<Bit::MorseSignals::Receiver>.
 151
 152 L<perlipc> for information about signals in perl.
 153
 154 For truly useful IPC, search for shared memory, pipes and semaphores.
 155
 156 =head1 AUTHOR
 157
 158 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 159
 160 You can contact me by mail or on C<irc.perl.org> (vincent).
 161
 162 =head1 BUGS
 163
 164 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.
 165
 166 =head1 SUPPORT
 167
 168 You can find documentation for this module with the perldoc command.
 169
 170     perldoc IPC::MorseSignals::Emitter
 171
 172 =head1 COPYRIGHT & LICENSE
 173
 174 Copyright 2007,2008,2013 Vincent Pit, all rights reserved.
 175
 176 This program is free software; you can redistribute it and/or modify it
 177 under the same terms as Perl itself.
 178
 179 =cut
 180
 181 1; # End of IPC::MorseSignals::Emitter