Tie.pm 3.39 KB
Newer Older
Alexander Gall's avatar
Alexander Gall committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
package Snabb::SNMP::Tie;

use 5.020002;
use strict;
use warnings;
require Tie::Scalar;
use SNMP;
use Snabb::SNMP::Agent qw($sysUpTime_base);
require Exporter;

our @ISA = qw(Exporter Tie::Scalar);

sub TIESCALAR {
  my ($class, $segment, $name, $handler) = @_;
  exists $segment->{objs}{$name} or
    die "Object $name not present in segment $segment->{name} ($segment->{file})";
  my $self = { segment => $segment,
	       obj => $name,
	       handler => $handler };
  return bless($self, $class);
}

package Snabb::SNMP::Tie::INTEGER;

our @ISA = qw(Snabb::SNMP::Tie);

sub FETCH {
  my ($self) = @_;
  my $obj = $self->{segment}{objs}{$self->{obj}};
  $obj->{length} == 4 or die
    "Bad field length for INTEGER, expected 4, got $obj->{length}";
  my $value = unpack("L", substr(${$self->{segment}{mmap}}, $obj->{offset}, $obj->{length}));
  if (defined $self->{handler}) {
    return $self->{handler}($value, $self->{obj}, $self->{segment});
  }
  return $value;
}

package Snabb::SNMP::Tie::INTEGER64;

our @ISA = qw(Snabb::SNMP::Tie);

sub FETCH {
  my ($self) = @_;
  my $obj = $self->{segment}{objs}{$self->{obj}};
  $obj->{length} == 8 or die
    "Bad field length for INTEGER64, expected 8, got $obj->{length}";
  my $value = unpack("Q", substr(${$self->{segment}{mmap}}, $obj->{offset}, $obj->{length}));
  if (defined $self->{handler}) {
    return $self->{handler}($value, $self->{obj}, $self->{segment});
  }
  return $value;
}

package Snabb::SNMP::Tie::OCTETSTR;

our @ISA = qw(Snabb::SNMP::Tie);

sub FETCH {
  my ($self) = @_;
  my $obj = $self->{segment}{objs}{$self->{obj}};
  my $mmap = ${$self->{segment}{mmap}};
  my $len = unpack("S", substr($mmap, $obj->{offset}, 2));
  my $value = substr($mmap, $obj->{offset}+2, $len);
  if (defined $self->{handler}) {
    return $self->{handler}($value, $self->{obj}, $self->{segment});
  }
  return $value;
}

package Snabb::SNMP::Tie::TICKS;

our @ISA = qw(Snabb::SNMP::Tie::INTEGER);

sub FETCH {
  my ($self) = @_;
  my $stamp = $self->SUPER::FETCH();
  my $syntax = $self->{segment}{objs}{$self->{obj}}{oid_node}->{syntax};
  if ($syntax eq 'TimeStamp') {
    my $aux_name = "_X_".$self->{obj}."_TimeAbs";
    my $aux_obj = $self->{segment}{objs}{$aux_name};
    if (defined $aux_obj) {
      ## $stamp is an absolute time stamp.  Convert it to
      ## the notion of sysUpTime
      $aux_obj->{length} == 8 or die
	"Wrong size of TimeStamp aux variable $aux_name";
      my $stamp_abs = unpack("Q", substr(${$self->{segment}{mmap}},
					 $aux_obj->{offset},
					 $aux_obj->{length}));
      ## TimeTicks are in units of 1/100 seconds while the auxiliary
      ## variable uses regular Unix time stamps in units of seconds.
      $stamp = 100*($stamp_abs - $Snabb::SNMP::Agent::sysUpTime_base);
    }
  } else {

    ## The syntax is TimeTicks.  If the auxiliary variable with suffix
    ## "_TicksBase" exists, the ticks are calculated as the difference
    ## between that time stamp and the current time.
    my $aux_name = "_X_".$self->{obj}."_TicksBase";
    my $aux_obj = $self->{segment}{objs}{$aux_name};
    if (defined $aux_obj) {
      $aux_obj->{length} == 8 or die
	"Wrong size of TimeStamp aux variable $aux_name";
      my $stamp_abs = unpack("Q", substr(${$self->{segment}{mmap}},
					 $aux_obj->{offset},
					 $aux_obj->{length}));
      if ($stamp_abs != 0) {
	$stamp = 100*(time() - $stamp_abs);
      }
    }
  }
  return $stamp;
}

1;

## Local Variables:
## mode: CPerl
## End: