package UPC;

use strict;
use warnings;

use WWW::Mechanize;
use HTML::TokeParser;

use Date::Parse;

use UPC::Config;

sub new {
    my $type = shift;
    my %opts = @_;
    my $self = {};

    $opts{ipaddr} ||= '192.168.1.1';
    $opts{username} ||= '';

    # default password is blank, so this probably works
    $opts{password} ||= '';

    my $ua = new WWW::Mechanize( env_proxy => 0, timeout => 10 );
    $ua->credentials( $opts{ipaddr} . ':80',
                      'Cisco',
                      $opts{username},
                      $opts{password} );

    $self->{ua} = $ua;
    $self->{ipaddr} = $opts{ipaddr};
    $self->{username} = $opts{username};
    $self->{password} = $opts{password};

    return bless $self, $type;
}

=pod
 reset() - reset the modem. returns 0 on failure, 1 on success.

=cut

sub reset {
    my $self = shift;

    my $c = $self->_getpage( 'restart.asp' );
    if ( $c ) {
        my $res = $self->{ua}->submit();
        if ( $res->is_success()) {
            return 1;
        }
    }
    return 0;
}

sub _getconfig {
    my $self = shift;

    my $c = $self->_getpage( 'filename.gwc' );
    if ( $c ) {
        $self->{_config} = new UPC::Config();
        $self->{_config}->parsetext( $c );
    }

    return $c;
}

sub _system {
    my $self = shift;

    my $data = {
                Date => scalar( gmtime( time ))
               };

    my $c = $self->_getpage( 'system.asp' );
    if ( $c ) {
        my $p = new HTML::TokeParser( \$c );
        my $label = "";
        while( my $t = $p->get_token( "td" )) {
            my $text = $p->get_trimmed_text( "/td" );
            if ( $text !~ /^[[:print:]]/ ) {
                $text =~ s/^.\s*//;
                $data->{$label} = $text;
                # cheap hack
                last if $label eq "Software Revision";
            } else {
                $text =~ s/^.*\. //;
                $label = $text;
            }
        }
    } else {
        $data->{'Cable Modem Status'} = 'Admin Interface not responding';
    }

    $data;
}

sub _network {
    my $self = shift;

    my $c = $self->_getpage( 'RgSetup.asp' );

    my $data = {
                Date => scalar( gmtime( time ))
               };

    if ( $c ) {
        my $p = new HTML::TokeParser( \$c );
        while ( my $t = $p->get_tag( "input" )) {
            if ( $t->[1]{name} ) {
                $data->{$t->[1]{name}} = $t->[1]{value};
            }
        }

        # reset parser, and pull the plain text
        $p = new HTML::TokeParser( \$c );
        while ( my $t = $p->get_tag( "tr" )) {
            my ( $key, $value ) = ( undef, "" );
            my $col = 0;
            while ( my $t1 = $p->get_tag( "td", "/tr" )) {
                last if $t1->[0] eq "/tr";
                $col++;
                next if $col == 1;
                my $text = $p->get_trimmed_text( "/td" );
                if ( $col == 2 ) {
                    if ( $text !~ /^[[:print:]]/ ) {
                        $text = 'IPv4 DNS Servers';
                        $value = $data->{$text};
                    }
                    $key = $text;
                } else {
                    if ( $value ) {
                        $value = join( ", ", $value, $text );
                    } else {
                        $value = $text;
                    }
                }
            }
            next unless defined($key) and defined($value);
            $key =~ s/:$//;
            $data->{$key} = $value;
        }
    }

    # data fiddling
    my $leaselength = $data->{Duration};
    my $leaseexpires = $data->{Expires};
    $data->{LeaseTime} = time;

    if ( $leaselength and $leaseexpires ) {
        my $exp = str2time( $leaseexpires );
        my %len = split( /:?\s+/, $leaselength );

        # now backtrack, not wholly accurate
        if ( $exp ) {
            $data->{LeaseTime} =
              $exp
                - $len{S}
                  - ( 60 * $len{M} )
                      - ( 60 * 60 * $len{H} )
                        - ( 24 * 60 * 60 * $len{D} );
        }
    }

    $data;
}

sub _getpage {
    my $self = shift;
    my $page = shift;

    my $res = $self->{ua}->get( 'http://' . $self->{ipaddr} . '/' . $page );
    my $c;
    if ( $res->is_success()) {
        $c = $self->{ua}->content();
    } else {
        $c = "";
    }
    return $c;
}

1;