#!/usr/bin/perl
# Copyright (C) 2004,2006,2007,2008,2009 Mark Suter <suter@humbug.org.au>
# See below for the full GPL v3 notice and other details (within the POD)
# $Id: internode-quota-check,v 1.4 2010/06/24 09:24:25 suter Exp suter $
#
# If you wish to create your own usage meter interface, do not copy
# the interface from this program, please contact Internode via
# http://www.internode.on.net/contact/support/ for the API document

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

Readonly my $SELF_DOWNLOAD => 'http://zwitterion.org/software/internode-quota-check/internode-quota-check';
Readonly my $INTERNODE_API => 'https://customer-webtools-api.internode.on.net/api/v1.5/';
Readonly my $CACHE         => "$ENV{HOME}/.internode-quota-check.cache";
Readonly my $NETRC         => "$ENV{HOME}/.netrc";
Readonly my $FETCHMAILRC => exists $ENV{FETCHMAILHOME} ? "$ENV{FETCHMAILHOME}/fetchmailrc" : "$ENV{HOME}/.fetchmailrc";

Readonly my $QUOTA_CACHE_TIME         => 1 * 3600;
Readonly my $VERSION_CHECK_TIME       => 24 * 3600;
Readonly my $LWP_KEEP_ALIVE           => 32;
Readonly my $LWP_TIMEOUT              => 180;
Readonly my $SECONDS_IN_A_DAY         => 86_400;
Readonly my @ROLLOVER_TIME_OF_DAY     => qw( 0 15 14 );
Readonly my @PERSONAL_UNITS           => ( '%6.3f', 'GB', 1e9 );
Readonly my @MOBILE_UNITS             => ( '%6.0f', 'MB', 1e6 );
Readonly my $ROLLOVER_MAX_DAYS        => 45;
Readonly my $ROLLOVER_ASSUMED_DEFAULT => 30;

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

## Process the command line
my %opt = ( man => 0, help => 0 );
GetOptions( \%opt, 'man', 'help' ) 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_details = get_accounts();

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

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

    ## Refresh the data ?
    if (   not defined $data->{$user}
        or not defined $data->{latest}{version}
        or $data->{$user}{time} < time - $QUOTA_CACHE_TIME
        or $data->{latest}{version} ne $VERSION )
    {

        ## Ready the browser
        my $mech = WWW::Mechanize->new( autocheck => 1, keep_alive => $LWP_KEEP_ALIVE, timeout => $LWP_TIMEOUT );
        $mech->agent( "internode-quota-check/$VERSION " . $mech->agent );
        $mech->credentials( $user, $pass );

        ## Current Usage and Service detail as XML
        ( $data->{$user}{type}, my $id )
            = $mech->get($INTERNODE_API)->content()
            =~ m{ <service .+? ( Personal | NodeMobile ) .+?>(\d+)</service> }imsx;
        my $service = $mech->get( $INTERNODE_API . "$id/service" )->content();
        my $usage   = $mech->get( $INTERNODE_API . "$id/usage" )->content();

        ## Speed - simple XML "parsing" to avoid an external module
        if ( $data->{$user}{type} eq 'NodeMobile' ) {
            $data->{$user}{speed} = '3G';
        }
        else {
            ( $data->{$user}{speed} ) = $service =~ m{
                <speed>(.+?)</speed> .*?
            }imsx or die "$PROGRAM_NAME: can't parse output: ", $service, $usage, "\n";

            ## Converting to SI units
            $data->{$user}{speed} =~ s{ MBits/sec }{Mb/s}imsx;
        }

        ## Usage - simple parsing once more
        @{ $data->{$user} }{qw( rollover quota usage )} = ( $service . $usage ) =~ m{ 
                <traffic \s+ name="total" \s+ rollover="(.+?)" .+? quota="(\d+)" \s+ unit="bytes">(\d+)</traffic>
            }imsx or die "$PROGRAM_NAME: can't parse output: ", $service, $usage, "\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 }imsx
            or die "$PROGRAM_NAME: can't parse rollover date: ", $mech->content;
        $data->{$user}{rollover} = timegm( @ROLLOVER_TIME_OF_DAY, $day, $month - 1, $year ) - $SECONDS_IN_A_DAY;

        ## Sanity check on rollover day
        if ( abs( $data->{$user}{rollover} - time ) > $SECONDS_IN_A_DAY * $ROLLOVER_MAX_DAYS ) {
            warn "$PROGRAM_NAME: weird rollover ($year-$month-$day), using 30 days from now.\n";
            $data->{$user}{rollover} = time() + $SECONDS_IN_A_DAY * $ROLLOVER_ASSUMED_DEFAULT;
        }

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

        ## Check for a new version of this script (Internode feature request)
        if ( not defined $data->{latest} or $data->{latest}{time} < time - $VERSION_CHECK_TIME ) {
            $mech->get($SELF_DOWNLOAD);
            ( $data->{latest}{version} ) = $mech->content =~ m{ \$Revision: \s+ (\S+) }msx;
            $data->{latest}{time} = time;
        }
        if ( $VERSION < $data->{latest}{version} ) {
            warn "Newer version ($data->{latest}{version}) is at $SELF_DOWNLOAD\n";
        }

        ## Write the cache
        nstore $data, $CACHE;
    }

    ## Display a one-line summary
    my $days_left = ( $data->{$user}{rollover} - time ) / $SECONDS_IN_A_DAY;
    my ( $spec, $label, $divisor ) = $data->{$user}{type} eq 'NodeMobile' ? @MOBILE_UNITS : @PERSONAL_UNITS;
    printf "%s: $spec %s (%4.1f%%) and %4.1f days (%4.1f%%) left on %d %s, %s plan.\n",
        ( sprintf "%${username_width}s", $user ),
        ( $data->{$user}{quota} - $data->{$user}{usage} ) / $divisor,
        $label,
        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} / $divisor, $label, $data->{$user}{speed},
        or die "$PROGRAM_NAME: print: $OS_ERROR\n";

}

