view release on metacpan or  search on metacpan

Multi.pm  view on Meta::CPAN

    my $rsessions = $multi->{_sessions};

    # Any extra arguments for SNMP::Session?
    #
    my @SNMPargs = @{$multi->{_SNMPArgs}};

    # Iterate through the round-robin list, popping host/index pairs off of
    # the front of @rrhosts, and pushing the "next" pair on the end if more
    # requests remain.
    #
RR: while (@{$multi->{_reqlist}}) {

	# Pull the next host/index pair off of the front of @rrhosts.
	#
	my $host  = shift @{$multi->{_reqlist}};
	my $index = shift @{$multi->{_reqlist}};
	my $rhost = $multi->{_hosts}{$host};

	# Skip this host/index if a new session to that host is needed,
	# but there are no available sessions.
	#
	my $rsess = $rsessions->{$host};
	if (!defined($rsess) && !$availsess) {
	    print "No SNMP sessions available for $host (all "
		. "$multi->{MaxSessions} sessions in use)\n"	if $DEBUGGING;

	    # Push the request on the tail of the retry request list.
	    push @retry, ($host, $index);
	    next RR;
	}

	# There is either a current session for this host, or a new one can
	# be created.  Get handles for the metadata for this host.
	#
	my $rreqs = $rhost->{requests};
	my $nreqs = scalar @$rreqs;

	croak "Request $host:$index outside range [0..$nreqs]"
		unless ($index < $nreqs);

	# Get a reference to the request, and its additional arguments.
	#
	my $request = $rreqs->[$index];
	croak "Request is undef!" unless defined $request;

	my $rargs = $rhost->{sendargs}->[$index];

	# Create a new session for this request if one does not already exist.
	unless (defined $rsess) {

	    $! = 0;	# Reset system errno before calling new() (see below)

	    $rsess = SNMP::Session->new( @SNMPargs,
					 DestHost    => $host,
					 Community   => $rhost->{community},
					 Version     => $rhost->{snmpversion}, 
					 Timeout     => $multi->{Timeout} * 1e6,
					 Retries     => $multi->{Retries},
					 TimeStamp   => $multi->{TimeStamp},
					 #UseNumeric => $multi->{UseNumeric},
					 # UseNumeric BOMBS PERL CORE !!!
					 UseNumeric  => 0,
				       );

	    # Give up on this particular request for now.  At some point in
	    # the future, we should probably flag the session as failed, and
	    # provide an option to avoid retrying any further requests on the
	    # host.
	    #
	    # This is a little tricky -- SNMP::Session::new() doesn't set any
	    # sort of error flag.  We can, however, tell if it was a hostname
	    # lookup failure by examining $! (errno).  It will be 0 if the
	    # problem occurred before the call into the XS code, otherwise
	    # a system-level error occured which we can trap based on $!.
	    #
	    unless (defined $rsess) {
		my $err;
		unless ($!) {
		    # Couldn't look up the host, so set the error code
		    # especially for this.
		    $err = "Couldn't resolve hostname";

		    # We are discarding this request.
		    #
		    $rhost->{remain} --;
		    $multi->{_remain} --;

		} else {
		    # Some system-level error occurred.  Handle a few simple
		    # resource problems by (hopefully) waiting for things to
		    # subside, and retry later.
		    #
		    # Copy error string, and force numeric errno
		    $err = "" . $!;
		    my $errno = $! + 0;
		    if (($errno == EINTR)  || 	# Interrupted system call
			($errno == EAGAIN) ||	# Resource temp. unavailable
			($errno == ENOMEM) ||	# No memory (temporary)
			($errno == ENFILE) ||	# Out of file descriptors
			($errno == EMFILE))	# Too many open fd's
		    {
			# Push the request onto the retry request list.
			push @retry, ($host, $index);

			# Prevent further attempts to get a new session
			# until the blockage clears, but only if there's
			# a chance a current connection will finish and
			# free up resources.
			$availsess = 0 if $multi->{_nsessions};

			# Note that we'll retry later.
			$err .= " (will retry)";
		    } else {

			# We are discarding this request.
			#
			$rhost->{remain} --;
			$multi->{_remain} --;
		    }
		}