The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use v5.10.0;
use strict;
use warnings;
use WebService::HabitRPG;
use Config::Tiny;
use Data::Dumper;
use File::Spec;
use IO::Handle;
use POSIX qw(strftime);
use utf8::all;

# Idonethis detection code.
my $IDT_VERSION = 0;

eval {
    require WebService::Idonethis; 
    $IDT_VERSION = WebService::Idonethis->VERSION;
};

# PODNAME: hrpg

# ABSTRACT: hrpg - Command line interface to HabitRPG

our $VERSION = '0.14'; # VERSION


if (not @ARGV) {
    say q{
    Usage:

    hrpg status                   : Show current HP/XP/GP
    hrpg tasks                    : Show current tasks
    hrpg habit|daily|reward|todo  : Show tasks of current type
    hrpg new                      : Create new task 'hrpg new' for help.
    hrpg [+-][num] task [comment] : Increment/decrement a task or habit
    hrpg history task             : Show the history of a task
    hrpg show task                : Show detailed info about a task
    hrpg clear daily              : Uncheck all daily tasks

    Debugging commands:
    
    hrpg dump                     : Dump entire user info
    hrpg dump tasks               : Dump task info

    For more documentation, use `perldoc hrpg`.
    };

    exit 1;
}

# $progname is just a nicer-formatted version of $0 (our command name)

my $PROGNAME = (File::Spec->splitpath($0))[2];
$PROGNAME ||= 'hrpg';

# TODO: Support XDG?
my $config_file = "$ENV{HOME}/.habitrpgrc";

my $config = Config::Tiny->read( $config_file );

unless ($config->{auth}{api_token}) {
    die "Cannot find user credentials in $config_file\n";
}

my @bonus_constructor_args;

if ($ENV{HRPG_API_BASE}) {
    @bonus_constructor_args = ( api_base => $ENV{HRPG_API_BASE} );
}

# Options handling.
# We could use Getopt::Long, but it gets confused by + and -
# being commands.

if ($ARGV[0] eq "--beta") { 
    shift @ARGV;
    @bonus_constructor_args = ( api_base => 'https://beta.habitrpg.com/api/v1' );

    # If we see auth details for beta, add those to our bonus options.

    if ($config->{'auth-beta'}) {
        push(@bonus_constructor_args,
            api_token => $config->{'auth-beta'}{api_token},
            user_id   => $config->{'auth-beta'}{user_id},
        );
    }
}
elsif ($ARGV[0] eq "--dev") {
    shift @ARGV;
    @bonus_constructor_args = ( api_base => 'http://localhost:3000/api/v1' );

    # If we see auth details for beta, add those to our bonus options.

    if ($config->{'auth-dev'}) {
        push(@bonus_constructor_args,
            api_token => $config->{'auth-dev'}{api_token},
            user_id   => $config->{'auth-dev'}{user_id},
        );
    }
}

my $hrpg = WebService::HabitRPG->new(
    api_token => $config->{auth}{api_token},
    user_id   => $config->{auth}{user_id},
    @bonus_constructor_args,
);

my $cmd = shift @ARGV;

