File Coverage

blib/lib/WebService/HabitRPG/Task.pm

Criterion	Covered	Total	%
statement	60	66	90.9
branch	11	22	50.0
condition			n/a
subroutine	16	16	100.0
pod	2	3	66.6
total	89	107	83.1

package WebService::HabitRPG::Task;
use v5.010;
use strict;
use warnings;
use autodie;
use JSON::MaybeXS qw(is_bool);
use Moo;
use Scalar::Util qw(looks_like_number);
use POSIX qw(strftime);
use Carp qw(croak);
use Data::Dumper;
use DateTime;
use DateTime::Format::ISO8601;

use constant HRPG_REPEAT_MAP => qw(
    m t w th f s su
);

# TODO: croak provides poor error messages in here, possibly due to
# it not knowing about Moo properly. Still, they're good enough for
# getting stack backtraces when needed.

# ABSTRACT: A HabitRPG task

our $VERSION = '0.30'; # VERSION: Generated by DZP::OurPkg:Version


# Validation functions

my $Bool = sub {
    my ( $value ) = @_;
    $value = 0 + $value if is_bool($value);
    croak "$value must be 0|1" unless $value =~ /^[01]$/;
};

my $Num = sub {
    croak "$_[0] isn't a number" unless looks_like_number $_[0];
};

my $Type = sub {
    croak "$_[0] is not habit|todo|daily|reward"
        unless $_[0] =~ /^(?:habit|todo|daily|reward)$/;
};

my $NonEmpty = sub {
    croak "Empty or undef parameter" unless length($_[0] // "");
};

has 'text'      => ( is => 'ro', required => 1, isa => $NonEmpty);
has 'id'        => ( is => 'ro', required => 1, isa => $NonEmpty);
has 'up'        => ( is => 'ro', default  => sub { 0 }, isa => $Bool);
has 'down'      => ( is => 'ro', default  => sub { 0 }, isa => $Bool);
has 'value'     => ( is => 'ro', required => 1, isa => $Num);
has 'type'      => ( is => 'ro', required => 1, isa => $Type);
has 'history'   => ( is => 'ro' );  # TODO: Objectify
has 'repeat'    => ( is => 'ro' );  # TODO: Objectify
has 'completed' => ( is => 'ro' );
has 'tags'      => ( is => 'ro' );  # Hashref to uuid => True pairs.
has 'streak'    => ( is => 'ro' );
has '_raw'      => ( is => 'rw' );

# Debugging hooks in case things go weird.

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;

    if ($WebService::HabitRPG::DEBUG) {
        warn "Building task with:\n";
        warn Dumper(\@_), "\n";
    }

    return $class->$orig(@_);
};

sub BUILD {
    my ($self, $args) = @_;

    # Since we're usually being called directly with the results of
    # a JSON parse, we want to record that original structure here.

    $self->_raw($args);
}


sub active_today {
    my ($self) = @_;

    return 1 if $self->type ne 'daily';

    my $frequency = $self->_raw->{frequency};

    if ($frequency eq 'weekly') {
        return unless $self->repeat;

        my $today_short = (HRPG_REPEAT_MAP)[ DateTime->now->set_time_zone('local')->day_of_week - 1 ];
        return $self->repeat->{$today_short};
    }
    elsif ($frequency eq 'daily') {
        my $every_x = $self->_raw->{everyX};
        return unless $every_x;

        my $start_date       = DateTime::Format::ISO8601->new->parse_datetime($self->_raw->{startDate})->truncate(to => 'day');
        my $days_since_start = DateTime->today->delta_days($start_date)->in_units('days');

        return $days_since_start % $every_x == 0;
    }
    else {
        return;
    }
}


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

    my $formatted = "";

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

    $formatted .= $task->text;

    return $formatted;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

WebService::HabitRPG::Task - A HabitRPG task

=head1 VERSION

version 0.30

=head1 SYNOPSIS

    my $task = WebService::HabitRRG::Task->new(
        text  => 'Floss teeth',
        id    => 'a670fc50-4e04-4b0f-9583-e4ee55fced02',
        up    => 1,
        down  => 0,
        value => 0,
        type  => 'habit',
        tags  => { work_uuid => 1, home_uuid => 0 },
    );

    say "Task name: ", $task->text;

=head1 DESCRIPTION

Represents a HabitRPG task object. All properties shown in the
synopsis are checked for sanity and are available as methods.

The C<history>, C<completed> and C<repeat> attributes may also
be provided at build-time, but are optional. No checking is done
on them (yet).

=head1 METHODS

=head2 active_today()

    if ( $task->active_today ) { # This task is active today! }

Returns a true value if this task is due today. To check if it's
already completed, check C< $task->completed >.

=head2 format_task()

    say $task->format_task;

Generated a formatted form of the task, including check-boxes for
C<todo> and C<daily> tasks, and C<+> and C<-> signs for habits.

=for Pod::Coverage BUILDARGS BUILD text id up down value type history completed repeat tags streak

=head1 AUTHOR

Paul Fenwick <[e-mail]>

=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