File Coverage

blib/lib/WebService/HabitRPG/Task.pm
Criterion Covered Total %
statement 57 63 90.4
branch 11 22 50.0
condition n/a
subroutine 15 15 100.0
pod 2 3 66.6
total 85 103 82.5


line stmt bran cond sub pod time code
1             package WebService::HabitRPG::Task;
2 5     5   41601 use v5.010;
  5         17  
3 5     5   26 use strict;
  5         9  
  5         127  
4 5     5   26 use warnings;
  5         9  
  5         132  
5 5     5   1614 use autodie;
  5         38635  
  5         67  
6 5     5   30198 use Moo;
  5         29816  
  5         35  
7 5     5   5034 use Scalar::Util qw(looks_like_number);
  5         10  
  5         281  
8 5     5   4104 use POSIX qw(strftime);
  5         27111  
  5         32  
9 5     5   7121 use Carp qw(croak);
  5         10  
  5         345  
10 5     5   5219 use Data::Dumper;
  5         41925  
  5         323  
11 5     5   7086 use DateTime;
  5         710425  
  5         204  
12 5     5   4796 use DateTime::Format::ISO8601;
  5         233025  
  5         307  
13              
14 5         5900 use constant HRPG_REPEAT_MAP => qw(
15             su m t w th f s
16 5     5   51 );
  5         13  
