Perl script to feed signal/uptime from motorola cablemodem into carbon/graphite database

cablemodem_stats.pl

#!/usr/bin/perl -w
 
use strict;
use 5.020;
use Cache::FileCache;
use Data::Dumper;
use Date::Format;
use File::Basename qw( basename );
use Getopt::Long qw( :config auto_help auto_version bundling no_ignore_case );
use IO::Socket;
use LWP::Simple;
my $scriptname = basename($0);
my $carbon_server = "127.0.0.1";
my $carbon_port = 2003;
my $cache_expiry = 55;     # Should set to just under how often you'll poll to 
                        # allow caching while testing but get live data when really polling
my $lynx_status = "SCRIPT or call like lynx -dump http://modem/cgi-bin/status or equiv";
my $lynx_swinfo = "SCRIPT or call like lynx -dump http://modem/cgi-bin/swinfo or equiv";

GetOptions(
    'v|verbose'     =>  \my $verbose,
    'd|dryrun'      =>  \my $dryrun,
    'h|help'        =>  sub{ help() },
    's|server=s'    =>  \$carbon_server,
    'p|port=i'      =>  \$carbon_port,
);

my $sock = IO::Socket::INET->new(
    PeerAddr    => $carbon_server,
    PeerPort    => $carbon_port,
    Proto       => 'tcp',
) unless($dryrun);

if (!$dryrun) {
    die "Failed to connect o $carbon_server:$carbon_port: $!\n" unless ($sock->connected);
}

my $cm = load_cm_data();
my $now = time();
foreach my $type (sort keys %{$cm}) {
    next if (ref $cm->{$type} ne "HASH");
    foreach my $chan (sort keys %{$cm->{$type}}) {
        foreach my $key (sort keys %{$cm->{$type}->{$chan}}) {
            $sock->send("cablemodem.$type.$chan.$key $cm->{$type}->{$chan}->{$key} $now\n") unless($dryrun);
            verbose("\$sock->send\(\"cablemodem.$type.$chan.$key $cm->{$type}->{$chan}->{$key} $now\"\)");
        }
    }
}
if (defined($cm->{'uptime'})) {
    $sock->send("cablemodem.uptime $cm->{'uptime'} $now\n") unless($dryrun);
    verbose("\$sock->send\(\"cablemodem.uptime $cm->{'uptime'} $now\"\)");
}

$sock->shutdown(2) unless($dryrun);

# Handle the caching or actually get info from cablemodem.. mostly in here for
#  testing to avoid hitting modem more often.
sub load_cm_data {
    my $cache       = Cache::FileCache->new( { namespace => $scriptname } );
    my $key         = join ' ',$scriptname, 'web';
    my $data        = $cache->get( $key );
    if ( defined $data && ref $data eq 'HASH') {
        verbose("Cache hit");
        my $foo = $cache->get_object( $key );
        if (defined($foo->{'_Expires_At'})) {
            my $etime = $foo->{'_Expires_At'};
            my $left = $etime-time();
            verbose("Cache TTL = '$cache_expiry' seconds. $left seconds left");
        }
        return $data->{'stdout'};
    } 
    verbose("Cache miss, doing web query against cablemodem");
    verbose("Cache TTL = '$cache_expiry' seconds");
    my $starttime=time();
    verbose("Caching cm data");
    my $lcmd = $lynx_status;
    open my $lynx, '-|', $lcmd or die "Failure to rn $lcmd: $!\n";
    while (defined(my $line = readline($lynx))) {
        if (( $line =~ /.*Locked\s\d+QAM\s(\d+)\s+\d+\.\d+\sMHz\s+-\d+\.\d+\sdBmV\s+(\d+\.\d+)\s+dB\s+(\d+)\s+(\d+)/ ) or 
        ( $line =~ /.*Locked\s\d+QAM\s(\d+)\s+\d+\.\d+\sMHz\s+\d+\.\d+\sdBmV\s+(\d+\.\d+)\s+dB\s+(\d+)\s+(\d+)/ )) { 
            my $ch = $1; my $sig = $2; my $corr = $3; my $uncorr = $4;
            $data->{'stdout'}->{'down'}->{$ch}->{'sig'}=$sig;
            $data->{'stdout'}->{'down'}->{$ch}->{'corr'}=$corr;
            $data->{'stdout'}->{'down'}->{$ch}->{'uncorr'}=$uncorr;
        }
    }
    close $lynx;
    $lcmd = $lynx_swinfo;
    open $lynx, '-|', $lcmd or die "Failure to rn $lcmd: $!\n";
    while (defined(my $line = readline($lynx))) {
        if ($line =~ /Up Time (\d+)\s+d:\s+(\d+)\s+h:\s+(\d+)\s+m/) {
            my $uptime; 
            if (defined($1)) {
                $uptime=$1*86400;
            }
            if (defined($2)) {
                $uptime+=$2*3600;
            }
            if (defined($3)) {
                $uptime+=$3*60;
            }
            $data->{'stdout'}->{'uptime'}=$uptime;
        }
    }
    close $lynx;
    my $endtime=time();
    my $took = $endtime-$starttime;
    verbose("get took $took seconds, munging output");
    $cache->set( $key, $data, "$cache_expiry seconds" );
    return $data->{'stdout'};
}

sub verbose {
    return unless $verbose;
    say $_[0];
}

sub help {
    say "
Usage: $0 [--verbose|--dryrun]
    dryrun  : Don't send info to carbonDB
    verbose : Output verbose/debugging bits for testing
    ";
    exit;
}

__END__

=head1 NAME

cablemodem_stats.pl - Perl script to walk info from Motorola Cablemodem and feed signal info into a carbon/graphite DB

=head1 SYNOPSIS

B<cablemodem_stats.pl> [--verbose|--dryrun]
    dryrun  : Don't send info to carbonDB
    verbose : Output verbose/debugging bits for testing

Script currently requires setting the 2 \$lynx_* lines to point to simple shell scripts that call
lynx (or wget/curl/etc) to output the text of the status/swinfo pages from the modem vs parsing the
html itself.

=head1 EXAMPLE OUTPUT

    $ ./cablemodem_stats.pl --dryrun --verbose
    Cache miss, doing web query against cablemodem
    Cache TTL = '55' seconds
    Caching cm data
    get took 0 seconds, munging output
    $sock->send("cablemodem.down.1.corr 1633478 1476911547")
    $sock->send("cablemodem.down.1.sig 40.95 1476911547")
    $sock->send("cablemodem.down.1.uncorr 3001152 1476911547")
    [snip]

=cut

This is actually serious overkill with the caching, but I've gotten into the habit of including that so that I can usually do multiple runs while testing without hitting the device being queried every time.