#!/usr/bin/perl

use strict;
use warnings;
use feature qw/ say /;
use Data::Dumper; $Data::Dumper::Sortkeys = 1;

use Getopt::Long;
use HTTP::Tiny;
use HTML::TableExtract;
use Time::Piece;
use Number::Format qw/ format_number /;
use List::Util qw/ any /;

my ( $sort_by, $order, $limit, $recent, $only_include, $force_include, $min_posts, $no_adjust );

GetOptions(
    'sort_by|s=s'        => \$sort_by,
    'order|o=s'          => \$order,
    'limit|l=i'          => \$limit,
    'recent|r=i'         => \$recent,
    'only_include|i=s@'  => \$only_include,
    'force_include|f=s@' => \$force_include,
    'min_posts|m=i',     => \$min_posts,
    'no_adjust|n'        => \$no_adjust,
    'help|?'             => \&print_usage,
);

minor_validation();

my $url     = 'http://perlmonks.com/?node_id=3559';
my $headers = ['#', 'User', 'Experience', 'Level', 'Writeups', 'User Since', 'Last Here'];
 
my $data;

fetch_data( $url );
print_data( $data );

exit;

######################################

sub fetch_data {
    my $url  = shift;

    my $page = HTTP::Tiny->new->get( $url );

    die 'Died. No response' if not $page;
    die "Died. $page->{'status'} $page->{'reason'}" if not $page->{'success'};
    
    my $table = HTML::TableExtract->new( 'headers' => $headers );
    $table->parse( $page->{'content'} );
    
    my $now = time();

    foreach my $row ( $table->rows ) {
        process_row( $now, $row );
    }
}

sub process_row {
    my $now = shift;
    my $row = shift;
    
    my ( $rank, $monk, $xp, $level, $posts, $created, $last_here ) = @{ $row };

    return if $last_here =~ /year/ or ( $last_here =~ /(\d+) week/ and $1 > ( $recent || 4 ) );
    return if $sort_by eq 'posts' and $posts eq 'None';
    return if $min_posts and ( $posts eq 'None' or $posts < $min_posts );
    return if $only_include and not any { $_ eq $monk } @{ $only_include };

    $created = Time::Piece->strptime($created, '%Y-%m-%d %R')->epoch;

    my $age         = $now - $created;
    my $age_days    = int( $age / 86400 );
    my $xp_adjusted = $no_adjust ? $xp : $xp - ( $age_days / 2 );
    
    my %record = (
        rank     => $rank,
        xp       => $xp,
        level    => $level,
        posts    => $posts,
        by_posts => $posts eq 'None' ? 0 : ( $xp_adjusted / $posts ),
        age      => $age_days,
        by_age   => ( $xp_adjusted / $age ) * 100000, # for scale
    );

    $data->{ $monk } = \%record;
}

sub print_data {
    my $data = shift;

    $sort_by = 'by_' . $sort_by;

    my %sortable = ( map { $_ => $data->{ $_ }->{ $sort_by } } keys %{ $data } );

    my @results;

    foreach my $monk ( sort { $sortable{$a} <=> $sortable{$b} } keys %sortable ) {

        $data->{ $monk }->{'posts'} =~ s/None/0/;

        push @results, {
            rank     => $data->{ $monk }->{'rank'},
            monk     => $monk,
            xp       => format_number( $data->{ $monk }->{'xp'} ),
            level    => $data->{ $monk }->{'level'},
            age      => format_number( $data->{ $monk }->{'age'} ),
            by_age   => format_number( $data->{ $monk }->{'by_age'}, 4, 1 ),
            posts    => format_number( $data->{ $monk }->{'posts'} ),
            by_posts => format_number( $data->{ $monk }->{'by_posts'}, 4, 1 )
        };
    }

    @results = reverse @results if $order and $order eq 'desc';

    print <<EOT; 
+--------------------------------------------------------------------------------------+
| Pos | St. | Monk name    |  XP  |     Level      |  Age  | XP/Age | Posts | XP/Posts |
+--------------------------------------------------------------------------------------+
EOT

    my $count = 0;
    foreach my $result ( @results ) {
        ++$count;
        if ( $limit and $count > $limit ) {
            last if not defined $force_include;
            next unless any { $_ eq $result->{'monk'} } @{ $force_include };
        }

        format =
@ @### @#### @<<<<<<<<<<<< @>>>>>> @>>>>>>>>>>>>>>> @>>>>>> @>>>>>>> @>>>>>> @>>>>>>>> @
'|', $count, $result->{'rank'}, $result->{'monk'}, $result->{'xp'}, $result->{'level'}, $result->{'age'}, $result->{'by_age'}, $result->{'posts'}, $result->{'by_posts'}, '|'
.

        write;
    }

    print '+--------------------------------------------------------------------------------------+';
}

sub minor_validation {
    print_usage() if (
        ( ! $sort_by or $sort_by !~ /age|posts/ ) or
        ( $order and $order !~ /asc|desc/ )
    );
}

sub print_usage {
    say <<"EOT";

        Usage: perl $0 --sort_by (age|posts)

        Options:
            --sort_by,       -s: Rank monks by XP/posts or by XP/age
            --limit,         -l: Limit results to this many
            --order,         -o: Sort order (asc|desc)
            --recent,        -r: Limit to monks seen in the last n weeks
            --only_include,  -i: Skip all monks except this/these one(s)
            --force_include, -f: Include this/these monk(s) even if -l is set
            --min_posts,     -m: Exclude monks with fewer than this many posts
            --no_adjust,     -n: Don't deduct 0.5 XP for each day of monkhood
            --help,          -h: Print this help
EOT
    exit; 
}

__END__