File Coverage

blib/lib/Net/SNMP/Mixin/System.pm

Criterion	Covered	Total	%
statement	24	54	44.4
branch	1	18	5.5
condition	0	3	0.0
subroutine	9	12	75.0
pod	1	1	100.0
total	35	88	39.7

package Net::SNMP::Mixin::System;

use 5.006;
use warnings;
use strict;

# store this package name in a handy variable,
# used for unambiguous prefix of mixin attributes
# storage in object hash
#
my $prefix = __PACKAGE__;

# this module import config
#
use Carp ();

use Net::SNMP::Mixin::Util qw/ push_error /;

# this module export config
#
my @mixin_methods;

BEGIN {
  @mixin_methods = ( qw/get_system_group/);
}

use Sub::Exporter -setup => {
  exports   => [@mixin_methods],
  groups    => { default => [@mixin_methods], },
};

# SNMP oid constants used in this module
#
use constant {
  SYS_DESCR          => '1.3.6.1.2.1.1.1.0',
  SYS_OBJECT_ID      => '1.3.6.1.2.1.1.2.0',
  SYS_UP_TIME        => '1.3.6.1.2.1.1.3.0',
  SYS_CONTACT        => '1.3.6.1.2.1.1.4.0',
  SYS_NAME           => '1.3.6.1.2.1.1.5.0',
  SYS_LOCATION       => '1.3.6.1.2.1.1.6.0',
  SYS_SERVICES       => '1.3.6.1.2.1.1.7.0',
};

=head1 NAME

Net::SNMP::Mixin::System - mixin class for the mib-2 system-group values

=head1 VERSION

Version 0.12

=cut

our $VERSION = '0.12';

=head1 SYNOPSIS

A Net::SNMP mixin class for mib-II system-group info. It's just in the distribution to act as a blueprint for mixin authors.

  use Net::SNMP;
  use Net::SNMP::Mixin qw/mixer init_mixins/;

  my $session = Net::SNMP->session( -hostname => 'foo.bar.com' );

  $session->mixer('Net::SNMP::Mixin::System');
  $session->init_mixins;
  snmp_dispatcher() if $session->nonblocking;

  die $session->error if $session->error;

  my $system_group = $session->get_system_group;

  printf "Name: %s, Contact: %s, Location: %s\n",
    $system_group->{sysName},
    $system_group->{sysContact},
    $system_group->{sysLocation};

=head1 MIXIN METHODS

=head2 B<< OBJ->get_system_group() >>

Returns the mib-II system-group as a hash reference:

  {
    sysDescr        => DisplayString,
    sysObjectID     => OBJECT_IDENTIFIER,
    sysUpTime       => TimeTicks,
    sysContact      => DisplayString,
    sysName         => DisplayString,
    sysLocation     => DisplayString,
    sysServices     => INTEGER,
  }

=cut

sub get_system_group {
  my $session = shift;
  Carp::croak "'$prefix' not initialized,"
    unless $session->{$prefix}{__initialized};

  # just a shallow copy for shallow values
  return { %{ $session->{$prefix}{sysGroup} } };
}

=head1 INITIALIZATION

=cut

=head2 B<< OBJ->_init($reload) >>

Fetch the SNMP mib-II system-group values from the host. Don't call this method direct! Returns nothing in case of failure so init_mixins can stop initialization.

=cut

sub _init {
  my ($session, $reload) = @_;

  die "$prefix already initalized and reload not forced.\n"
  	if $session->{$prefix}{__initialized} && not $reload;

  # initialize the object system-group infos
  my $success = _fetch_system_group($session);
  $success ? return 1 : return;
}

=head1 PRIVATE METHODS

Only for developers or maintainers.

=head2 B<< _fetch_system_group($session) >>

Fetch values from the system-group once during object initialization. Push error message onto the error buffer in case of failure and returns nothing.

=cut

sub _fetch_system_group {
  my $session = shift;
  my $result;

  # fetch the mib-II system-group
  $result = $session->get_request(
    -varbindlist => [

      SYS_DESCR,
      SYS_OBJECT_ID,
      SYS_UP_TIME,
      SYS_CONTACT,
      SYS_NAME,
      SYS_LOCATION,
      SYS_SERVICES,
    ],

    # define callback if in nonblocking mode
    $session->nonblocking ? ( -callback => \&_system_group_cb ) : (),
  );

  unless (defined $result) {
    if (my $err_msg = $session->error) {
      push_error($session, "$prefix: $err_msg");
    };
    return;
  }

  # in nonblocking mode the callback will be called asynchronously
  return 1 if $session->nonblocking;

  # ok we are in synchronous mode, call the result mangling function
  # by hand
  _system_group_cb($session);

}

=head2 B<< _system_group_cb($session) >>

The callback for _fetch_system_group. Push error message onto the error buffer in case of failure and returns nothing.

=cut

sub _system_group_cb {
  my $session = shift;
  my $vbl     = $session->var_bind_list;

  unless (defined $vbl) {
    if (my $err_msg = $session->error) {

      # Net::SNMP looses sometimes error messages in nonblocking
      # mode, so we save them in an extra buffer
      push_error($session, "$prefix: $err_msg");
    };
    return;
  }


  $session->{$prefix}{sysGroup}{sysDescr}    = $vbl->{ SYS_DESCR() };
  $session->{$prefix}{sysGroup}{sysObjectID} = $vbl->{ SYS_OBJECT_ID() };
  $session->{$prefix}{sysGroup}{sysUpTime}   = $vbl->{ SYS_UP_TIME() };
  $session->{$prefix}{sysGroup}{sysContact}  = $vbl->{ SYS_CONTACT() };
  $session->{$prefix}{sysGroup}{sysName}     = $vbl->{ SYS_NAME() };
  $session->{$prefix}{sysGroup}{sysLocation} = $vbl->{ SYS_LOCATION() };
  $session->{$prefix}{sysGroup}{sysServices} = $vbl->{ SYS_SERVICES() };

  $session->{$prefix}{__initialized}++;

  return 1;
}

unless ( caller() ) {
  print "$prefix compiles and initializes successful.\n";
}

=head1 BUGS, PATCHES & FIXES

There are no known bugs at the time of this release. However, if you spot a bug or are experiencing difficulties that are not explained within the POD documentation, please submit a bug to the RT system (see link below). However, it would help greatly if you are able to pinpoint problems or even supply a patch.

Fixes are dependant upon their severity and my availablity. Should a fix not be forthcoming, please feel free to (politely) remind me by sending an email to [e-mail] .

  RT: http://rt.cpan.org/Public/Dist/Display.html?Name=Net-SNMP-Mixin

=head1 AUTHOR

Karl Gaissmaier
=head1 COPYRIGHT & LICENSE

Copyright 2008 Karl Gaissmaier, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;

# vim: sw=2