view release on metacpan or  search on metacpan

lib/Danga/Socket.pm  view on Meta::CPAN

    return wantarray ? %OtherFds : \%OtherFds;
}

=head2 C<< CLASS->AddOtherFds( [%fdmap] ) >>

Add fds to the OtherFds hash for processing.

=cut
sub AddOtherFds {
    my $class = shift;
    %OtherFds = ( %OtherFds, @_ ); # FIXME investigate what happens on dupe fds
    return wantarray ? %OtherFds : \%OtherFds;
}

=head2 C<< CLASS->SetLoopTimeout( $timeout ) >>

Set the loop timeout for the event loop to some value in milliseconds.

A timeout of 0 (zero) means poll forever. A timeout of -1 means poll and return
immediately.

=cut
sub SetLoopTimeout {
    return $LoopTimeout = $_[1] + 0;
}

=head2 C<< CLASS->DebugMsg( $format, @args ) >>

Print the debugging message specified by the C<sprintf>-style I<format> and
I<args>

=cut
sub DebugMsg {
    my ( $class, $fmt, @args ) = @_;
    chomp $fmt;
    printf STDERR ">>> $fmt\n", @args;
}

=head2 C<< CLASS->AddTimer( $seconds, $coderef ) >>

Add a timer to occur $seconds from now. $seconds may be fractional, but timers
are not guaranteed to fire at the exact time you ask for.

Returns a timer object which you can call C<< $timer->cancel >> on if you need to.

=cut
sub AddTimer {
    my $class = shift;
    my ($secs, $coderef) = @_;

    my $fire_time = Time::HiRes::time() + $secs;

    my $timer = bless [$fire_time, $coderef], "Danga::Socket::Timer";

    if (!@Timers || $fire_time >= $Timers[-1][0]) {
        push @Timers, $timer;
        return $timer;
    }

    # Now, where do we insert?  (NOTE: this appears slow, algorithm-wise,
    # but it was compared against calendar queues, heaps, naive push/sort,
    # and a bunch of other versions, and found to be fastest with a large
    # variety of datasets.)
    for (my $i = 0; $i < @Timers; $i++) {
        if ($Timers[$i][0] > $fire_time) {
            splice(@Timers, $i, 0, $timer);
            return $timer;
        }
    }

    die "Shouldn't get here.";
}

=head2 C<< CLASS->DescriptorMap() >>

Get the hash of Danga::Socket objects keyed by the file descriptor (fileno) they
are wrapping.

Returns a hash in list context or a hashref in scalar context.

=cut
sub DescriptorMap {
    return wantarray ? %DescriptorMap : \%DescriptorMap;
}
*descriptor_map = *DescriptorMap;
*get_sock_ref = *DescriptorMap;

sub set_cloexec ($) {
    my ($fd) = @_;

    # new_from_fd fails on real kqueue, but is needed for libkqueue
    # (which emulates kqueue via epoll on Linux)
    $_io = IO::Handle->new_from_fd($fd, 'r+') or return;
    defined(my $fl = fcntl($_io, F_GETFD, 0)) or return;
    fcntl($_io, F_SETFD, $fl | FD_CLOEXEC);
}

sub _InitPoller
{
    return if $DoneInit;
    $DoneInit = 1;

    if ($HAVE_KQUEUE) {
        $KQueue = IO::KQueue->new();
        $HaveKQueue = $KQueue >= 0;
        if ($HaveKQueue) {
            set_cloexec($KQueue); # needed if using libkqueue & epoll
            *EventLoop = *KQueueEventLoop;
        }
    }
    elsif (Sys::Syscall::epoll_defined()) {
        $Epoll = eval { epoll_create(1024); };
        $HaveEpoll = defined $Epoll && $Epoll >= 0;
        if ($HaveEpoll) {
            set_cloexec($Epoll);
            *EventLoop = *EpollEventLoop;
        }
    }

    if (!$HaveEpoll && !$HaveKQueue) {
        require IO::Poll;