SNMP::Effective - An effective SNMP-information-gathering module

    use SNMP::Effective;

    my $snmp = SNMP::Effective->new(
        max_sessions => $NUM_POLLERS,
        master_timeout => $TIMEOUT_SECONDS,
    );

    $snmp->add(
        dest_host => $ip,
        callback => sub { store_data() },
        get => [ '1.3.6.1.2.1.1.3.0', 'sysDescr' ],
    );

    # lather, rinse, repeat

    # retrieve data from all hosts
    $snmp->execute;

    $obj->method(MyKey => $value);
    $obj->method(my_key => $value);
    $obj->method(My_Key => $value);
    $obj->method(mYK__EY => $value);

    match_oid("1.3.6.10",   "1.3.6");    # return 10
    match_oid("1.3.6.10.1", "1.3.6");    # return 10.1
    match_oid("1.3.6.10",   "1.3.6.11"); # return undef

 make_numeric_oid("sysDescr"); # return .1.3.6.1.2.1.1.1

    make_name_oid("1.3.6.1.2.1.1.1"); # return sysDescr

 sub my_callback {
     my($host, $error) = @_

     if($error) {
         warn "$host failed with this error: $error"
         return;
     }

     my $data = $host->data;

     for my $oid (keys %$data) {
         print "$host returned oid $oid with this data:\n";

         print join "\n\t",
               map { "$_ => $data->{$oid}{$_}" }
                   keys %{ $data->{$oid}{$_} };
         print "\n";
     }
 }

    SNMP_EFFECTIVE_DEBUG=1 perl myscript.pl

package SNMP::Effective;

use warnings;
use strict;
use constant DEBUG => $ENV{'SNMP_EFFECTIVE_DEBUG'} ? 1 : 0;
use SNMP;
use SNMP::Effective::Host;
use SNMP::Effective::HostList;
use Time::HiRes qw/usleep/;
use POSIX qw(:errno_h);

use base qw/ SNMP::Effective::Dispatch /;

our $VERSION = eval '1.0801';
our %SNMPARG = (
    Version => '2c',
    Community => 'public',
    Timeout => 1e6,
    Retries => 2
);

BEGIN {
    no strict 'refs';
    my %sub2key = qw/
                      max_sessions    maxsessions
                      master_timeout  mastertimeout
                      _varlist        _varlist
                      hostlist        _hostlist
                      arg             _arg
                      callback        _callback
                      heap            _heap
                  /;

    for my $subname (keys %sub2key) {
        *$subname = sub {
            my($self, $set) = @_;
            $self->{ $sub2key{$subname} } = $set if(defined $set);
            $self->{ $sub2key{$subname} };
        }
    }
}

sub new {
    my $class = shift;
    my %args = _format_arguments(@_);
    my $self = (ref $class) ? $class : $class->_new_object(%args);

    $self->add(%args);

    return $self;
}

sub _new_object {
    my $class = shift;
    my %args = @_;

    return bless {
        maxsessions => 1,
        mastertimeout => undef,
        _sessions => 0,
        _hostlist => SNMP::Effective::HostList->new,
        _varlist => [],
        _arg => {},
        _callback => sub {},
        %args,
    }, $class;
}

sub add {
    my $self = shift;
    my %in = _format_arguments(@_) or return;
    my $hostlist = $self->hostlist;
    my $varlist = $self->_varlist;
    my @new_varlist;

    # setup desthost input argument
    if($in{'desthost'} and ref $in{'desthost'} ne 'ARRAY') {
        $in{'desthost'} = [$in{'desthost'}];
        warn "Adding host(@{ $in{'desthost'} })" if DEBUG;
    }

    # add to varlist
    for my $key (keys %SNMP::Effective::Dispatch::METHOD) {
        next unless($in{$key});
        $in{$key} = [$in{$key}] unless(ref $in{$key});

        if(@{$in{$key}}) {
            warn "Adding $key(@{ $in{$key} })" if DEBUG;
            unshift @{$in{$key}}, $key;
            push @new_varlist, $in{$key};
        }
    }

    if(ref $in{'desthost'} eq 'ARRAY') {
        for my $addr (@{$in{'desthost'}}) {

            # add/update hosts
            my $host = $hostlist->get_host($addr)
                    || $hostlist->add_host(
                           address => $addr,
                           arg => $self->arg,
                           callback => $self->callback,
                           heap => $self->heap,
                       );

            push @$host, (@$host or @new_varlist) ? @new_varlist : @$varlist;
            $host->arg($in{'arg'}) if($in{'arg'});
            $host->callback($in{'callback'}) if($in{'callback'});
            $host->heap($in{'heap'}) if($in{'heap'});
        }
    }
    else {

        # update $self with generic args
        $self->arg($in{'arg'}) if(ref $in{'arg'} eq 'HASH');
        $self->callback($in{'callback'}) if(ref $in{'callback'});
        $self->heap($in{'heap'}) if(exists $in{'heap'});

        # update $self and all hosts with @new_varlist
        if(@new_varlist) {
            push @$varlist, @new_varlist;
            for my $host (values %$hostlist) {
                push @$host, @new_varlist;
            }
        }
    }

    return 1;
}

