view release on metacpan or  search on metacpan

lib/MHFS/EventLoop/Poll/Base.pm  view on Meta::CPAN

package MHFS::EventLoop::Poll::Base v0.7.0;
use 5.014;
use strict; use warnings;
use feature 'say';
use POSIX ":sys_wait_h";
use IO::Poll qw(POLLIN POLLOUT POLLHUP);
use Time::HiRes qw( usleep clock_gettime CLOCK_REALTIME CLOCK_MONOTONIC);
use Scalar::Util qw(looks_like_number);
use Data::Dumper;
use Devel::Peek;
#use Devel::Refcount qw( refcount );

use constant POLLRDHUP => 0;
use constant ALWAYSMASK => (POLLRDHUP | POLLHUP);

# You must provide event handlers for the events you are listening for
# return undef to have them removed from poll's structures

sub _decode_status {
    my ($rc) = @_;
    print "$rc: normal exit with code ". WEXITSTATUS($rc)."\n" if WIFEXITED(  $rc);
    print "$rc: terminated with signal ".WTERMSIG(   $rc)."\n" if WIFSIGNALED($rc);
    print "$rc: stopped with signal ".   WSTOPSIG(   $rc)."\n" if WIFSTOPPED( $rc);
}

sub new {
    my ($class) = @_;
    my %self = ('poll' => IO::Poll->new(), 'fh_map' => {}, 'timers' => [], 'children' => {}, 'deadchildren' => []);
    bless \%self, $class;

    $SIG{CHLD} = sub {
        while((my $child = waitpid(-1, WNOHANG)) > 0) {
            my ($wstatus, $exitcode) = ($?, $?>> 8);
            if(defined $self{'children'}{$child}) {
                say "PID $child reaped (func) $exitcode";
                push @{$self{'deadchildren'}}, [$self{'children'}{$child}, $child, $wstatus];
                $self{'children'}{$child} = undef;
            }
            else {
                say "PID $child reaped (No func) $exitcode";
            }
        }
    };

    return \%self;
}

sub register_child {
    my ($self, $pid, $cb) = @_;
    $self->{'children'}{$pid} = $cb;
}

sub run_dead_children_callbacks {
    my ($self) = @_;
    while(my $chld = shift(@{$self->{'deadchildren'}})) {
        say "PID " . $chld->[1] . ' running SIGCHLD cb';
        $chld->[0]($chld->[2]);
    }
}

sub set {
    my ($self, $handle, $obj, $events) = @_;
    $self->{'poll'}->mask($handle, $events);
    $self->{'fh_map'}{$handle} = $obj;
}

sub getEvents {
    my ($self, $handle) = @_;