#!/usr/bin/perl
# Copyright (C) 2004,2006,2007 Mark Suter <suter@humbug.org.au>
# $Id: internode-quota-check,v 1.27 2008/02/04 10:02:33 suter Exp suter $

use strict;
use warnings;
use English qw( -no_match_vars );
use Getopt::Long;
use IO::File;
use Pod::Usage;
use Storable;
use Time::Local;
use WWW::Mechanize;

## The locations of things not here...
my $uri         = 'https://accounts.internode.on.net/cgi-bin/padsl-usage';
my $cache       = "$ENV{HOME}/.internode-quota-check.cache";
my $fetchmailrc = "$ENV{HOME}/.fetchmailrc";
my $netrc       = "$ENV{HOME}/.netrc";

## Process the command line
my %opt = ( man => 0, help => 0, history => 0 );
GetOptions( \%opt, "man", "help", "history" ) or pod2usage(0);
$opt{man} and pod2usage( -exitval => 0, -verbose => 2 );
$opt{help} and pod2usage(0);

## Get our data, either from cache or directly from the website
my $data = undef;
if ( -e $cache and -s _ and ( time() - ( stat(_) )[9] ) < 60 * 90 ) {
    $data = retrieve $cache;
}
else {

    my ( $user, $pass ) = get_account_details();

    ## Ready the browser
    my $ua = WWW::Mechanize->new( autocheck => 1, keep_alive => 32 );

    ## Current Status
    $ua->post( $uri, { username => $user, password => $pass, iso => 1 } );
    @{$data}{qw( usage quota rollover excess )} = $ua->content
        =~ m{ \A ( -? \d+ (?:\.\d+)? ) \s+ (\d+) \s+ (\d{8}) \s+ ( \d+ (?:\.\d+)? ) \Z }x
        or die "$0: can't parse: ", $ua->content, "\n";

    ## Convert rollover to epoch, using midnight Adelaide local time, GMT+0930
    ## Refer FAQ: http://www.internode.on.net/adsl/faq/using-internode-adsl.htm
    my ( $year, $month, $day )
        = $data->{rollover} =~ m{ \A (\d{4}) (\d{2}) (\d{2}) \Z }x
        or die "$0: can't parse rollover date: ", $ua->content, "\n";
    $data->{rollover} = timegm( 0, 30, 14, $day - 1, $month - 1, $year );

    ## Speed value - converting to SI units
    $ua->post( $uri, { username => $user, password => $pass, speed => 1 } );
    ( $data->{speed} ) = $ua->content =~ / \A (.+) \Z /x
        or die "$0: can't parse: $ua->content\n";
    $data->{speed} =~ s{ MBits/sec }{Mb/s}ix;

    ## Historical daily totals
    $ua->post( $uri, { username => $user, password => $pass, history => 1, iso => 1 } );
    foreach ( split /\n/, $ua->content ) {
        my ( $year, $month, $day, $traffic )
            = m{ \A (\d{2,4}) (\d{2}) (\d{2}) \s+ ( -? \d+ (?:\.\d+)? ) \Z }x
            or die "$0: can't parse: x", $_, "x\n";

        ## Do we have a *TWO* digit year?
        if ( $year < 100 ) {
            $year = $year < 70 ? "20$year" : "19$year";
        }

        ## Store using ISO8601 format
        $data->{history}{ "$year-$month-$day" } = $traffic;
    }

    ## Write the cache
    store $data, $cache;
}

## Optional: Display the historical summary
$opt{history} and do {
    foreach my $day ( sort keys %{ $data->{history} } ) {
        printf "%s %7.2f\n", $day, $data->{history}{$day};
    }
};

## Display a simple one-line summary
my $days_left = ( $data->{rollover} - time() ) / ( 60 * 60 * 24 );
printf "Used %.2f MB of %d MB (%.1f%%) with %.1f days left (%.1f%%) at %s.\n",
    $data->{usage},
    $data->{quota},
    100 * $data->{usage} / $data->{quota},
    $days_left,
    100 * $days_left / days_in_billing_month( $data->{rollover} ),
    $data->{speed};

## Estimate of number of days in the current billing month
sub days_in_billing_month {
    my ($rollover_time) = @_;

    ## Day of the month (1..31) for given epoch time
    sub mday {
        return ( gmtime( $_[0] ) )[3];
    }

    ## Find the last day of the month before the rollover month
    my $time = $rollover_time;
    while ( mday($time) <= mday($rollover_time) ) {
        $time -= 86400;
    }

    return mday($time);
}

