line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WebService::HabitRPG; |
2
|
3
|
|
|
3
|
|
62561
|
use v5.010; |
|
3
|
|
|
|
|
9
|
|
3
|
3
|
|
|
3
|
|
16
|
use strict; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
48
|
|
4
|
3
|
|
|
3
|
|
12
|
use warnings; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
66
|
|
5
|
3
|
|
|
3
|
|
517
|
use autodie; |
|
3
|
|
|
|
|
23008
|
|
|
3
|
|
|
|
|
13
|
|
6
|
3
|
|
|
3
|
|
15575
|
use Carp qw(carp); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
152
|
|
7
|
3
|
|
|
3
|
|
1071
|
use Moo; |
|
3
|
|
|
|
|
23408
|
|
|
3
|
|
|
|
|
22
|
|
8
|
3
|
|
|
3
|
|
4496
|
use WWW::Mechanize; |
|
3
|
|
|
|
|
310673
|
|
|
3
|
|
|
|
|
133
|
|
9
|
3
|
|
|
3
|
|
1359
|
use Method::Signatures 20121201; |
|
3
|
|
|
|
|
144035
|
|
|
3
|
|
|
|
|
34
|
|
10
|
3
|
|
|
3
|
|
1959
|
use WebService::HabitRPG::Task; |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
84
|
|
11
|
3
|
|
|
3
|
|
20
|
use JSON::MaybeXS; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
178
|
|
12
|
3
|
|
|
3
|
|
17
|
use Data::Dumper; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
117
|
|
13
|
3
|
|
|
3
|
|
27
|
use Carp qw(croak); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
700
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $DEBUG = $ENV{HRPG_DEBUG} || 0; |
16
|
|
|
|
|
|
|
our $TAG_PREFIX_CHARACTER = '^'; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# ABSTRACT: Perl interface to the HabitRPG (Habitica) API |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $VERSION = '0.30'; # VERSION: Generated by DZP::OurPkg:Version |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
has 'api_token' => (is => 'ro'); # aka x-api-key |
24
|
|
|
|
|
|
|
has 'user_id' => (is => 'ro'); # aka x-api-user |
25
|
|
|
|
|
|
|
has 'agent' => (is => 'rw'); |
26
|
|
|
|
|
|
|
has 'api_base' => (is => 'ro', default => sub { 'https://habitica.com/api/v3' }); |
27
|
|
|
|
|
|
|
has '_last_json' => (is => 'rw'); # For debugging |
28
|
|
|
|
|
|
|
has 'tags' => (is => 'rw'); |
29
|
|
|
|
|
|
|
has 'tag_prefix' => (is => 'rw', default => sub { '^' }); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# use constant URL_BASE => 'https://habitica.com/api/v3'; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub BUILD { |
34
|
3
|
|
|
3
|
0
|
24
|
my ($self, $args) = @_; |
35
|
|
|
|
|
|
|
|
36
|
3
|
|
100
|
|
|
14
|
my $keep_alive = $args->{keep_alive} // 1; |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# Set a default agent if we don't already have one. |
39
|
|
|
|
|
|
|
|
40
|
3
|
50
|
|
|
|
12
|
if (not $self->agent) { |
41
|
3
|
|
|
|
|
41
|
$self->agent( |
42
|
|
|
|
|
|
|
WWW::Mechanize->new( |
43
|
|
|
|
|
|
|
agent => "Perl/$], WebService::HabitRPG/" . $self->VERSION, |
44
|
|
|
|
|
|
|
keep_alive => $keep_alive, |
45
|
|
|
|
|
|
|
) |
46
|
|
|
|
|
|
|
); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
3
|
|
|
|
|
12503
|
return; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
3
|
0
|
|
3
|
|
3065
|
method user() { return $self->_get_request( '/user' ); } |
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
|
56
|
3
|
0
|
|
3
|
|
265806
|
method tasks($type where qr{^(?: habits | habit | dailys | daily | todos | todo | rewards | reward | )$}x = "") { |
|
3
|
0
|
|
3
|
|
1613
|
|
|
3
|
0
|
|
0
|
|
33
|
|
|
3
|
|
|
|
|
16
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
57
|
0
|
0
|
|
|
|
|
if ($type) { |
58
|
0
|
0
|
|
|
|
|
if ($type !~ /s$/) { |
59
|
0
|
|
|
|
|
|
carp "Deprecated type '$type' used in tasks(); please use '${type}s' instead"; |
60
|
0
|
|
|
|
|
|
$type .= 's'; |
61
|
|
|
|
|
|
|
} |
62
|
0
|
|
|
|
|
|
return $self->_get_tasks( "/tasks/user?type=$type" ); |
63
|
|
|
|
|
|
|
} |
64
|
0
|
|
|
|
|
|
return $self->_get_tasks( "/tasks/user" ); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
3
|
0
|
|
3
|
|
7058
|
method get_task($task_id) { |
|
0
|
0
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# _get_tasks() always returns an array ref, so we unpack that here. |
71
|
|
|
|
|
|
|
|
72
|
0
|
|
|
|
|
|
return $self->_get_tasks("/task/$task_id")->[0]; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
|
76
|
3
|
|
|
3
|
|
72496
|
method new_task( |
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
77
|
3
|
0
|
|
3
|
|
381
|
:$type! where qr{^(?: habit | daily | todo | reward )$}x, |
|
3
|
0
|
|
|
|
6
|
|
|
3
|
|
|
|
|
16
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
78
|
0
|
0
|
|
|
|
|
:$text!, |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
|
:$completed, |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
80
|
0
|
0
|
|
|
|
|
:$value = 0, |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
81
|
0
|
0
|
|
|
|
|
:$note = '', |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
82
|
0
|
0
|
|
|
|
|
:$up = 1, |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
83
|
0
|
0
|
|
|
|
|
:$down = 1, |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
84
|
0
|
0
|
|
|
|
|
:$extend = {}, |
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
) { |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# Magical boolification for JSONification. |
88
|
|
|
|
|
|
|
# TODO: These work with JSON::XS. Do they work with other backends? |
89
|
|
|
|
|
|
|
|
90
|
0
|
0
|
|
|
|
|
$up = $up ? \1 : \0; |
91
|
0
|
0
|
|
|
|
|
$down = $down ? \1 : \0; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# TODO : The API spec doesn't allow the submission of up/down |
94
|
|
|
|
|
|
|
# values, but I feel that *should* be allowed, otherwise |
95
|
|
|
|
|
|
|
# creating goals isn't full-featured. |
96
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
my $payload = $self->_encode_json({ |
98
|
|
|
|
|
|
|
type => $type, |
99
|
|
|
|
|
|
|
text => $text, |
100
|
|
|
|
|
|
|
completed => $completed, |
101
|
|
|
|
|
|
|
value => $value, |
102
|
|
|
|
|
|
|
note => $note, |
103
|
|
|
|
|
|
|
up => $up, |
104
|
|
|
|
|
|
|
down => $down, |
105
|
|
|
|
|
|
|
%$extend, |
106
|
|
|
|
|
|
|
}); |
107
|
|
|
|
|
|
|
|
108
|
0
|
|
|
|
|
|
my $req = $self->_build_request('POST', '/tasks/user'); |
109
|
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
$req->content( $payload ); |
111
|
|
|
|
|
|
|
|
112
|
0
|
|
|
|
|
|
return $self->_request( $req ); |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
117
|
3
|
|
|
3
|
|
22570
|
method updown( |
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
118
|
0
|
0
|
|
|
|
|
$task!, |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
119
|
3
|
0
|
|
3
|
|
355
|
$direction! where qr{up|down} |
|
3
|
0
|
|
|
|
6
|
|
|
3
|
0
|
|
|
|
13
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
) { |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
my $req = $self->_build_request('POST', "/tasks/$task/score/$direction"); |
123
|
0
|
|
|
|
|
|
$req->header('Content-Length' => 0); |
124
|
0
|
|
|
|
|
|
$req->content(''); |
125
|
|
|
|
|
|
|
|
126
|
0
|
|
|
|
|
|
return $self->_request( $req ); |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# Convenience methods |
131
|
3
|
0
|
|
3
|
|
6394
|
method up ($task) { return $self->updown($task, 'up' ); } |
|
0
|
0
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
132
|
3
|
0
|
|
3
|
|
5874
|
method down($task) { return $self->updown($task, 'down'); } |
|
0
|
0
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
|
135
|
3
|
|
|
3
|
|
10455
|
method _update( |
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
136
|
0
|
0
|
|
|
|
|
$task!, |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
137
|
0
|
0
|
|
|
|
|
$updates! |
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
) { |
139
|
0
|
|
|
|
|
|
my $payload = $self->_encode_json({ |
140
|
|
|
|
|
|
|
%$updates, |
141
|
|
|
|
|
|
|
}); |
142
|
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
my $req = $self->_build_request('PUT', "/user/task/$task"); |
144
|
|
|
|
|
|
|
|
145
|
0
|
|
|
|
|
|
$req->content( $payload ); |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
return $self->_request( $req ); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# NOTE: We exclude rewards |
152
|
|
|
|
|
|
|
# NOTE: This returns a list of data structures. |
153
|
|
|
|
|
|
|
# NOTE: Case insensitive search |
154
|
|
|
|
|
|
|
|
155
|
3
|
0
|
|
3
|
|
13975
|
method search_tasks($search_term, :$all = 0) { |
|
0
|
0
|
|
0
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
|
my $tasks = $self->tasks; |
157
|
0
|
|
|
|
|
|
my @matches; |
158
|
|
|
|
|
|
|
my $tag_uuid; |
159
|
|
|
|
|
|
|
|
160
|
0
|
|
|
|
|
|
my $tag_prefix = $self->tag_prefix; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
# Check to see if we're doing a tag search. |
163
|
|
|
|
|
|
|
|
164
|
0
|
0
|
|
|
|
|
if ($search_term =~ /^\Q$tag_prefix\E(?<tag>.*)/ms) { |
165
|
0
|
0
|
|
|
|
|
if (not $self->tags) { croak "No tags defined on " . ref($self) . " object!"; } |
|
0
|
|
|
|
|
|
|
166
|
3
|
|
|
3
|
|
1662
|
$tag_uuid = $self->tags->{ $+{tag} }; |
|
3
|
|
|
|
|
1041
|
|
|
3
|
|
|
|
|
487
|
|
|
0
|
|
|
|
|
|
|
167
|
0
|
0
|
|
|
|
|
$tag_uuid or croak "Search for unknown tag: $+{tag}"; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
|
foreach my $task (@$tasks) { |
171
|
|
|
|
|
|
|
|
172
|
0
|
0
|
|
|
|
|
next if $task->type eq 'reward'; |
173
|
0
|
0
|
0
|
|
|
|
if ($task->completed and not $all) { next; } |
|
0
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# If we're doing a tag search... |
176
|
0
|
0
|
|
|
|
|
if ($tag_uuid) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
177
|
0
|
0
|
|
|
|
|
next if not $task->tags; # Skip tagless tasks |
178
|
0
|
0
|
|
|
|
|
push(@matches, $task) if $task->tags->{$tag_uuid}; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# If our search term exactly matches a task ID, then use that. |
182
|
|
|
|
|
|
|
elsif ($task->id eq $search_term) { |
183
|
0
|
|
|
|
|
|
return $task; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# Otherwise, if it contains our search term. |
187
|
|
|
|
|
|
|
elsif ($task->text =~ /\Q$search_term\E/i) { |
188
|
0
|
|
|
|
|
|
push(@matches, $task); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
return @matches; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
#### Internal use only code beyond this point #### |
196
|
|
|
|
|
|
|
|
197
|
3
|
0
|
|
3
|
|
6209
|
method _get_tasks($url) { |
|
0
|
0
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
|
my $results = $self->_get_request($url); |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# If we're fetching a single task, it can come back as |
201
|
|
|
|
|
|
|
# an un-wrapped hash. We re-wrap it here if that's the case. |
202
|
|
|
|
|
|
|
|
203
|
0
|
0
|
|
|
|
|
if (ref($results) ne 'ARRAY') { |
204
|
0
|
|
|
|
|
|
$results = [$results]; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
0
|
|
|
|
|
|
my @tasks; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Somehow we can get back completely undefined results, |
210
|
|
|
|
|
|
|
# hence the grep to only look at defined ones. |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
foreach my $raw (grep { defined } @$results) { |
|
0
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
|
push @tasks, WebService::HabitRPG::Task->new( |
214
|
|
|
|
|
|
|
$raw, |
215
|
|
|
|
|
|
|
); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Sort based on task type. The old API used to do this for us. |
219
|
0
|
|
|
|
|
|
@tasks = sort { $a->type cmp $b->type } @tasks; |
|
0
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
|
221
|
0
|
|
|
|
|
|
return \@tasks; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
3
|
0
|
|
3
|
|
6131
|
method _get_request($url) { |
|
0
|
0
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
my $req = $self->_build_request('GET', $url); |
226
|
0
|
|
|
|
|
|
return $self->_request( $req ); |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# I don't like the name here, but this makes our request, and decodes |
230
|
|
|
|
|
|
|
# the JSON-filled result |
231
|
|
|
|
|
|
|
|
232
|
3
|
0
|
|
3
|
|
5856
|
method _request($req) { |
|
0
|
0
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
233
|
0
|
|
|
|
|
|
my $result = $self->_decode_json($self->agent->request( $req )->decoded_content); |
234
|
|
|
|
|
|
|
|
235
|
0
|
0
|
|
|
|
|
if ($result->{'error'}) { |
236
|
0
|
|
|
|
|
|
die $result->{'error'}{'message'}; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
0
|
|
|
|
|
|
return $result->{'data'}; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
3
|
0
|
|
3
|
|
10038
|
method _build_request($type, $url) { |
|
0
|
0
|
|
0
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
|
244
|
0
|
0
|
|
|
|
|
warn "Making $type request to $url" if $DEBUG; |
245
|
|
|
|
|
|
|
|
246
|
0
|
|
|
|
|
|
my $req = HTTP::Request->new( $type, $self->api_base . $url ); |
247
|
0
|
|
|
|
|
|
$req->header( 'Content-Type' => 'application/json'); |
248
|
0
|
|
|
|
|
|
$req->header( 'x-api-user' => $self->user_id ); |
249
|
0
|
|
|
|
|
|
$req->header( 'x-api-key' => $self->api_token ); |
250
|
|
|
|
|
|
|
|
251
|
0
|
|
|
|
|
|
return $req; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
my $json = JSON->new; |
255
|
|
|
|
|
|
|
|
256
|
3
|
0
|
|
3
|
|
6604
|
method _decode_json($string) { |
|
0
|
0
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
|
258
|
0
|
0
|
|
|
|
|
warn "Decoding JSON: $string" if $DEBUG; |
259
|
|
|
|
|
|
|
|
260
|
0
|
|
|
|
|
|
$self->_last_json($string); # For debugging |
261
|
0
|
|
|
|
|
|
my $result = $json->decode( $string ); |
262
|
|
|
|
|
|
|
|
263
|
0
|
0
|
|
|
|
|
if ($DEBUG) { |
264
|
0
|
|
|
|
|
|
warn "JSON decoded to: ", Dumper($result), "\n"; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
0
|
|
|
|
|
|
return $result; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
3
|
0
|
|
3
|
|
6099
|
method _encode_json($string) { |
|
0
|
0
|
|
0
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
271
|
0
|
|
|
|
|
|
return $json->encode( $string ); |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
1; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
__END__ |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=pod |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=encoding UTF-8 |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=head1 NAME |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
WebService::HabitRPG - Perl interface to the HabitRPG (Habitica) API |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=head1 VERSION |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
version 0.30 |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
=head1 SYNOPSIS |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
use WebService::HabitRPG; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
# The API Token and User ID are obained through the |
296
|
|
|
|
|
|
|
# Setting -> API link on http://habitrpg.com/ |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
my $hrpg = WebService::HabitRPG->new( |
299
|
|
|
|
|
|
|
api_token => 'your-token-goes-here', |
300
|
|
|
|
|
|
|
user_id => 'your-user-id-goes-here', |
301
|
|
|
|
|
|
|
tags => { work => $uuid, home => $uuid2, ... }, # optional |
302
|
|
|
|
|
|
|
); |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# Get everyting about the user |
305
|
|
|
|
|
|
|
my $user = $hrpg->user; |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
# Get all tasks. |
308
|
|
|
|
|
|
|
my $tasks = $hrpg->tasks; |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# Get all tasks of a particular type (eg: 'dailys') |
311
|
|
|
|
|
|
|
my $daily = $hrpg->tasks('dailys'); |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# Increment/decrement a task |
314
|
|
|
|
|
|
|
$hrpg->up($task_id); |
315
|
|
|
|
|
|
|
$hrpg->down($task_id); |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
# Make a new task |
318
|
|
|
|
|
|
|
$hrpg->new_task( |
319
|
|
|
|
|
|
|
type => 'daily', |
320
|
|
|
|
|
|
|
text => 'floss teeth', |
321
|
|
|
|
|
|
|
up => 1, |
322
|
|
|
|
|
|
|
down => 0, |
323
|
|
|
|
|
|
|
); |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=head1 DESCRIPTION |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
Interface to API provided by L<HabitRPG|http://habitrpg.com/>, also |
328
|
|
|
|
|
|
|
known as Habitica. |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
At the time of release, the HabitRPG API is still under construction. |
331
|
|
|
|
|
|
|
This module may change as a result. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Note that when data structures are returned, they are almost |
334
|
|
|
|
|
|
|
always straight conversions from the JSON returned by the |
335
|
|
|
|
|
|
|
HabitRPG API. |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=head1 METHODS |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=head2 new |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
my $hrpg = WebService::HabitRPG->new( |
342
|
|
|
|
|
|
|
api_token => 'your-token-goes-here', |
343
|
|
|
|
|
|
|
user_id => 'your-user-id-goes-here', |
344
|
|
|
|
|
|
|
tags => { work => $work_uuid, home => $home_uuid, ... }, |
345
|
|
|
|
|
|
|
tag_prefix => '^', # Optional, defaults to '^' |
346
|
|
|
|
|
|
|
); |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
Creates a new C<WebService::HabitRPG> object. The C<api_token> and C<user_id> |
349
|
|
|
|
|
|
|
parameters are mandatory. You may also pass your own L<WWW::Mechanize> |
350
|
|
|
|
|
|
|
compatible user-agent with C<agent>, and should you need it your own HabitRPG |
351
|
|
|
|
|
|
|
API base URL with C<api_base> (useful for testing, or if you're running your |
352
|
|
|
|
|
|
|
own server). |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
By default, the official API base of C<https://habitica.com/api/v3> is used. |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
The C<tags> field is optional, but if included should consist of C<tag => uuid> |
357
|
|
|
|
|
|
|
pairs. When API support is added for tags, this optional will become obsolete. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
I<Use of the tags feature should be considered experimental>. |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=head2 user |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
my $user = $hrpg->user(); |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
Returns everything from the C</user> route in the HabitRPG API. |
366
|
|
|
|
|
|
|
This is practically everything about the user, their tasks, scores, |
367
|
|
|
|
|
|
|
and other information. |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
The Perl data structure that is returned is a straight conversion |
370
|
|
|
|
|
|
|
from the JSON provided by the HabitRPG API. |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=head2 tasks |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
my $tasks = $hrpg->tasks(); # All tasks |
375
|
|
|
|
|
|
|
my $habits = $hrpg->tasks('habits'); # Only habits |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
Return a reference to an array of tasks. With no arguments, all |
378
|
|
|
|
|
|
|
tasks (habits, dailies, todos and rewards) are returned. With |
379
|
|
|
|
|
|
|
an argument, only tasks of the given type are returned. The |
380
|
|
|
|
|
|
|
argument must be one of C<habits>, C<dailys>, C<todos> or C<rewards>. |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
B<NOTE>: The singular forms C<habit>, C<daily>, C<todo>, and C<reward> |
383
|
|
|
|
|
|
|
are also accepted, but deprecated; they will be forbidden in a future |
384
|
|
|
|
|
|
|
release. Please take the time to update your code! A warning will |
385
|
|
|
|
|
|
|
be emitted if a "legacy" type is seen. |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
See L<WebService::HabitRPG::Task> for a complete description of |
388
|
|
|
|
|
|
|
what task objects look like. |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Not all tasks will have all fields. Using the L<hrpg> command-line |
391
|
|
|
|
|
|
|
tool with C<hrpg dump tasks> is a convenient way to see the |
392
|
|
|
|
|
|
|
data structures returned by this method. |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
=head2 get_task |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
my $task = $hrpg->get_task('6a11dd4d-c2d6-42b7-b9ff-f562d4ccce4e'); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
Given a task ID, returns information on that task in the same format |
399
|
|
|
|
|
|
|
at L</tasks> above. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=head2 new_task |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
$hrpg->new_task( |
404
|
|
|
|
|
|
|
type => 'daily', # Required |
405
|
|
|
|
|
|
|
text => 'floss teeth', # Required |
406
|
|
|
|
|
|
|
up => 1, # Suggested, defaults true |
407
|
|
|
|
|
|
|
down => 0, # Suggested, defaults true |
408
|
|
|
|
|
|
|
value => 0, |
409
|
|
|
|
|
|
|
note => "Floss every tooth for great justice", |
410
|
|
|
|
|
|
|
completed => 0, |
411
|
|
|
|
|
|
|
extend => {}, |
412
|
|
|
|
|
|
|
); |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
Creates a new task. Only the C<type> and C<text> arguments are |
415
|
|
|
|
|
|
|
required, all other tasks are optional. The C<up> and C<down> |
416
|
|
|
|
|
|
|
options default to true (ie, tasks can be both incremented and |
417
|
|
|
|
|
|
|
decremented). |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
The C<type> parameter must be one of: C<habit>, C<daily>, |
420
|
|
|
|
|
|
|
C<todo> or C<reward>. |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
The C<extend> parameter consists to key/value pairs that will be |
423
|
|
|
|
|
|
|
added to the JSON create packet. This should only be used if you |
424
|
|
|
|
|
|
|
know what you're doing, and wish to take advantage of new or |
425
|
|
|
|
|
|
|
undocumented features in the API. |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
Returns a task data structure of the task created, identical |
428
|
|
|
|
|
|
|
to the L</tasks> method above. |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
Creating tasks that can be neither incremented nor decremented |
431
|
|
|
|
|
|
|
is of dubious usefulness. |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=head2 updown |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
$hrpg->updown('6a11dd4d-c2d6-42b7-b9ff-f562d4ccce4e', 'up' ); |
436
|
|
|
|
|
|
|
$hrpg->updown('6a11dd4d-c2d6-42b7-b9ff-f562d4ccce4e', 'down'); |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
Moves the habit in the direction specified. Returns a data structure |
439
|
|
|
|
|
|
|
of character status: |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
{ |
442
|
|
|
|
|
|
|
exp => 11, |
443
|
|
|
|
|
|
|
gp => 15.5, |
444
|
|
|
|
|
|
|
hp => 50, |
445
|
|
|
|
|
|
|
lv => 2, |
446
|
|
|
|
|
|
|
delta => 1, |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=head2 up |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
$hrpg->up($task); |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
Convenience method. Equivalent to C<$hrpg->updown($task, 'up')>; |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=head2 down |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
$hrpg->down($task); |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
Convenience method. Equivalent to C<$hrpg->updown($task, 'down')>; |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=head2 _update |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
$hrpg->_update($task, { attr => value }); |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
I<This method should be considered experimental.> |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
Updates the given task on the server (using the underlying C<PUT> |
468
|
|
|
|
|
|
|
functionality in the API). Attributes are not checked for sanity, |
469
|
|
|
|
|
|
|
they're just directly converted into JSON. |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
=head2 search_tasks |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
my @tasks = $hrpg->search_tasks($search_term, all => $bool); |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
# Eg: |
476
|
|
|
|
|
|
|
my @tasks = $hrpg->search_tasks('floss'); |
477
|
|
|
|
|
|
|
my @tasks = $hrpg->search_tasks('git', all => 1); |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
Search for tasks which match the provided search term. If the |
480
|
|
|
|
|
|
|
search term C<exactly> matches a task ID, then the task ID |
481
|
|
|
|
|
|
|
is returned. Otherwise, returns a list of tasks which contain |
482
|
|
|
|
|
|
|
the search term in their names (the C<text> field returned by the API). |
483
|
|
|
|
|
|
|
This list is in the same format as the as the L</tasks> method call. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
If the term begins with the tag prefix character ('^' by default), |
486
|
|
|
|
|
|
|
it is considered to be a tag, and the hashless form is searched for. |
487
|
|
|
|
|
|
|
For example, '^work' will result in returning all tasks which match |
488
|
|
|
|
|
|
|
the tag 'work'. |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
If the term does not begin with a hash, then the search term is |
491
|
|
|
|
|
|
|
treated in a literal, case-insensitive fashion. |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
If the optional C<all> parameter is set, then all tasks are |
494
|
|
|
|
|
|
|
returned. Otherwise only non-completed tasks are returned. |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
This is useful for providing a human-friendly way to refer to |
497
|
|
|
|
|
|
|
tasks. For example: |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
# Search for a user-provided term |
500
|
|
|
|
|
|
|
my @tasks = $hrpg->search_tasks($term); |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# Increment task if found |
503
|
|
|
|
|
|
|
if (@tasks == 1) { |
504
|
|
|
|
|
|
|
$hrpg->up($tasks[0]->id); |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
else { |
507
|
|
|
|
|
|
|
say "Too few or too many tasks found."; |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=for Pod::Coverage BUILD DEMOLISH api_token user_id agent api_base tags tag_prefix |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=head1 BUGS |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
I'm sure there are plenty! Please view and/or record them at |
515
|
|
|
|
|
|
|
L<https://github.com/pjf/WebService-HabitRPG/issues> . |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=head1 SEE ALSO |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
The L<HabitRPG API spec|https://github.com/lefnire/habitrpg/wiki/API>. |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
The L<hrpg> command-line client. It's freakin' awesome. |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
=head1 AUTHOR |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
Paul Fenwick <pjf@cpan.org> |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
This software is copyright (c) 2013 by Paul Fenwick. |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
532
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=cut |