File Coverage

blib/lib/Net/Int/Stats.pm

Criterion	Covered	Total	%
statement	37	49	75.5
branch	20	22	90.9
condition	15	15	100.0
subroutine	6	9	66.6
pod	0	7	0.0
total	78	102	76.4

package Net::Int::Stats;

our $VERSION = '2.1';

use strict;
use warnings;

############ Global Declarations ##############

# hash of hashes
# key1 - interface, key2 - type ex: rx_packets, values ex: 'packets:12345'
my %interface_values;

# tmp array to store string tokens
my @tmp;

# interface name
my $key1;

# value types
my @key2;

########## End Global Declarations ###########

# generate ifconfig values
sub data {

    # store ifconfig output
    my @ifconfig_out = `/sbin/ifconfig`;

    # loop through each line of ifconfig output
    foreach (@ifconfig_out){

        # skip if blank line
        next if /^$/;

        # get interface name if not white space
        if (!/^\s/){

            # extract values
            extract($_);

            # store first token of interface name
            $key1 = shift(@tmp);
        }

        # get inet address, RX, TX, collisions and txqueuelen values
        # look for 'inet addr' or 'RX' or 'TX' or 'collisions' text
        if (/RX/ || /TX/ || /collisions/ || /inet addr/){

            # key2 values
            @key2 = qw(inet_addr) if (/inet addr/);
            @key2 = qw(rx_packets rx_errors rx_dropped rx_overruns rx_frame) if (/RX packets/);
            @key2 = qw(tx_packets tx_errors tx_dropped tx_overruns tx_carrier) if (/TX packets/);
			@key2 = qw(rx_bytes tx_bytes) if (/RX bytes/);
            @key2 = qw(collisions txqueuelen) if (/collisions/);

            # extract values
            extract($_);

            # shift first token of 'inet' or 'RX' or 'TX'
            shift(@tmp) if (/inet addr/ || /RX packets/ || /TX packets/);

            # build values hash
            build();
        }
    }
}

# extract values
sub extract {

    # ifconfig output line with newlines removed
    my $line = shift;

    # remove spaces
    $line =~ s/^\s+//;

    # store tokens split on spaces
    @tmp = split (/\s/, $line);

    # check if line is RX or TX bytes
    if ($line =~ /bytes/){
        # slice bytes values
        @tmp = @tmp[1,6];
    }
}

# build values hash
sub build {

    # values type count
    my $i = 0;

    # loop through value types
    for (@key2){

        # build hash with interface name, value type, and value
        $interface_values{$key1}{$_} = $tmp[$i];

        # increment values type count
        $i++;
    }
}

# validate interface name
sub validate {

    # interface name
    my $int = shift;

    # terminate program if specified interface name is not in ifconfig output
    die "specified interface $int not listed in ifconfig output!\n" if !(grep(/$int/, keys %interface_values));
}

# create new Net::Int::Stats object
sub new {

    # class name
    my $class = shift;

    # allocate object memory
    my $self = {};

    # assign object reference to class
    bless($self, $class);

    # initialize values reference
    $self->{VALUES} = '';

    # initialize interfaces list reference
    $self->{INTERFACES} = '';

    # generate value data
    data();

    # return object reference
    return $self;
}

# get specific ifconfig value for specific interface
sub value {

    # object reference
    my $self = shift;

    # interface name
    my $int = shift;

    # value type
    my $type = shift;

    # validate if supplied interface is present
    validate($int);

    # user specified value
    $self->{VALUES} = $interface_values{$int}{$type};

    # return value
    return $self->{VALUES};
}

sub interfaces {

    # object reference
    my $self = shift;

    # interface list
    my @int_list = keys %interface_values;

    # interface list reference
    $self->{INTERFACES} = "@int_list";

    # return value
    return $self->{INTERFACES};
}

1;

__END__