17              
18             # TODO: croak provides poor error messages in here, possibly due to
19             # it not knowing about Moo properly. Still, they're good enough for
20             # getting stack backtraces when needed.
21              
22             # ABSTRACT: A HabitRPG task
23              
24             our $VERSION = '0.23'; # VERSION: Generated by DZP::OurPkg:Version
25              
26              
27             # Validation functions
28              
29             my $Bool = sub {
30             croak "$_[0] must be 0|1" unless $_[0] =~ /^[01]$/;
31             };
32              
33             my $Num = sub {
34             croak "$_[0] isn't a number" unless looks_like_number $_[0];
35             };
36              
37             my $Type = sub {
38             croak "$_[0] is not habit|todo|daily|reward"
39             unless $_[0] =~ /^(?:habit|todo|daily|reward)$/;
40             };
41              
42             my $NonEmpty = sub {
43             croak "Empty or undef parameter" unless length($_[0] // "");
44             };
45              
46             has 'text' => ( is => 'ro', required => 1, isa => $NonEmpty);
47             has 'id' => ( is => 'ro', required => 1, isa => $NonEmpty);
48             has 'up' => ( is => 'ro', default => sub { 0 }, isa => $Bool);
49             has 'down' => ( is => 'ro', default => sub { 0 }, isa => $Bool);
50             has 'value' => ( is => 'ro', required => 1, isa => $Num);
51             has 'type' => ( is => 'ro', required => 1, isa => $Type);
52             has 'history' => ( is => 'ro' ); # TODO: Objectify
53             has 'repeat' => ( is => 'ro' ); # TODO: Objectify
54             has 'completed' => ( is => 'ro' );
55             has 'tags' => ( is => 'ro' ); # Hashref to uuid => True pairs.
56             has 'streak' => ( is => 'ro' );
57             has '_raw' => ( is => 'rw' );
58              
59             # Debugging hooks in case things go weird.
60              
61             around BUILDARGS => sub {
62             my $orig = shift;
63             my $class = shift;
64              
65             if ($WebService::HabitRPG::DEBUG) {
66             warn "Building task with:\n";
67             warn Dumper(\@_), "\n";
68             }
69              
70             return $class->$orig(@_);
71             };
72              
73             sub BUILD {
74 6     6 0 70 my ($self, $args) = @_;
75              
76             # Since we're usually being called directly with the results of
77             # a JSON parse, we want to record that original structure here.
78              
79 6         138 $self->_raw($args);
80             }
81              
82              
83             sub active_today {
84 5     5 1 418 my ($self) = @_;
85              
86 5 100       24 return 1 if $self->type ne 'daily';
87              
88 4         12 my $frequency = $self->_raw->{frequency};
89              
90 4 100       15 if ($frequency eq 'weekly') {
    50          
91 2 50       8 return unless $self->repeat;
92              
93 2         248 my $today_short = (HRPG_REPEAT_MAP)[ int(strftime "%w", localtime) ];
94 2         16 return $self->repeat->{$today_short};
95             }
96             elsif ($frequency eq 'daily') {
97 2         5 my $every_x = $self->_raw->{everyX};
98 2 50       6 return unless $every_x;
99              
100 2         15 my $start_date = DateTime::Format::ISO8601->new->parse_datetime($self->_raw->{startDate})->truncate(to => 'day');
101 2         1261 my $days_since_start = DateTime->today->delta_days($start_date)->in_units('days');
102              
103 2         1045 return $days_since_start % $every_x == 0;
104             }
105             else {
106 0         0 return;
107             }
108             }
109              
110              
111             sub format_task {
112 1     1 1 3369 my ($task) = @_;
113              
114 1         3 my $formatted = "";
115              
116 1 50       14 if ($task->type =~ /^(?:daily|todo)$/) {
    50          
117 0 0       0 if ($task->completed) {
    0          
118 0         0 $formatted .= '[X] ';
119             }
120             elsif (not $task->active_today) {
121 0         0 $formatted .= '[-] ';
122             }
123             else {
124 0         0 $formatted .= '[ ] ';
125             }
126             }
127             elsif ($task->type eq 'habit') {
128 1         3 $formatted .= ' ';
129 1 50       5 $formatted .= $task->{up} ? "+" : " " ;
130 1 50       11 $formatted .= $task->{down} ? "- " : " " ;
131             }
132             else {
133 0         0 $formatted .= " * ";
134             }
135              
136 1         11 $formatted .= $task->text;
137              
138 1         3 return $formatted;
139             }
140              
141             1;
142              
143             __END__
144              
145             =pod
146              
147             =encoding UTF-8
148              
149             =head1 NAME
150              
151             WebService::HabitRPG::Task - A HabitRPG task
152              
153             =head1 VERSION
154              
155             version 0.23
156              
157             =head1 SYNOPSIS
158              
159             my $task = WebService::HabitRRG::Task->new(
160             text => 'Floss teeth',
161             id => 'a670fc50-4e04-4b0f-9583-e4ee55fced02',
162             up => 1,
163             down => 0,
164             value => 0,
165             type => 'habit',
166             tags => { work_uuid => 1, home_uuid => 0 },
167             );
168              
169             say "Task name: ", $task->text;
170              
171             =head1 DESCRIPTION
172              
173             Represents a HabitRPG task object. All properties shown in the
174             synopsis are checked for sanity and are available as methods.
175              
176             The C<history>, C<completed> and C<repeat> attributes may also
177             be provided at build-time, but are optional. No checking is done
178             on them (yet).
179              
180             =head1 METHODS
181              
182             =head2 active_today()
183              
184             if ( $task->active_today ) { # This task is active today! }
185              
186             Returns a true value if this task is due today. To check if it's
187             already completed, check C< $task->completed >.
188              
189             =head2 format_task()
190              
191             say $task->format_task;
192              
193             Generated a formatted form of the task, including check-boxes for
194             C<todo> and C<daily> tasks, and C<+> and C<-> signs for habits.
195              
196             =for Pod::Coverage BUILDARGS BUILD text id up down value type history completed repeat tags
197              
198             =head1 AUTHOR
199              
200             Paul Fenwick <pjf@cpan.org>
201              
202             =head1 COPYRIGHT AND LICENSE
203              
204             This software is copyright (c) 2013 by Paul Fenwick.
205              
206             This is free software; you can redistribute it and/or modify it under
207             the same terms as the Perl 5 programming language system itself.
208              
209             =cut