view release on metacpan or  search on metacpan

lib/Net/SNMP.pm  view on Meta::CPAN

         'The entryoid argument is obsolete, use the columns argument ' .
         'with a list of column OBJECT IDENTIFIERs'
      );

      if ($argv[0] !~ m/^\.?\d+(?:\.\d+)* *$/) {
         return $this->_error(
            'The entryoid value "%s" is expected in dotted decimal notation',
            $argv[0]
         );
      }

      my $columns = {};

      for (@{$argv[1]}) {
         if (!m/^\d+$/) {
            return $this->_error(
               'The columns list value "%s" is expected in positive numeric ' .
               'format', $_
            );
         }
         if (exists $columns->{$_}) {
            return $this->_error(
               'The columns list value "%s" is duplicated in the columns list',
               $_
            );
         } else {
            $columns->{$_} = $_;
         }
      }

      # Now create the new syntax for the columns list.

      $argv[1] = [];

      for (sort { $a <=> $b } (keys %{$columns})) {
         push @{$argv[1]}, join q{.}, $argv[0], $_;
      }

   }

   # Validate the column list. 

   for (@{$argv[1]}) {
      if (!m/^\.?\d+(?:\.\d+)* *$/) {
         return $this->_error(
            'The columns list OBJECT IDENTIFIER "%s" is expected in dotted ' .
            'decimal notation', $_
         );
      }
   }

   my $start_index = undef;

   if (defined $argv[2]) {
      if ($argv[2] !~ m/^\d+(?:\.\d+)*$/) {
         return $this->_error(
            'The start index "%s" is expected in dotted decimal notation',
            $argv[2]
         );
      }
      my @subids = split m/\./, $argv[2];
      if ($subids[-1] > 0) {
         $subids[-1]--;
      } else {
         pop @subids;
      }
      $start_index = (@subids) ? join(q{.}, @subids) : q{};
   }

   if (defined $argv[3]) {
      if ($argv[3] !~ /^\d+(?:\.\d+)*$/) {
         return $this->_error(
             'The end index "%s" is expected in dotted decimal notation',
             $argv[3]
         );
      }
      if (defined $argv[2]) {
         if (oid_lex_cmp($argv[2], $argv[3]) > 0) {
            return $this->_error(
               'The end index cannot be less than the start index'
            );
         }
      }
   }

   # Undocumented and unsupported "-rowcallback" argument.

   if (defined $argv[5]) {
      if (ref $argv[5] eq 'CODE') {
         $argv[5] = [$argv[5]];
      } elsif ((ref($argv[5]) ne 'ARRAY') || (ref($argv[5]->[0]) ne 'CODE')) {
         return $this->_error('The syntax of the row callback is invalid');
      }
   }

   # Create a new PDU.
   if (!defined $this->_create_pdu()) {
      return $this->_error();
   }

   # Create table of values that need passed along with the
   # callbacks.  This just prevents a big argument list.

   my $argv = {
      callback     => $this->{_pdu}->callback(),
      columns      => $argv[1],
      end_index    => $argv[3],
      entries      => undef,
      last_index   => undef,
      max_reps     => 0,
      row_callback => $argv[5],
      start_index  => $argv[2],
      types        => undef,
      use_bulk     => FALSE
   };

   # Override the callback now that we have stored it.
   $this->{_pdu}->callback(
      sub
      {
         $this->{_pdu} = $_[0];

lib/Net/SNMP.pm  view on Meta::CPAN

      eval { Net::SNMP::Transport->debug($DEBUG & DEBUG_TRANSPORT);          };
      eval { Net::SNMP::Dispatcher->debug($DEBUG & DEBUG_DISPATCHER);        };
      eval { Net::SNMP::MessageProcessing->debug($DEBUG & DEBUG_PROCESSING); };
      eval { Net::SNMP::Security->debug($DEBUG & DEBUG_SECURITY);            };

   }

   return $DEBUG;
}

sub snmp_debug
{
   return debug(undef, $_[0]);
}

sub pdu
{
   return $_[0]->{_pdu};
}

sub nonblocking
{
   return $_[0]->{_nonblocking};
}

