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   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