sub execute {
    my $self = shift;

    unless(scalar($self->hostlist)) {
        return 0;
    }

    $self->_init_lock;

    if(my $timeout = $self->master_timeout) { # dispatch with master timeout
        my $die_msg = "alarm_clock_timeout";

        warn "Execute dispatcher with timeout ($timeout)" if DEBUG;

        eval {
            local $SIG{'ALRM'} = sub { die $die_msg };
            alarm $timeout;
            $self->dispatch and SNMP::MainLoop();
            alarm 0;
        };

        # check for timeout
        if($@ and $@ =~ /$die_msg/mx) {
            $self->master_timeout(0);
            warn "Master timeout!" if DEBUG;
            SNMP::finish();
        }
        elsif($@) {
            die $@;
        }
    }
    else { # dispatch without master timeout
        warn "Execute dispatcher without timeout" if DEBUG;
        $self->dispatch and SNMP::MainLoop();
    }

    return 1;
}

sub _create_session {
    local $! = 0;

    my($self, $host) = @_;
    my $snmp = SNMP::Session->new(%SNMPARG, $host->arg);

    unless($snmp) {
        my($retry, $msg) = $self->_check_errno($!);
        warn "SNMP session failed for host $host: $msg" if DEBUG;
        return $retry ? '' : undef;
    }

    warn "SNMP session created for $host" if DEBUG;

    return $snmp;
}

sub _check_errno {
    my($self, $err) = @_;
    my $retry = 0;
    my $errstr = '';

    if(not $err) {
        $errstr = "Couldn't resolve hostname";
    }
    elsif($errstr = "$err") {
        if(
            $err == EINTR  || # Interrupted system call
            $err == EAGAIN || # Resource temp. unavailable
            $err == ENOMEM || # No memory (temporary)
            $err == ENFILE || # Out of file descriptors
            $err == EMFILE    # Too many open fd's
        ) {
            $errstr .= ' (will retry)';
            $retry = 1;
        }
    }

    return $retry, $errstr;
}

sub match_oid {
    my $p = shift or return;
    my $c = shift or return;
    return ($p =~ /^ \.? $c \.? (.*)/mx) ? $1 : undef;
}

sub make_numeric_oid {
    my @input = @_;

    for my $i (@input) {
        next if($i =~ /^ [\d\.]+ $/mx);
        $i = SNMP::translateObj($i);
    }

    return wantarray ? @input : $input[0];
}

sub make_name_oid {
    my @input = @_;

    for my $i (@input) {
        $i = SNMP::translateObj($i) if($i =~ /^ [\d\.]+ $/mx);
    }

    return wantarray ? @input : $input[0];

}

sub _format_arguments {
    return if(@_ % 2 == 1);

    my %args = @_;

    for my $k (keys %args) {
        my $v = delete $args{$k};
        $k = lc $k;
        $k =~ s/_//gmx;
        $args{$k} = $v;
    }

    return %args;
}

sub _init_lock {
    my $self = shift;

    pipe my $READ, my $WRITE or die "Failed to create pipe: $!";
    select +( select($READ), $| = 1 )[0];
    select +( select($WRITE), $| = 1 )[0];
    print $WRITE "\n";

    warn "Lock is ready and unlocked" if DEBUG;

    return $self->{'_lock_fh'} = [ $READ, $WRITE ];
}

sub _wait_for_lock {
    my $self = shift;
    my $LOCK_FH = $self->{'_lock_fh'}->[0];

    warn "Waiting for lock to unlock..." if DEBUG;
    defined readline $LOCK_FH or die "Failed to read from LOCK_FH: $!";
    warn "The lock is now locked again" if DEBUG;

    return 1;
}

sub _unlock {
    my $self = shift;
    my $LOCK_FH = $self->{'_lock_fh'}->[1];

    warn "Unlocking lock" if DEBUG;
    print $LOCK_FH "\n";

    return 1;
}

1;