given ($cmd) {
    when ('dump')   { 

        my ($option) = @ARGV;

        if (not $option) {
            say Dumper $hrpg->user; 
        }
        elsif ($option eq 'tasks') {
            say Dumper $hrpg->tasks;
        }
        else {
            say "Did you mean `$PROGNAME dump tasks`?";
            exit 1;
        }
    }

    when ('status') {
        my $user = $hrpg->user;

        my $name =  $user->{profile}{name}
                 || $user->{auth}{facebook}{displayName}
                 || $user->{auth}{local}{username}
                 || 'adventurer';

        say "\nHark, $name! (Lv $user->{stats}{lvl})\n";

        say "HP: $user->{stats}{hp} / $user->{stats}{maxHealth}";
        say "XP: $user->{stats}{exp} / $user->{stats}{toNextLevel}";

        # Pretty-printing of money
        my $raw_gp = sprintf("%.4f", $user->{stats}{gp});
        ($raw_gp =~ /^(?<gp>\d+)\.(?<sp>\d{2})(?<cp>\d{2})$/);

        printf "GP: %d | SP: %2d | CP: %2d\n\n",$+{gp}, $+{sp}, $+{cp};
    }

    when (/^(?<type>habit|todo|daily|reward)$/) {
        my $tasks = $hrpg->tasks($+{type});

        foreach my $task (@$tasks) {
            next if $task->{type} eq 'todo' and $task->{completed};
            say format_task($task);
        }
    }

    when ('tasks') {
        my $tasks = $hrpg->tasks();

        my $last_type = "";

        foreach my $task (@$tasks) {
            next if $task->{type} eq 'reward';
            next if $task->{type} eq 'todo' and $task->{completed};

            if ($task->{type} ne $last_type) {
                say "\n === \u$task->{type} ===\n";
            }
            say format_task($task);
            $last_type = $task->{type};
        }
    }

    when ('show') {

        # TODO: Integrate history/show search routines.

        my ($task_name) = @ARGV;

        if (not $task_name) {
            die "Usage: $PROGNAME show taskname\n";
        }

        my @tasks = $hrpg->search_tasks($task_name, all => 1);

        if (not @tasks) {
            die "Sorry, no tasks found!\n";
        }

        foreach my $task (@tasks) {
            say Dumper $task;
        }
    }
        
    
    when ('history') {
        my ($task_name) = @ARGV;

        if (not $task_name) {
            die "Usage: $PROGNAME history taskname\n";
        }

        my @tasks = $hrpg->search_tasks($task_name, all => 1);

        if (not @tasks) {
            die "Sorry, no tasks found!\n";
        }

        foreach my $task (@tasks) {
            say "\n = ", $task->{text}, " =\n";

            foreach my $hist ( @{ $task->{history} }) {

                # Substr is to work around lefnire/habitrpg#716
                # This will break in a few thousand years time.
                my $timestamp = substr($hist->{date},0,10);

                print strftime("[%Y-%m-%d %H:%M]", localtime($timestamp));
                printf("\t%6.2f\n", $hist->{value});
            }
        }
    }

    when (/^(?<dir>[+-])(?<qty>\d*)$/) {
        my ($task_name, @comment) = @ARGV;

        my $direction = $+{dir} eq '+' ? 'up' : 'down';
        my $qty       = $+{qty} || 1;

        die "Usage: $PROGNAME $direction\[num] task [comment]\n"
            if not $task_name;

        my @candidates = $hrpg->search_tasks($task_name);

        if (@candidates == 1) {
            my $task = $candidates[0];
            say "Updating $task->{text} (x$qty) ($task->{id})\n";

            # TODO: We really need an object model behind
            # this, so we're not digging out hash keys.

            my $stats = $hrpg->user->{stats};
            
            my $result;

            foreach (1..$qty) {
                $result = $hrpg->updown($task->{id}, $direction);
            }

            # Display new stats.

            printf "HP: %d/%d (%+.2f)\n", $result->{hp}, $stats->{maxHealth},  $result->{hp}  - $stats->{hp}; 
            printf "XP: %d/%d (%+.2f)\n", $result->{exp},$stats->{toNextLevel},$result->{exp} - $stats->{exp};
            printf "GP: %.2f (%+.2f)\n",  $result->{gp} ,                      $result->{gp}  - $stats->{gp};

            if (@comment) {
                if ($IDT_VERSION) {
                    system('idone',@comment);
                }
                else {
                    say "Comment ignored, WebService::Idonethis not installed.";
                }
            }
        }
        elsif (@candidates == 0) {
            say "No task matching '$task_name' found";
        }
        else {
            say "Did you mean...";

            foreach my $task (@candidates) {
                say "* $task->{text} ($task->{id})";
            }
        }
    }

    when ('new') {
        my ($type, $direction, $text, $note, $value, @rest) = @ARGV;
        my ($up, $down) = (0, 0);

        # TODO: Support rewards (which have 'value')

        my $usage_text = qq{Usage: $PROGNAME new [habit|todo|daily] +- "name" ["note"] [value]\n};

        unless ($type and $direction and $text  ) { die $usage_text; }
        if     ($type !~ /^(?:habit|todo|daily)/) { die $usage_text; }
        if     ($direction !~ /^[+-]+$/         ) { die $usage_text; }

        if ($direction =~ /\+/) { $up   = 1; }
        if ($direction =~ /\-/) { $down = 1; }

        $note //= "";

        my $result = $hrpg->new_task(
            type => $type,
            text => $text,
            note => $note,
            up   => $up,
            down => $down,
            extend => { @rest },
        );

        say Dumper $result;
    }

    when ('clear') {
        my (@args) = @ARGV;

        if ($args[0] ne 'daily') {
            die "Only '$PROGNAME clear daily' is supported.\n";
        }

        my $dailies = $hrpg->tasks("daily");

        foreach my $task (@$dailies) {
            if ($task->{completed}) {
                say "Clearing $task->{text}...";

                # \0 converts into magic JSON false
                $hrpg->_update($task->{id}, { completed => \0 });
            }
        }

        say "All daily tasks cleared!\n";
    }

    when ('↑↑↓↓←→←→BA') {
        print "\nAuto-leveller enabled. Please wait.";
        STDOUT->flush;

        my $start_level = $hrpg->user->{stats}{lvl}
            or die "Cannot determine player level";

        my $leveller = $hrpg->new_task(
            type => 'habit',
            text => '',
            up   => 1,
        );

        my $id = $leveller->{id};

        while ($hrpg->user->{stats}{lvl} <= $start_level) {
            print ".";
            STDOUT->flush;
            $hrpg->up($id);
            print ".";
            STDOUT->flush;
            $hrpg->_update($id, { value => 0 });
            print ".";
            STDOUT->flush;
        }

        print "DING!\n";

        # Oh dear, I guess we need a way to delete that task now.

    }
    
    # EXPERIMENTAL
    when ('_update') {
        my ($task, @args) = @ARGV;

        my @candidates = $hrpg->search_tasks($task);

        if (@candidates != 1) {
            die "Found ".@candidates." matche(s). There can be only one.\n";
        }

        say Dumper $hrpg->_update($candidates[0]{id}, { @args } );
    }

    default {
        say "\nSorry, I didn't understand what you were asking for!";
        say "Try $PROGNAME with no arguments for help.\n";
        exit 1;
    }
}

