#!/usr/bin/perl
# Copyright (C) 2004,2006,2007 Mark Suter <suter@humbug.org.au>
# $Id: internode-quota-check,v 1.34 2008/08/18 12:09:24 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 $netrc = "$ENV{HOME}/.netrc";
my $fetchmailrc
    = exists $ENV{FETCHMAILHOME} ? "$ENV{FETCHMAILHOME}/fetchmailrc" : "$ENV{HOME}/.fetchmailrc";

our ($VERSION) = '$Revision: 1.34 $' =~ m{ \$Revision: \s+ (\S+) }msx; ## no critic "InterpolationOfMetachars"

## 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 from cache
my $data = undef;
if ( -e $cache ) {
    $data = retrieve $cache;
}

## Get the accounts' details
my @accounts = get_accounts();

## Space to allow for username display
my $username_width = ( sort map { length $_->[0] } @accounts )[0];

## Do each account separately
foreach (@accounts) {
    my ( $user, $pass ) = @{$_};

    ## Refresh the data ?
    if ( not defined $data->{$user} or $data->{$user}{time} < time - 5400 ) {

        ## 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->{$user} }{qw( usage quota rollover excess )}
            = $ua->content
            =~ m{ \A ( -? \d+ (?:\.\d+)? ) \s+ (\d+) \s+ (\d{8}) \s+ ( \d+ (?:\.\d+)? ) \Z }msx
            or die "$0: can't parse: ", $ua->content, "\n";

        ## Rollover day is approx 23:45 on the returned date, Adelaide local (GMT+0930)
        ## http://www.internode.on.net/support/faq/broadband_adsl/using_internode_adsl/
        my ( $year, $month, $day )
            = $data->{$user}{rollover} =~ m{ \A (\d{4}) (\d{2}) (\d{2}) \Z }msx
            or die "$0: can't parse rollover date: ", $ua->content, "\n";
        $data->{$user}{rollover} = timegm( 0, 15, 14, $day, $month - 1, $year ) - 86_400;

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

        ## Historical daily totals, where available
        $ua->post( $uri, { username => $user, password => $pass, history => 1, iso => 1 } );
        if ( $ua->content !~ m{ No \s Usage \s History }msix ) {
            foreach ( split m{\n}msx, $ua->content ) {
                my ( $year, $month, $day, $traffic )
                    = m{ \A (\d{2,4}) (\d{2}) (\d{2}) \s+ ( -? \d+ (?:\.\d+)? ) \Z }msx
                    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->{$user}{history}{"$year-$month-$day"} = $traffic;
            }
        }

        ## Store the freshness of this data
        $data->{$user}{time} = time;

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

    }

    ## Optional: Display the historical summary
    if ( $opt{history} ) {
        foreach my $day ( sort keys %{ $data->{$user}{history} } ) {
            printf "%s %7.2f\n", $day, $data->{$user}{history}{$day}
                or die "$0: print: $OS_ERROR\n";
        }
    }

    ## Display a one-line summary
    my $days_left = ( $data->{$user}{rollover} - time ) / ( 60 * 60 * 24 );
    printf
        "%s: %6.3f GB (%4.1f%%) and %4.1f days (%4.1f%%) left on %d GB, %s plan.\n",
        ( sprintf "%${username_width}s", $user ),
        ( $data->{$user}{quota} - $data->{$user}{usage} ) / 1000,
        100 * ( $data->{$user}{quota} - $data->{$user}{usage} ) / $data->{$user}{quota},
        $days_left,
        100 * $days_left / days_in_billing_month( $data->{$user}{rollover} ),
        $data->{$user}{quota} / 1000, $data->{$user}{speed},
        or die "$0: print: $OS_ERROR\n";

}

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

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

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

    return mday($time);
}

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

    my @accounts = ();

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

        ## Get all the stanzas from the .fetchmailrc
        my @stanzas = slurp($fetchmailrc) =~ m{ \G .*? ( poll \s+ .+? (?= poll \s+ | \Z ) ) }gcimsx
            or die "$0: Didn't find Internode in your .fetchmailrc.\n";

        foreach my $stanza ( grep {/ internode /imsx} @stanzas ) {

            ## Get the username
            my ($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
            my ($pass) = $stanza =~ m{ (?<! auth \s ) password \s+ "? ( .+? ) "? (?: \s | $ ) }imsx;

            ## Do we need .netrc for the password ?
            if ( not defined $pass ) {
                my ($netrc_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) = $netrc_stanza =~ m{ password \s+ "? ( .+? ) (?: " | \s ) }imsx
                    or die "$0: Didn't find password in your .netrc.\n";
            }

            push @accounts, [ $user, $pass ];
        }

    }
    else {

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

        push @accounts, [ $user, $pass ];
    }

    return @accounts;
}

## 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 Internode accounts

=head1 USAGE

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 quota usage information for Internode
ADSL accounts, for example,

    $ internode-quota-check
     mark: 21.583 GB (27.0%) and 5.1 days (16.5%) left of 80 GB, 24 Mb/s plan.
    suter: 35.036 GB (63.7%) and 5.1 days (16.5%) left of 55 GB, 24 Mb/s plan.

=head1 CONFIGURATION

=over 8

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

Where this program gets the usernames and passwords.  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.

If you have multiple accounts defined, then this program will display
the quota usage for each account, one per line.

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"

This program will honour the FETCHMAILHOME environment variable, that
is, read $FETCHMAILHOME/fetchmailrc instead of the normal one on your
home directory.  Refer to L<fetchmail(1)> for more details.

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

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

=back

=head1 EXIT STATUS

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 interface
to the billing system.

Thanks to Trent W. Buck for improvements making the single line
of output more understandable and readily usable.

Thanks to Michael T. Pope for letting me know about the
alternative fetchmailrc location.

=head1 SEE ALSO

L<http://www.internode.on.net/support/tools/usage_meters/>

=head1 AUTHOR

Mark Suter E<lt>F<suter@humbug.org.au>E<gt>

=head1 LICENSE AND 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