view release on metacpan or  search on metacpan

lib/App/Netdisco/Util/SNMP.pm  view on Meta::CPAN

}

=head2 decode_and_munge( $method, $data )

Takes some data from snmpwalk cache that has been Base64 encoded,
decodes it and then munge to handle data format, before finally pretty
render in JSON format.

=cut

sub get_code_info { return ($_[0]) =~ m/^(.+)::(.*?)$/ }
sub sub_name      { return (get_code_info $_[0])[1] }
sub class_name    { return (get_code_info $_[0])[0] }

sub decode_and_munge {
    my ($munger, $encoded) = @_;
    return undef unless defined $encoded and length $encoded;

    my $json = JSON::PP->new->utf8->pretty->allow_nonref->allow_unknown->canonical;
    $json->sort_by( sub { sortable_oid($JSON::PP::a) cmp sortable_oid($JSON::PP::b) } );

    return undef if $encoded !~ m/^\[/; # legacy format double protection for web crash
    my $data = (@{ from_json($encoded) })[0];

    $data = (ref {} eq ref $data)
      ? { map {($_ => (defined $data->{$_} ? decode_base64($data->{$_}) : undef))}
              keys %$data }
      : (defined $data ? decode_base64($data) : undef);

    return $json->encode( $data ) if not $munger;

    my $sub   = sub_name($munger);
    my $class = class_name($munger);
    Module::Load::load $class;

    # munge_e_type seems broken, noop it
    return $json->encode( $data ) if $sub eq 'munge_e_type' and $class eq 'SNMP::Info';

    $data = (ref {} eq ref $data)
      ? { map {($_ => (defined $data->{$_} ? $class->can($sub)->($data->{$_}) : undef))}
              keys %$data }
      : (defined $data ? $class->can($sub)->($data) : undef);

    return $json->encode( $data );
}

=head2 sortable_oid( $oid, $seglen? )

Take an OID and return a version of it which is sortable using C<cmp>
operator. Works by zero-padding the numeric parts all to be length
C<< $seglen >>, which defaults to 6.

=cut

# take oid and make comparable
sub sortable_oid {
  my ($oid, $seglen) = @_;
  $seglen ||= 6;
  return $oid if $oid !~ m/^[0-9.]+$/;
  $oid =~ s/^(\.)//; my $leading = $1;
  $oid = join '.', map { sprintf("\%0${seglen}d", $_) } (split m/\./, $oid);
  return (($leading || '') . $oid);
}

true;