sub security
{
   return $_[0]->{_security};
}

sub transport
{
   return $_[0]->{_transport};
}

=head1 SUBROUTINES

=head2 oid_base_match() - determine if an OID has a specified OID base 

   $value = oid_base_match($base_oid, $oid);

This function takes two OBJECT IDENTIFIERs in dotted notation and returns a
true value (i.e. 0x1) if the second OBJECT IDENTIFIER is equal to or is a 
child of the first OBJECT IDENTIFIER in the SNMP Management Information Base 
(MIB).  This function can be used in conjunction with the C<get-next-request()>
or C<get-bulk-request()> methods to determine when a OBJECT IDENTIFIER in the 
GetResponse-PDU is no longer in the desired MIB tree branch.

=cut

sub oid_base_match
{
   my ($base, $oid) = @_;

   defined $base || return FALSE;
   defined $oid  || return FALSE;

   $base =~ s/^\.//o;
   $oid  =~ s/^\.//o;

   $base = pack 'N*', split m/\./, $base;
   $oid  = pack 'N*', split m/\./, $oid;

   return (substr($oid, 0, length $base) eq $base) ? TRUE : FALSE;
}

sub oid_context_match
{
   require Carp;
   Carp::croak(
       'oid_context_match() is obsolete, use oid_base_match() instead'
   );

   goto &oid_base_match;
}

=head2 oid_lex_cmp() - compare two OBJECT IDENTIFIERs lexicographically

   $cmp = oid_lex_cmp($oid1, $oid2);

This function takes two OBJECT IDENTIFIERs in dotted notation and returns one
of the values 1, 0, -1 if $oid1 is respectively lexicographically greater,
equal, or less than $oid2.

=cut 

sub oid_lex_cmp
{
   my ($aa, $bb) = @_;

   for ($aa, $bb) {
      s/^\.//;
      s/ /\.0/g;
      $_ = pack 'N*', split m/\./;
   }

   return $aa cmp $bb;
}

=head2 oid_lex_sort() - sort a list of OBJECT IDENTIFIERs lexicographically

   @sorted_oids = oid_lex_sort(@oids);

This function takes a list of OBJECT IDENTIFIERs in dotted notation and returns
the listed sorted in lexicographical order.

=cut

sub oid_lex_sort
{
   if (@_ <= 1) {
      return @_;
   }

   return map { $_->[0] }
             sort { $a->[1] cmp $b->[1] }
                map
                {
                   my $oid = $_;
                   $oid =~ s/^\.//;
                   $oid =~ s/ /\.0/g;
                   [$_, pack 'N*', split m/\./, $oid]
                } @_;
}

=head2 snmp_type_ntop() - convert an ASN.1 type to presentation format

   $text = snmp_type_ntop($type);

This function takes an ASN.1 type octet and returns a text string suitable for
presentation.  Some ASN.1 type definitions map to the same octet value when
encoded.  This method cannot distinguish between these multiple mappings and
the most basic type name will be returned.

=cut

sub snmp_type_ntop
{
   goto &asn1_itoa;
}

=head2 ticks_to_time() - convert TimeTicks to formatted time

   $time = ticks_to_time($timeticks);

This function takes an ASN.1 TimeTicks value and returns a string representing
the time defined by the value.  The TimeTicks value is expected to be a 
non-negative integer value representing the time in hundredths of a second 
since some epoch.  The returned string will display the time in days, hours, 
and seconds format according to the value of the TimeTicks argument.

=cut

sub ticks_to_time
{
   goto &asn1_ticks_to_time;
}

sub DESTROY
{
   my ($this) = @_;

   # We decrement the object type count when the object goes out of
   # existance.  We assume that _object_type_validate() was called for
   # every creation or else we die.

   if ($this->{_nonblocking}) {
      if (--$NONBLOCKING < 0) {
         die 'FATAL: Invalid non-blocking object count';
      }
   } else {
      if (--$BLOCKING < 0) {
         die 'FATAL: Invalid blocking object count';
      }
   }
}

# [private methods] ----------------------------------------------------------

sub _send_pdu
{
   my ($this) = @_;