# TODO: Move these to the API module? Maybe?

# Formats todo/daily tasks with checkmarks. Everything else gets bullets.

sub format_task {
    my ($task) = @_;

    my $formatted = "";

    if ($task->{type} =~ /^(?:daily|todo)$/) {
        if ($task->{completed}) {
            $formatted .= '[X] ';
        }
        else {
            $formatted .= '[ ] ';
        }
    }
    elsif ($task->{type} eq 'habit') {
        $formatted .= ' ';
        $formatted .= $task->{up}   ? "+"  : " "  ;
        $formatted .= $task->{down} ? "- " : "  " ;
    }
    else {
        $formatted .= "  * ";
    }

    $formatted .= $task->{text};

    return $formatted;
}

__END__

=pod

=head1 NAME

hrpg - hrpg - Command line interface to HabitRPG

=head1 VERSION

version 0.14

=head1 SYNOPSIS

Usage:

    hrpg status                  : Show current HP/XP/GP
    hrpg tasks                   : Show current tasks
    hrpg habit|daily|reward|todo : Show tasks of current type
    hrpg new                     : Create new task 'hrpg new' for help.
    hrpg [+-][num] task          : Increment/decrement a task or habit
    hrpg history task            : Show the history of a task
    hrpg show task               : Show detailed info about a task

    Debugging commands:
    
    hrpg dump                    : Dump entire user info
    hrpg dump tasks              : Dump task info

=head1 DESCRIPTION

This is a command-line client for the L<HabitRPG|http://habitrpg.com/>
service.  Use C<hrpg> with no arguments for help.

When using the C<+> and C<-> commands, any unique shortening of a
task name can be used. When using C<history> and C<show>, all
tasks matching the name specified will be displayed.

The C<--beta> switch may be provided as a first argument to use
the beta API server.  The C<--dev> switch may be used to use
C<http://localhost:3000/api/v1> as the server.

=head1 SETUP

=head2 Installation

If you have not already installed this software, the easiest way
is to use L<cpanm> and L<local::lib>. If you don't have them installed,
it's easy with:

    curl -L http://cpanmin.us/ | perl - --self-upgrade
    ~/perl5/bin/cpanm -L ~/perl5 App::local::lib::helper
    source ~/perl5/bin/localenv-bashrc

You might want to put that last line in your F<~/.bashrc> file.

You can then install C<hrpg> and related utilities with:

    cpanm hrpg

=head2 Configuration

Create a F<.habitrpgrc> file in your home directory. Place in it
the following lines:

    [auth]
    user_id   = xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx
    api_token = xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx

Replace the long strings of 'x's with the values you obtain by
going to I<Settings -> API> in the HabitRPG web interface.

You may also have an C<[auth-dev]> and/or C<[auth-beta]> section,
if you use a development or beta server and have different credentials
there.  Most users will never need this.

=head1 EXPERIMENTAL FEATURES

These features are considered experimental, and may change in
the future.

=head2 INTEGRATION WITH IDONETHIS

If you have L<WebService::Idonethis> installed, then you can add
items to your done-list at the same time as you complete habits.
This is done by adding an extra argument to the C<+> or C<->
calls to hrpg:

    hrpg + bugfix   "Recalibrated the flux capacitor."
    hrpg - junkfood "Won the local doughnut eating competition."

This integration is extraordinarily simple for now. We simply
call out to the L<idone> command-line tool with all additional
arugments given. If you're an C<idone> power user, this means
you can use switches like C<-l>.

If L<WebService::Idonethis> is not installed, any additional arguments
to habit reporting are ignored.

=head2 CUSTOM ATTRIBUTES

Additional arguments after the I<value> to C<hrpg new> are considered
to be custom arguments that are sent to the API.  These must be
key/value pairs, which are encoded into JSON and passed directly
as-is, without any sanity checking. These can allow tasks to be
created that may hook into new features on the server, or which contain
additional information which is not used by the main HabitRPG servers.

=head1 ENVIRONMENT

If the C<HRPG_API_BASE> environment variable is set, it will be used as
the API base URL. This may be useful in testing, or when working with
other servers.

=head1 BUGS

I'm sure there are plenty! Please view and/or record them at
L<https://github.com/pjf/WebService-HabitRPG/issues> .

=head1 SEE ALSO

L<WebService::HabitRPG>

=head1 AUTHOR

Paul Fenwick <pjf@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Paul Fenwick.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut