File Coverage

blib/lib/ZeroMQ/Poller/Timer.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package ZeroMQ::Poller::Timer;

use strict;
use warnings;

our $VERSION = '0.01';

use threads;
use ZeroMQ qw/ ZMQ_POLLIN ZMQ_PAIR /;

my $zmq_ctxt = ZeroMQ::Context->new();
my $testmode = 0;

# Nope, not using Moose or even Class::Accessor 'antlers'
# for this first pass. It's a lite weight little module
# and I'd like to keep it that way for now.

sub new {
    my $class = shift;
    my $self  = {@_};
    $testmode ||= $self->{'test'};

    if ( !$self->{'name'} ) {
        _pe("constuctor requires a 'name' field.");
        return;
    }

    if ( !defined $self->{'after'} ) {
        _pe("constructor requires a 'after' field.");
        return;
    }

    if ( $self->{'after'} !~ /^\d+$/ ) {
        _pe("the 'after' field must be an integer.");
        return;
    }

    if ( defined $self->{'interval'} && $self->{'interval'} !~ /^\d+$/ ) {
        _pe("the 'interval' field must be an integer.");
        return;
    }

    $self->{'_addr'} = "inproc://" . $self->{'name'};
    $self->{'_sock'} = $zmq_ctxt->socket(ZMQ_PAIR);
    $self->{'_sock'}->bind( $self->{'_addr'} );

    my $obj = bless $self, $class;

    $obj->start unless $self->{'pause'};

    return $obj;
}

sub start {
    my $self = shift;
    my $thread = threads->create( \&_timer, $self );

    $thread->detach;
}

sub name { shift->{'name'} }

sub socket { shift->{'_sock'} }

sub reset { shift->socket->recv }

sub poll_hash {
    my $self = shift;

    return {
        name   => $self->name,
        socket => $self->socket,
        events => ZMQ_POLLIN,
    };
}

sub _timer {
    my $self  = shift;
    my $after = $self->{'after'};
    my $int   = $self->{'interval'};
    my $sock  = $zmq_ctxt->socket(ZMQ_PAIR);

    $sock->connect( $self->{'_addr'} );

    sleep $after;

    if ( !$int ) {
        $sock->send(1);
        return;
    }

    while (1) {
        $sock->send(1);
        sleep $int;
    }
}

# '_pe' is short for 'print error'. te he.
sub _pe {
    return if $testmode;
    print STDERR __PACKAGE__ . ': ' . (shift) . "\n";
}

1;

__END__