# Copyright (C) 2013 Moritz Orbach <gnu@apfelboymchen.net>
# http://apfelboymchen.net/gnu/collectd/collectd-perl.html
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# birth: 16.05.2013
#
=head1 NAME

tecom - collectd plugin to gather statistics from a Tecom DSL modem

=head1 DESCRIPTION

This plugin gathers data from the statistics page of the the Tecom Tiny Bridge 
DSL Modem. It also serves as an example on how to write collectd plugins.

The Modem only has one page. The IP is 192.168.1.1. Login and pass are admin. 
Neither passord nor IP can be changed.

=head1 AUTHOR

Moritz Orbach <gnu@apfelboymchen.net>
L<http://apfelboymchen.net/gnu/collectd/collectd-perl.html>

=cut

# This is the relevant output from the modem:
# <tr>
#    <td class='hd'>&nbsp;Rate (Kbps):&nbsp;</td>
#    <td>&nbsp;17693&nbsp;</td>
#    <td>&nbsp;1167&nbsp;</td>
# </tr>
# <tr>
#    <td class='hd'>&nbsp;SNR Margin (dB):&nbsp;</td>
#    <td>&nbsp;6.3&nbsp;</td>
#    <td>&nbsp;13.5&nbsp;</td>
# </tr>
# <tr>
#    <td class='hd'>&nbsp;Attenuation (dB):&nbsp;</td>
#    <td>&nbsp;14.5&nbsp;</td>
#    <td>&nbsp;8.4&nbsp;</td>
# </tr>

package Collectd::Plugins::Tecom;

use strict;
use warnings;

use Collectd qw( :all );
use LWP::UserAgent;

#  This thing only has this one page. Neither passord nor IP can be changed.
my $CFG_url = 'http://admin:admin@192.168.1.1/';

# plugin name
my $CFG_plugin_name = "tecom";

##

# long live the user agent
my $UA = undef;

#
## The Tecom-specific part to get and extract the values
#

# extract the number from $line. $line is assumed to be in the format as 
# normally returned by the modem
# example: <td>&nbsp;17693&nbsp;</td>
sub extract_number
{
	my $line = shift;

	$line =~ /&nbsp;(\d+\.*\d+)&nbsp;/;
	return $1;
}

# return the numbers from the next two lines
sub get_values
{
	my $li = shift; # line iterator

	my $down = extract_number($li->());
	my $up = extract_number($li->());

	return ($down, $up);
}

# the closure returns the next line of $text on every call
sub line_iterator
{
	my $text = shift;

	return sub {
		# global matching (continue after last match)
		$text =~ /([^\n]+)\n?/g;
		return $1;
	}
}

# extract the data from $statuspage_ref
sub extract_data
{
	my $statuspage_ref = shift;

	my ( $snr_up, $snr_down, $att_up, $att_down, $rate_up, $rate_down );
	my $li = line_iterator($$statuspage_ref);
	while ($_ = $li->()) {
		# if the string is found, the next two lines will contain the values
		if (/SNR Margin/) {
			($snr_down, $snr_up) = get_values($li);
		}
		if (/Attenuation/) {
			($att_down, $att_up) = get_values($li);
		}
		if (/Rate/) {
			($rate_down, $rate_up) = get_values($li);
		}
	}

	return ( $snr_up, $snr_down, $att_up, $att_down, $rate_up, $rate_down );
}

#
## The collectd part
#

# callback to collect the data and hand it to collectd via 
# plugin_dispatch_values()
sub tecom_read
{
	plugin_log(LOG_NOTICE, "tecom_read!"); # debug
	my $time = time;
	my $response = $UA->get($CFG_url);

	if ($response->is_success()) {

		# get the data
		my $statuspage = $response->decoded_content();
		# and extract the values
		my ( $snr_up, $snr_down, $att_up, $att_down, $rate_up, $rate_down ) = extract_data(\$statuspage);

		plugin_log(LOG_NOTICE, "dispatch: >$snr_down< >$snr_up< >$att_down< >$att_up< >$rate_down< >$rate_up<"); # debug
		my $v = {
			plugin   => $CFG_plugin_name,
			time     => $time,
			#interval => 60,
			#interval => plugin_get_interval(),
			#host     => $hostname_g,
			#plugin_instance => "",
			#type_instance   => "",
		};
	   	$v->{type}   = "tecom_q",
	   	$v->{values} = [ $snr_down, $snr_up, $att_down, $att_up ],
		plugin_dispatch_values($v);

	   	$v->{type}   = "tecom_rate",
	   	$v->{values} = [ $rate_down, $rate_up ];
		plugin_dispatch_values($v);
	}
	else {
		plugin_log(LOG_ERR, "$CFG_plugin_name plugin: modem returned " . $response->status_line());
	}

	return $response->is_success();
}

# plugin initialization callback
sub tecom_init
{
	plugin_log(LOG_INFO, "init!"); # debug
	$UA = LWP::UserAgent->new(keep_alive => 1);
	$UA->timeout(3);
}

#
## initialization
#

#plugin_log(LOG_INFO, $CFG_plugin_name);

# deprecated. Why?? Wouldn't it be better if every plugin could bring its own 
# definition in the same file?
#plugin_register(TYPE_DATASET, $CFG_plugin_name, $CFG_dataset);

plugin_register(TYPE_INIT, $CFG_plugin_name, "tecom_init");
plugin_register(TYPE_READ, $CFG_plugin_name, "tecom_read");

1;