## Get the username and password from .fetchmailrc (and .netrc if needed).
sub get_account_details {

    my ($user, $pass);

    ## Do we have a .fetchmailrc ?
    if ( -e $fetchmailrc ) {

        ## Get our stanza from the .fetchmailrc
        my ($stanza)
            = slurp($fetchmailrc)
            =~ m{ ( poll \s+ \S+ internode \S+ \s+ .+? (?: poll \s+ | \Z ) ) }imsx
            or die "$0: Didn't find Internode in your .fetchmailrc.\n";

        ## Get the username
        ($user) = $stanza =~ m{ user \s+ "? ( .+? ) "? (?: \s | $ ) }imsx;
        if ( not defined $user ) {
            exists $ENV{USER}    and $user = $ENV{USER};
            exists $ENV{LOGNAME} and $user = $ENV{LOGNAME};
            defined $user or die "$0: couldn't find username\n";
        }

        ## Get the password
        ($pass)
            = $stanza
            =~ m{ (?<! auth \s ) password \s+ "? ( .+? ) "? (?: \s | $ ) }imsx;

    }
    else {

        ## Get the credentials interactively
        print "You don't seem to have a .fetchmailrc, so I'll prompt you.\n";
        print "To avoid extra dependancies, your password will be echoed.\n";
        print "Username: ";
        chomp( $user = <STDIN> );
        print "Password: ";
        chomp( $pass = <STDIN> );
        print "Run this command to create a suitable ~/.fetchmailrc file:\n\n\t";
        printf "echo '# poll mail.internode.on.net user \"%s\" password \"%s\"' >> ~/.fetchmailrc\n",
            $user, $pass;
        print "\n";

    }

    ## Username needs domain part
    if ( $user !~ m{ .+? \@ internode \. on \. net  }ix ) {
        $user .= '@internode.on.net';
    }

    ## Do we need .netrc for the password ?
    if ( not defined $pass ) {
        my ($stanza)
            = slurp($netrc)
            =~ m{ ( machine \s+ \S+ internode \S+ \s+ .+? (?: machine \s+ | \Z ) ) }imsx
            or die "$0: Didn't find Internode in your .netrc.\n";
        ($pass) = $stanza =~ m{ password \s+ "? ( .+? ) (?: " | \s ) }imsx
            or die "$0: Didn't find password in your .netrc.\n";
    }

    return ( $user, $pass );
}

## Slurp without needing an extra module
sub slurp {
    my ($file) = @_;

    my $fh = IO::File->new($file)
        or die "$0: open of $file failed: $OS_ERROR\n";

    return join q{}, $fh->getlines()
        or die "$0: open of $file failed: $OS_ERROR\n";
}

__END__

=head1 NAME

internode-quota-check - Usage information for your Internode account

=head1 SYNOPSIS

internode-quota-check

=head1 OPTIONS

=over 8

=item B<--history>

Include a day-by-day historical summary.

=item B<--man>

Print the manual page and exit.

=item B<--help>

Print a brief help message and exit.

=back

=head1 DESCRIPTION

B<This program> retrieves usage information for your Internode PADSL
account using a text interface Internode provide, for example,

    $ internode-quota-check 
    Used 3965.47 MB (12.4%) of 32000 MB with 16.1 days left at 1.5 Mbits/sec.

=head1 FILES

=over 8

=item B<$ENV{HOME}/.fetchmailrc> and/or B<$ENV{HOME}/.netrc>

Where this program gets your username and password.  This program
does nothing else with these files, nor email or ftp for that matter.

If you are using fetchmail for your Internode email, it should work.

This program understands implicit usernames and using your .netrc file
if the details aren't all in the .fetchmailrc.

If you are B<not> using fetchmail for your Internode email, then
put a comment into this file, creating it if needed:

    # poll mail.internode.on.net user "example" password "secret"

=item B<$ENV{HOME}/.internode-quota-check.cache>

Where this program stores it's cache.  If this file is older than
90 minutes, or missing, this program fetches fresh data from
Internode and updates this file.

=back

=head1 EXIT CODES

If this program exits with a zero exit status and the correct
output is on standard output.  Nothing else is ever printed to
standard output.

This program will exit with a non-zero exit status if there
was a fatal error.  Both fatal and non-fatal errors will cause
output on standard error.

=head1 THANKS

Thanks to Mark Newton at Internode who created the simple interface
to the billing system.

=head1 SEE ALSO

L<http://www.internode.on.net/tools/usage-meters/>

=head1 COPYRIGHT

internode-quota-check - Usage information for your Internode account
Copyright (C) 2007 Mark Suter E<lt>F<suter@humbug.org.au>E<gt>

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 3 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.

You should have received a copy of the GNU General Public License
along with this program.  If not, see L<http://www.gnu.org/licenses/>.

=cut