## 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 ( monthnum($time) == monthnum($rollover_time) ) {
        $time -= $SECONDS_IN_A_DAY;
    }

    # Return the number of days ($time is now in the previous month)
    return mday($time);
}

## Month number (1..12) for given epoch time
sub monthnum {
    my ($time) = @_;
    return ( gmtime $time )[4];    ## no critic "ProhibitMagicNumbers"
}

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

## Get the accounts' 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 "$PROGRAM_NAME: Didn't find Internode in your ~/.fetchmailrc.\n";

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

            ## Get the username
            my ($user) = $stanza =~ m{ user (?:name)? \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 "$PROGRAM_NAME: 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 "$PROGRAM_NAME: Didn't find Internode in your ~/.netrc.\n";
                ($pass) = $netrc_stanza =~ m{ password \s+ "? ( .+? ) (?: " | \s ) }imsx
                    or die "$PROGRAM_NAME: 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 "$PROGRAM_NAME: print: $OS_ERROR\n";
        chomp( my $user = <STDIN> );    ## no critic "ExplicitStdin"
        print 'Password: ' or die "$PROGRAM_NAME: 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 "$PROGRAM_NAME: 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 "$PROGRAM_NAME: open of $file failed: $OS_ERROR\n";

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

__END__

=for stopwords internode usernames fetchmail FETCHMAILHOME fetchmailrc Mickan

=head1 NAME

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

=head1 USAGE

internode-quota-check

=head1 OPTIONS

=over 8

=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
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 the fetchmail man page for more details.

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

Where this program stores it's cache.  If the data is older than
one (1) hour, 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.

Thanks to Jan Marecek for tweaks to the parsing of the
fetchmailrc file.

Thanks to to Mark Mickan for a much more elegant way to calculate
the days in the billing month.

Thanks to Chris Giles for the suggestions on improving the cache
handling between versions.

=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 accounts
Copyright (C) 2004,2006,2007,2008,2009 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