# $Id: SNMP.pm,v 1.20 2009/09/18 09:38:00 dk Exp $
package IO::Lambda::SNMP;
use vars qw(
	$DEBUG
	@ISA @EXPORT_OK %EXPORT_TAGS 
	$MASTER %ACTIVE_FDS %PASSIVE_FDS 
	@TIMER $TIMER_ACTIVE
);
@ISA = qw(Exporter);
my @methods = qw(get fget getnext fgetnext set bulkwalk);
@EXPORT_OK = map { "snmp$_" } @methods;
%EXPORT_TAGS = ( all => \@EXPORT_OK);
$DEBUG = $IO::Lambda::DEBUG{snmp} || 0;

use strict;
use warnings;
use SNMP;
use IO::Handle;
use Exporter;
use Time::HiRes qw(time);
use IO::Lambda qw(:all :dev);

# $DEBUG = 1;

#
# Part I: Lower-level event loop interactions
# 
# Create a singleton object that will receive yield notification
# and that will be passed as WATCH_OBJ for all lower-level events
# to not involve upper-level IO::Lambda event mechanisms. In this
# part, we talk to the loop directly because SNMP has its own
# event loop.
#
# Also note that this implementation allows for use of SNMP with native
# callbacks together with lambdas.
$MASTER = bless {}, __PACKAGE__;

# register yield handler
IO::Lambda::add_loop($MASTER);
END { IO::Lambda::remove_loop($MASTER) };

sub remove {}

sub empty { 0 == keys %ACTIVE_FDS and 0 == keys %PASSIVE_FDS }

sub yield
{
	warn "snmp.yield\n" if $DEBUG;
	SNMP::MainLoop(1e-6);
	reshuffle_fds();
}
# Use the same $MASTER for the lambda emulator and do not call anything in the handler,
# but do that in yield()
sub io_handler
{
	my ( undef, $rec) = @_;
	my $fileno = fileno($rec->[WATCH_IO_HANDLE]);
	warn "snmp.io_handler[$fileno]\n" if $DEBUG;
	$PASSIVE_FDS{$fileno} = delete $ACTIVE_FDS{$fileno};
}

# There'll also be a single timer as SNMP loop needs timeouts
$TIMER[WATCH_OBJ] = bless {}, "IO::Lambda::Loop::SNMP::Timer";
sub IO::Lambda::Loop::SNMP::Timer::io_handler { $TIMER_ACTIVE = 0 }

