| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package WebService::HabitRPG::Task; |
|
2
|
5
|
|
|
5
|
|
95922
|
use v5.010; |
|
|
5
|
|
|
|
|
16
|
|
|
3
|
5
|
|
|
5
|
|
24
|
use strict; |
|
|
5
|
|
|
|
|
9
|
|
|
|
5
|
|
|
|
|
84
|
|
|
4
|
5
|
|
|
5
|
|
21
|
use warnings; |
|
|
5
|
|
|
|
|
9
|
|
|
|
5
|
|
|
|
|
94
|
|
|
5
|
5
|
|
|
5
|
|
747
|
use autodie; |
|
|
5
|
|
|
|
|
22995
|
|
|
|
5
|
|
|
|
|
33
|
|
|
6
|
5
|
|
|
5
|
|
28135
|
use Moo; |
|
|
5
|
|
|
|
|
16747
|
|
|
|
5
|
|
|
|
|
29
|
|
|
7
|
5
|
|
|
5
|
|
3618
|
use Scalar::Util qw(looks_like_number); |
|
|
5
|
|
|
|
|
11
|
|
|
|
5
|
|
|
|
|
220
|
|
|
8
|
5
|
|
|
5
|
|
2099
|
use POSIX qw(strftime); |
|
|
5
|
|
|
|
|
18178
|
|
|
|
5
|
|
|
|
|
27
|
|
|
9
|
5
|
|
|
5
|
|
5743
|
use Carp qw(croak); |
|
|
5
|
|
|
|
|
11
|
|
|
|
5
|
|
|
|
|
193
|
|
|
10
|
5
|
|
|
5
|
|
2516
|
use Data::Dumper; |
|
|
5
|
|
|
|
|
26476
|
|
|
|
5
|
|
|
|
|
277
|
|
|
11
|
5
|
|
|
5
|
|
3644
|
use DateTime; |
|
|
5
|
|
|
|
|
1974803
|
|
|
|
5
|
|
|
|
|
233
|
|
|
12
|
5
|
|
|
5
|
|
2996
|
use DateTime::Format::ISO8601; |
|
|
5
|
|
|
|
|
421358
|
|
|
|
5
|
|
|
|
|
273
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
5
|
|
|
|
|
4251
|
use constant HRPG_REPEAT_MAP => qw( |
|
15
|
|
|
|
|
|
|
m t w th f s su |
|
16
|
5
|
|
|
5
|
|
45
|
); |
|
|
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.29'; # 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
|
55
|
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
|
|
|
|
|
38
|
$self->_raw($args); |
|
80
|
|
|
|
|
|
|
} |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub active_today { |
|
84
|
5
|
|
|
5
|
1
|
299
|
my ($self) = @_; |
|
85
|
|
|
|
|
|
|
|
|
86
|
5
|
100
|
|
|
|
26
|
return 1 if $self->type ne 'daily'; |
|
87
|
|
|
|
|
|
|
|
|
88
|
4
|
|
|
|
|
13
|
my $frequency = $self->_raw->{frequency}; |
|
89
|
|
|
|
|
|
|
|
|
90
|
4
|
100
|
|
|
|
14
|
if ($frequency eq 'weekly') { |
|
|
|
50
|
|
|
|
|
|
|
91
|
2
|
50
|
|
|
|
7
|
return unless $self->repeat; |
|
92
|
|
|
|
|
|
|
|
|
93
|
2
|
|
|
|
|
9
|
my $today_short = (HRPG_REPEAT_MAP)[ DateTime->now->set_time_zone('local')->day_of_week - 1 ]; |
|
94
|
2
|
|
|
|
|
1788
|
return $self->repeat->{$today_short}; |
|
95
|
|
|
|
|
|
|
} |
|
96
|
|
|
|
|
|
|
elsif ($frequency eq 'daily') { |
|
97
|
2
|
|
|
|
|
7
|
my $every_x = $self->_raw->{everyX}; |
|
98
|
2
|
50
|
|
|
|
7
|
return unless $every_x; |
|
99
|
|
|
|
|
|
|
|
|
100
|
2
|
|
|
|
|
12
|
my $start_date = DateTime::Format::ISO8601->new->parse_datetime($self->_raw->{startDate})->truncate(to => 'day'); |
|
101
|
2
|
|
|
|
|
1494
|
my $days_since_start = DateTime->today->delta_days($start_date)->in_units('days'); |
|
102
|
|
|
|
|
|
|
|
|
103
|
2
|
|
|
|
|
1205
|
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
|
3864
|
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
|
|
|
|
|
4
|
$formatted .= ' '; |
|
129
|
1
|
50
|
|
|
|
4
|
$formatted .= $task->{up} ? "+" : " " ; |
|
130
|
1
|
50
|
|
|
|
4
|
$formatted .= $task->{down} ? "- " : " " ; |
|
131
|
|
|
|
|
|
|
} |
|
132
|
|
|
|
|
|
|
else { |
|
133
|
0
|
|
|
|
|
0
|
$formatted .= " * "; |
|
134
|
|
|
|
|
|
|
} |
|
135
|
|
|
|
|
|
|
|
|
136
|
1
|
|
|
|
|
4
|
$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.29 |
|
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 streak |
|
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 |