Dave J.'s modem program

modem.pl

#!/usr/bin/perl -w

use strict;
use warnings qw(all);

use LWP::Simple;
use Data::Dumper;
use HTML::TreeBuilder;
use HTML::DOMbo;
use Win32::API;

my $stat_url = 'http://192.168.100.1/cmSignalData.htm';
my $lfilename = 'modem_log.csv';

my $setthreadexecutionstate = 
    Win32::API->new('kernel32', 'SetThreadExecutionState','N','N');

open(OF,'>>',$lfilename);
OF->autoflush(1);

$| = 1;

my $last_l0 = '';
while (1) {
    my $modem_data= getStatHTML();
    if ($modem_data->{ok}) {
        my $lines = structToLine($modem_data);
        if ($last_l0 ne $lines->[0]) {
            print OF $lines->[0] . "\n";
        }
        print OF $lines->[1] . "\n";
        $last_l0 = $lines->[0];
    }
    keepAwake($setthreadexecutionstate);
    sleep 60;
};

sub getStatHTML {
    my $res = { ok => 0 };
    my $content = get($stat_url);
    if (defined($content) && length($content)) {
        $res->{ok} = 1;	
        my $tree = HTML::TreeBuilder->new;
        $tree->parse($content);
        $tree->eof();
        my $dom_tree = $tree->to_XML_DOM;
# $tree->delete;
        my @tables = $dom_tree->getElementsByTagName('table');
        my $curr_table_name = "_none";
        my $channels = {};
        foreach my $table (@tables) {
            my $table_width = $table->getAttribute('width');	
            if (defined($table_width) && ($table_width)) {
# the only table we are not interested also happens to have the 
# width attribute set, o we can skip it.
            } else {
                my @rows = $table->getElementsByTagName('tr');
                foreach my $row (@rows) {
                    my @thelems = $row->getElementsByTagName('th');
                    if (@thelems) {
                        $curr_table_name = $thelems[0]->toString();
                        $curr_table_name =~ s/<th.*">//g;
                        $curr_table_name =~ s/<\/.*$//;
# print "TABLE_NAME $curr_table_name\n";
                    };
                    my @elems = $row->getElementsByTagName('td');
                    my $in_ids = 0;
                    my $name = "_undef";
                    my $col_ct = 0;
                    foreach my $elem (@elems) {
# print "COL $col_ct\n";
                        my $nv = $elem->toString;
                        $nv =~ s/^<td>//g;
                        $nv =~ s/<\/td>//g;
                        $nv =~ s/\x{a0}//g;
                        $nv =~ s/^\s*//;
                        $nv =~ s/\s*$//;
# I cannot figure out why we need this extra shift on Power Level
# but without it the prog acts like one of the columns has not been
# consumed. So strange!
                        if ($nv =~ /Power Level/) { $nv = 'Power Level'; shift @elems};
                        if (!$col_ct) {
                            $name = $nv;
# print "NAME $name\n";
                        } elsif ($name =~ /Channel ID/) {
                            $channels->{$col_ct} = $nv;
                        } else {
                            $res->{data}{$curr_table_name}{$name}{ $channels->{$col_ct} } = $nv;
# print "TABLE $curr_table_name, VAR $name, COL $col_ct, CH $channels->{$col_ct}, VAL $nv\n";
                        }
                        $col_ct++;
                    }
                }
            }
        }
    }	
    return $res;
};

sub structToLine {
    my $data = shift;
    my $now = time;

    my $oa = [
        [ '','' ],
        [ $now, scalar localtime $now, ],
        ];

    foreach my $table (keys %{$data->{data}}) {
        foreach my $variable (keys %{$data->{data}{$table}}) {
            foreach my $channel (keys %{$data->{data}{$table}{$variable}}) {
                push(@{$oa->[0]}, $table . '__' . $variable . '__ch' . $channel);
                push(@{$oa->[1]}, $data->{data}{$table}{$variable}{$channel});
            }
        }
    }

    my $os = [ '', '', ];

    for my $l (0, 1) {
        $os->[$l] = join(',',@{$oa->[$l]});
    }
    return $os;
};

sub keepAwake {
    my $stes = shift;

    if (defined($stes)) {
        my $res = $stes->Call(0x80000001);
        print sprintf("-info- new execution state is %x\n",$res);
    } else {
        print STDERR "could not run Win32 SetThreadExecutionState\n";
    };
};