# Get all fds monitored by SNMP, and monitor these by ourselves.
# Return number of events passed (and therefore resubmitted)
sub reshuffle_fds
{
	my $resubmitted = 0;

	my ( $timeout, @fds) = SNMP::select_info;
	@fds = grep { defined } @fds;
	if ( @fds) {
		$timeout = 1e-6 if defined($timeout) && $timeout == 0;
	} else {
		undef $timeout;
	}

	# kill old handles
	my %all = map { $_ => 1 } @fds;
	for my $old ( grep { not exists $all{$_} } keys %ACTIVE_FDS) {
		$IO::Lambda::LOOP-> remove_event( delete $ACTIVE_FDS{$old});
		warn "snmp.remove: $old\n" if $DEBUG;
	}

	# resubmit handles that were fired off
	for my $passive ( grep { exists $all{$_} } keys %PASSIVE_FDS) {
		$resubmitted++;
		$IO::Lambda::LOOP-> watch( $ACTIVE_FDS{$passive} = $PASSIVE_FDS{$passive} );
		warn "snmp.resubmit: $passive\n" if $DEBUG;
	}
	%PASSIVE_FDS = ();

	# register new handles
	for my $new ( grep { not exists $ACTIVE_FDS{$_} } @fds) {
	
		warn "snmp.listen: $new\n" if $DEBUG;
		
		my $fh = IO::Handle-> new;
		unless ( open( $fh, "<&=$new")) {
			warn "cannot dup($new):$!\n";
			next;
		}

		# construct a fake IO::Lambda event record
		my @rec;
		$rec[WATCH_OBJ]       = $MASTER;
		$rec[WATCH_IO_HANDLE] = $fh;
		$rec[WATCH_IO_FLAGS]  = IO_READ;

		$IO::Lambda::LOOP-> watch( $ACTIVE_FDS{$new} = \@rec);
	}

	# timer
	if ( $timeout) {
		my $deadline = time + $timeout;
		if ( $TIMER_ACTIVE) {
			if ( abs( $deadline - $TIMER[WATCH_DEADLINE]) > 0.001) {
				# restart the active timer
				warn "snmp.timer restart $timeout $deadline/$TIMER[WATCH_DEADLINE]\n"
					if $DEBUG;
				$IO::Lambda::LOOP-> remove_event( \@TIMER);
				$TIMER[WATCH_DEADLINE] = $deadline;
				$IO::Lambda::LOOP-> after( \@TIMER);
			}
			# else, same timeout, on already active timer - do nothing
		} else {
			# resubmit
			warn "snmp.timer resubmit $timeout\n" if $DEBUG;
			$TIMER[WATCH_DEADLINE] = $deadline;
			$IO::Lambda::LOOP-> after( \@TIMER);
			$TIMER_ACTIVE = 1;
			$resubmitted++;
		}
	} elsif ( $TIMER_ACTIVE) {
		warn "snmp.timer stop\n" if $DEBUG;
		# stop timer
		$IO::Lambda::LOOP-> remove_event( \@TIMER);
		$TIMER_ACTIVE = 0;
	}

	return $resubmitted;
}

# Part II - building on SNMP callback mechanism, provide lambda interface

sub snmpcallback
{
	my ($q, $c) = (shift, shift);

	warn "snmp.cb: $q\n" if $DEBUG;
	$q-> resolve($c);
	$q-> terminate(@_);
	undef $c;
	undef $q;
}


sub wrapper 
{
	my ( $cb, $method, $caller) = @_;

	return this-> override_handler( $method, $caller, $cb)
		if this-> {override}->{$method};

	my ( $session, @param ) = context;
	_subname( $method, $cb, 1) if $cb;

	# the caller will listen to a new lambda
	my $q = IO::Lambda-> new;
	my $c = $q-> bind;
	this-> add_tail( $cb, $caller, $q, context);

	# fire an snmp request
	my $ok = $session-> $method(
		@param, 
		[ \&snmpcallback, $q, $c ]
	);

	return $q-> resolve($c) unless $ok;

	reshuffle_fds();

	# don't set up timers and fd listeners yet, yield() will do that
	warn "snmp.call: $method($q)\n" if $DEBUG;
}

for ( @methods) {
	eval "sub snmp$_(&) { wrapper( shift, '$_', \\&snmp$_ ) }";
	die $@ if $@;
}

1;

__DATA__

=pod

=head1 NAME

IO::Lambda::SNMP - snmp requests lambda style

=head1 DESCRIPTION

The module exports a set of conditions: snmpget, snmpfget, snmpgetnext,
snmpfgetnext, snmpset, and snmpbulkwalk, that behave like the corresponding
SNMP:: non-blocking counterpart functions. See L<SNMP> for descriptions of
their parameters and results.

=head1 SYNOPSIS

   use strict;
   use SNMP;
   use IO::Lambda::SNMP qw(:all);
   use IO::Lambda qw(:all);
   
   my $sess = SNMP::Session-> new(
      DestHost => 'localhost',
      Community => 'public',
      Version   => '2c',
   );
   
   this lambda {
      context $sess, new SNMP::Varbind;
      snmpgetnext {
         my $vb = shift;
         print @{$vb->[0]}, "\n" ; 
         context $sess, $vb;
         again unless $sess-> {ErrorNum};
      }
   };
   this-> wait;

=head1 SEE ALSO

L<IO::Lambda>, L<SNMP>.

=head1 AUTHOR

Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>.

=cut