view release on metacpan or  search on metacpan

lib/AnyEvent/Ping.pm  view on Meta::CPAN

    delete $self->{_poll_write};
    delete $self->{_timers};

    while (my $request = pop @{$self->{_tasks}}) {
        $request->{cb}->($request->{results});
    }

    close delete $self->{_socket}
        if exists $self->{_socket};
}

sub generate_data_random {
    my $length = shift;

    my $data = '';
    while ($length > 0) {
        $data .= pack('C', int(rand(256)));
        $length--;
    }

    $data;
}

sub _add_write_poll {
    my $self = shift;

    return if exists $self->{_poll_write};

    $self->{_poll_write} = AnyEvent->io(
        fh   => $self->{_socket},
        poll => 'w',
        cb   => sub { $self->_send_requests },
    );
}

sub _send_requests {
    my $self = shift;

    foreach my $request (@{$self->{_tasks_out}}) {
        $self->_send_request($request);
    }

    $self->{_tasks_out} = [];
    delete $self->{_poll_write};
}

sub _on_read {
    my $self = shift;

    my $socket = $self->{_socket};
    $socket->sysread(my $chunk, 4194304, 0);

    my $icmp_msg = substr $chunk, 20;

    my ($type, $identifier, $sequence, $data);

    $type = unpack 'c', $icmp_msg;

    if ($type == $ICMP_ECHOREPLY) {
        ($type, $identifier, $sequence, $data) =
          (unpack $ICMP_PING, $icmp_msg)[0, 3, 4, 5];
    }
    elsif ($type == $ICMP_DEST_UNREACH || $type == $ICMP_TIME_EXCEEDED) {
        ($identifier, $sequence) = unpack('nn', substr($chunk, 52));
    }
    else {

        # Don't mind
        return;
    }

    # Find our task
    my $request =
      List::Util::first { $identifier == $_->{identifier} }
    @{$self->{_tasks}};

    return unless $request;

    # Is it response to our latest message?
    return unless $sequence == @{$request->{results}} + 1;

    if ($type == $ICMP_ECHOREPLY) {

        # Check data
        if ($data eq $request->{data}) {
            $self->_store_result($request, 'OK');
        }
        else {
            $self->_store_result($request, 'MALFORMED');
        }
    }
    elsif ($type == $ICMP_DEST_UNREACH) {
        $self->_store_result($request, 'DEST_UNREACH');
    }
    elsif ($type == $ICMP_TIME_EXCEEDED) {
        $self->_store_result($request, 'TIMEOUT');
    }
}

sub _store_result {
    my ($self, $request, $result) = @_;

    my $results = $request->{results};

    # Clear request specific data
    delete $self->{_timers}->{$request};

    push @$results, [$result, time - $request->{start}];

    if (@$results == $request->{times} || $result eq 'ERROR') {

        # Cleanup
        my $tasks = $self->{_tasks};
        for my $i (0 .. scalar @$tasks) {
            if ($tasks->[$i] == $request) {
                splice @$tasks, $i, 1;
                last;
            }
        }

        # Testing done