File Coverage

blib/lib/SNMP/ToolBox.pm

Criterion	Covered	Total	%
statement	39	40	97.5
branch	15	16	93.7
condition	15	19	78.9
subroutine	8	9	88.8
pod	2	2	100.0
total	79	86	91.8

package SNMP::ToolBox;
use strict;
use warnings;

use parent qw< Exporter >;

use Carp;


{
    no strict "vars";
    $VERSION = '0.03';
    @EXPORT  = qw< by_oid find_next_oid oid_encode >;

    if ($] < 5.008) {
        *by_oid = \&_by_oid_vstring;
    }
    else {
        *by_oid = \&_by_oid_classical;
    }
}


#
# _by_oid_classical()
# -----------------
# by Sebastien Aperghis-Tramoni
#
sub _by_oid_classical ($$) {
    my (undef, @a) = split /\./, $_[0];
    my (undef, @b) = split /\./, $_[1];
    my $n = $#a > $#b ? $#a : $#b;
    my $v = 0;
    $v ||= ($a[$_]||0) <=> ($b[$_]||0), $v && return $v for 0 .. $n;
    return $v
}


#
# _by_oid_vstring()
# ---------------
# by Vincent Pit
#
sub _by_oid_vstring ($$) {
    eval($_[0]) cmp eval ($_[1])
}


#
# find_next_oid()
# -------------
sub find_next_oid {
    my ($oid_list, $req_oid, $walk_base) = @_;

    croak "error: first argument must be an arrayref"
        unless ref $oid_list eq "ARRAY";

    $req_oid   ||= "";
    $walk_base ||= "";

    my ($first_idx, $next_oid_idx);

    for my $i (0 .. $#{$oid_list}) {
        # check if we are still within the given context, if given any
        next if $walk_base and index($oid_list->[$i], $walk_base) != 0;

        # keep track of the first entry within the given context
        $first_idx = $i if not defined $first_idx;

        # exact match of the requested entry
        if ($oid_list->[$i] eq $req_oid) {
            $next_oid_idx = $i + 1;
            last
        }
        # prefix match of the requested entry
        elsif (index($oid_list->[$i], $req_oid) == 0) {
            $next_oid_idx = $i;
            last
        }
    }

    # get the entry following the requested one
    my $next_oid = (defined $next_oid_idx and $next_oid_idx <= $#{$oid_list})
                 ? $oid_list->[$next_oid_idx]
                 : "NONE";

    # check that the resulting OID is still within context
    $next_oid = "NONE" if index($next_oid, $walk_base) != 0;

    return $next_oid
}


#
# oid_encode()
# ----------
sub oid_encode {
    return join ".", length($_[0]), unpack "c*", $_[0];
}


__PACKAGE__

__END__