Agent-TCLI-Package-Net

 view release on metacpan or  search on metacpan

lib/Agent/TCLI/Package/Net/Ping.pm  view on Meta::CPAN

=over

=item target

The default target for a ping
B<target> will only accept NetAddr::IP type values.

=cut

=item timeout

The default timeout for a ping
B<timeout> will only contain numeric values.

=cut

=item retry_count

The default number of retries before failing
B<retry_count> will only contain numeric values.

=cut

=back

=head2 METHODS

Most of these methods are for internal use within the TCLI system and may
be of interest only to developers trying to enhance TCLI.

=over

=item new ( hash of attributes )

Usually the only attributes that are useful on creation are the
verbose and do_verbose attrbiutes that are inherited from Agent::TCLI::Base.

=cut

sub _start {
	my ($kernel,  $self,  $session) =
      @_[KERNEL, OBJECT,   SESSION];
	$self->Verbose("_start: tcli ping starting");

	# are we up before OIO has finished initializing object?
	if (!defined( $self->name ))
	{
		$kernel->yield('_start');
		return;
	}

	# There is only one command object per TCLI
    $kernel->alias_set($self->name);

	# Keep the pinger session so we can shut it down

	# Create a pinger component.
#	$self->set(\@poco_pinger,
	POE::Component::Client::Ping->spawn(
    	Alias   	=> 'pinger',    # This is the name it'll be known by.
    	Timeout 	=> 10,          # This is how long it waits for echo replies.
    	OneReply	=> 1,			# Only tell us when success or timeout
	);

	return($self->name.":_start complete ");
} #end start

sub _stop {
    my ($kernel,  $self,) =
      @_[KERNEL, OBJECT,];
	$self->Verbose("_stop: ".$self->name." stopping",2);

	return($self->name.":_stop complete ");
}

=item ping

This POE Event handler executes the ping command.

=cut

sub ping {
    my ($kernel,  $self, $session, $request, ) =
      @_[KERNEL, OBJECT,  SESSION,     ARG0, ];

	my $txt = '';
	my $param;
	my $command = $request->command->[0];
	my $cmd = $self->commands->{'ping'};

	return unless ( $param = $cmd->Validate($kernel, $request, $self) );

	$self->Verbose("ping: param dump",1,$param);

	my $target;

	if ( defined( $param->{'target'} ) && ref( $param->{'target'} ) eq 'NetAddr::IP' )
	{
		$target = $param->{'target'}
	}
	else
	{
		$self->Verbose('ping: target not specified ');
		$request->Respond($kernel,  "Target must be defined in command line or in default settings.",412);
		return;
	}
	$self->Verbose("ping: target ",1,$target);

	if ( $target->version() == 6 )
	{
		$request->Respond($kernel,  "IPv6 currently not supported.",400);
		return;
	}
	if ( $target->masklen() != 32 )
	{
		$request->Respond($kernel,  "Address blocks not supported.",400);
		return;
	}

	$self->Verbose("ping: target(".$target.") ",2);

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 0.556 second using v1.00-cache-2.02-grep-82fe00e-cpan-2c419f77a38b )