IPC::MorseSignals::Emitter - Base class for IPC::MorseSignals emitters.


IPC-MorseSignals documentation Contained in the IPC-MorseSignals distribution.

Index


Code Index:

NAME

Top

IPC::MorseSignals::Emitter - Base class for IPC::MorseSignals emitters.

VERSION

Top

Version 0.15

SYNOPSIS

Top

    use IPC::MorseSignals::Emitter;

    my $deuce = new IPC::MorseSignals::Emitter speed => 1024;
    $deuce->post('HLAGH') for 1 .. 3;
    $deuce->send($pid);

DESCRIPTION

Top

This module sends messages processed by an underlying Bit::MorseSignal emitter to another process as a sequence of SIGUSR1 (for bits 0) and SIGUSR2 (for 1) signals.

METHODS

Top

new < delay => $seconds, speed => $bauds, %bme_options >

Creates a new emitter object. delay specifies the delay between two sends, in seconds, while 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 new in Bit::MorseSignals::Emitter.

send $pid

Sends messages enqueued with post in Bit::MorseSignals::Emitter to the process $pid (or to all the @$pid if $pid is an array reference, in which case duplicated targets are stripped off).

delay < $seconds >

Returns the current delay in seconds, or set it if an argument is provided.

speed < $bauds >

Returns the current speed in bauds, or set it if an argument is provided.

IPC::MorseSignals::Emitter objects also inherit methods from Bit::MorseSignals::Emitter.

EXPORT

Top

An object module shouldn't export any function, and so does this one.

DEPENDENCIES

Top

Bit::MorseSignals::Emitter.

Carp (standard since perl 5), POSIX (idem) and Time::HiRes (since perl 5.7.3) are required.

SEE ALSO

Top

IPC::MorseSignals, IPC::MorseSignals::Receiver.

Bit::MorseSignals, Bit::MorseSignals::Emitter, Bit::MorseSignals::Receiver.

perlipc for information about signals in perl.

For truly useful IPC, search for shared memory, pipes and semaphores.

AUTHOR

Top

Vincent Pit, <perl at profvince.com>, http://www.profvince.com.

You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).

BUGS

Top

Please report any bugs or feature requests to bug-ipc-morsesignals-emitter at rt.cpan.org, or through the web interface at 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.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc IPC::MorseSignals::Emitter

COPYRIGHT & LICENSE

Top


IPC-MorseSignals documentation Contained in the IPC-MorseSignals distribution.
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/;

our $VERSION = '0.15';

sub _check_self {
 croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
  unless ref $_[0] and $_[0]->isa(__PACKAGE__);
}

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;
}

sub send {
 my ($self, $dest) = @_;
 _check_self($self);
 return unless defined $dest;
 my %count;
 my @dests = grep $_ > 0 && !$count{$_}++, # Remove duplicates.
              ref $dest eq 'ARRAY' ? map int, grep defined, @$dest
                                   : int $dest;
 return unless @dests;
 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;
 }
}

sub delay {
 my ($self, $delay) = @_;
 _check_self($self);
 $self->{delay} = abs $delay if $delay and $delay += 0.0;
 return $self->{delay};
}

sub speed {
 my ($self, $speed) = @_;
 _check_self($self);
 $self->{delay} = 1 / (abs $speed) if $speed and $speed = int $speed;
 return int(1 / $self->{delay});
}

1; # End of IPC::MorseSignals::Emitter