package UPC;

use strict;
use warnings;

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

use Date::Parse;
use POSIX;

use File::Basename qw(dirname);
use File::Path qw(make_path);

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 bootpages {
    # these pages are only available when booting
    return [ 'emta', 'signal', 'status', 'log' ]
}

sub backup {
    my $self = shift;
    my $backupfile = shift;
    my $rawconfig = $self->_getconfig();

    my $backupfilename = strftime($backupfile, gmtime());
    my $backuppath = dirname($backupfilename);

    make_path($backuppath, {mode => 0755});

    if (open(my $BACKUP, '>', $backupfilename)) {
        print $BACKUP $rawconfig;
        return $backupfilename;
    }
    return;
}

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 _ip_mgmt {
    my $self = shift;
    my $c = $self->_getpage('RgDhcp.asp' );
    my @leases;

    my $p =new HTML::TokeParser(\$c);
    my $t = $p->get_tag('select');

    if (($t->[1]{name}||'') eq 'LeaseToFree' ) {
        while ( $t = $p->get_tag('option', '/select')) {
            last if $t->[0] eq '/select';
            my $row = $p->get_text('/option');
            chomp($row);
            my @data = split(/\xa0+/, $row);
            $data[0] = uc($data[0]);
            $data[0] =~ s/(..)(?=.)/$1:/g;
            my %data = (
                        macaddr => $data[0],
                        ipaddr => $data[1],
                        netmask => $data[2],
                        duration => $data[3],
                        expires => $data[4],
                       );
            push @leases, \%data;
        }
    }
    \@leases;
}

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;