line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package AnyEvent::WebService::Tracks; |
2
|
|
|
|
|
|
|
|
3
|
10
|
|
|
10
|
|
209583
|
use strict; |
|
10
|
|
|
|
|
26
|
|
|
10
|
|
|
|
|
407
|
|
4
|
10
|
|
|
10
|
|
54
|
use warnings; |
|
10
|
|
|
|
|
19
|
|
|
10
|
|
|
|
|
356
|
|
5
|
|
|
|
|
|
|
|
6
|
10
|
|
|
10
|
|
11055
|
use AnyEvent::HTTP qw(http_request); |
|
10
|
|
|
|
|
429401
|
|
|
10
|
|
|
|
|
1144
|
|
7
|
10
|
|
|
10
|
|
115
|
use Carp qw(croak); |
|
10
|
|
|
|
|
17
|
|
|
10
|
|
|
|
|
452
|
|
8
|
10
|
|
|
10
|
|
23490
|
use DateTime; |
|
10
|
|
|
|
|
1924573
|
|
|
10
|
|
|
|
|
436
|
|
9
|
10
|
|
|
10
|
|
10989
|
use DateTime::Format::ISO8601; |
|
10
|
|
|
|
|
524258
|
|
|
10
|
|
|
|
|
1075
|
|
10
|
10
|
|
|
10
|
|
18404
|
use MIME::Base64 qw(encode_base64); |
|
10
|
|
|
|
|
10764
|
|
|
10
|
|
|
|
|
874
|
|
11
|
10
|
|
|
10
|
|
184494
|
use URI; |
|
10
|
|
|
|
|
71842
|
|
|
10
|
|
|
|
|
410
|
|
12
|
10
|
|
|
10
|
|
16846
|
use XML::Parser; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use XML::Writer; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use AnyEvent::WebService::Tracks::Context; |
16
|
|
|
|
|
|
|
use AnyEvent::WebService::Tracks::Project; |
17
|
|
|
|
|
|
|
use AnyEvent::WebService::Tracks::Todo; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new { |
22
|
|
|
|
|
|
|
my ( $class, %params ) = @_; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
return bless { |
25
|
|
|
|
|
|
|
url => URI->new($params{url}), |
26
|
|
|
|
|
|
|
username => $params{username}, |
27
|
|
|
|
|
|
|
password => $params{password}, |
28
|
|
|
|
|
|
|
}, $class; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub parse_datetime { |
32
|
|
|
|
|
|
|
my ( $self, $str ) = @_; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
return DateTime::Format::ISO8601->parse_datetime($str); |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub format_datetime { |
38
|
|
|
|
|
|
|
my ( $self, $datetime ) = @_; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my @fields = qw/year month day hour minute second/; |
41
|
|
|
|
|
|
|
my %attrs = map { $_ => $datetime->$_() } @fields; |
42
|
|
|
|
|
|
|
my $offset = DateTime::TimeZone->offset_as_string($datetime->offset); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
return sprintf '%04d-%02d-%02dT%02d:%02d:%02d%s', @attrs{@fields}, $offset; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub handle_error { |
48
|
|
|
|
|
|
|
my ( $self, $body, $headers, $cb ) = @_; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my $message; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
if($body) { |
53
|
|
|
|
|
|
|
# context creation serves errors in XML, but project creation in plain text, |
54
|
|
|
|
|
|
|
# even though the Content-Type is application/xml... |
55
|
|
|
|
|
|
|
if($body =~ /^\s*<\?xml/) { |
56
|
|
|
|
|
|
|
my $error = $self->parse_single(undef, $body); |
57
|
|
|
|
|
|
|
$message = $error->{'error'}; |
58
|
|
|
|
|
|
|
} else { |
59
|
|
|
|
|
|
|
$message = $body; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
} else { |
62
|
|
|
|
|
|
|
$message = $headers->{'status'}; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
$cb->(undef, $message); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub generate_xml { |
69
|
|
|
|
|
|
|
my ( $self, $root, $attrs ) = @_; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
my $xml = ''; |
72
|
|
|
|
|
|
|
my $w = XML::Writer->new(OUTPUT => \$xml); |
73
|
|
|
|
|
|
|
my @keys = sort keys %$attrs; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
$w->startTag($root); |
76
|
|
|
|
|
|
|
foreach my $k (@keys) { |
77
|
|
|
|
|
|
|
my $v = $attrs->{$k}; |
78
|
|
|
|
|
|
|
my @xml_attrs; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
push @xml_attrs, (nil => 'true') unless defined $v; |
81
|
|
|
|
|
|
|
if(ref($v) eq 'DateTime') { |
82
|
|
|
|
|
|
|
push @xml_attrs, (type => 'datetime'); |
83
|
|
|
|
|
|
|
$v = $self->format_datetime($v); |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my $nk = $k; |
87
|
|
|
|
|
|
|
$nk =~ tr/_/-/; |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
$w->startTag($nk, @xml_attrs); |
90
|
|
|
|
|
|
|
$w->characters($v) if defined $v; |
91
|
|
|
|
|
|
|
$w->endTag($nk); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
$w->endTag($root); |
94
|
|
|
|
|
|
|
$w->end; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
return $xml; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub status_successful { |
100
|
|
|
|
|
|
|
my ( $self, $status ) = @_; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
return ($status >= 200 && $status < 300); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub do_request { |
106
|
|
|
|
|
|
|
my ( $self, $http_method, $uri, $params, $method, $cb ) = @_; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
my ( $username, $password ) = @{$self}{qw/username password/}; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
my $auth_token = encode_base64(join(':', $username, $password), ''); |
111
|
|
|
|
|
|
|
$params->{'headers'} = { |
112
|
|
|
|
|
|
|
Authorization => "Basic $auth_token", |
113
|
|
|
|
|
|
|
Accept => 'application/xml', |
114
|
|
|
|
|
|
|
Referer => undef, |
115
|
|
|
|
|
|
|
}; |
116
|
|
|
|
|
|
|
if($params->{'body'}) { |
117
|
|
|
|
|
|
|
$params->{'headers'}{'Content-Type'} = 'text/xml'; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
my $handle_result = sub { |
121
|
|
|
|
|
|
|
my ( $data, $headers ) = @_; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
if($self->status_successful($headers->{'Status'})) { |
124
|
|
|
|
|
|
|
$cb->($self->$method($data, $headers)); |
125
|
|
|
|
|
|
|
} else { |
126
|
|
|
|
|
|
|
$self->handle_error($data, $headers, $cb); |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
}; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
unless(ref($uri) eq 'URI') { |
131
|
|
|
|
|
|
|
if(ref($uri) eq 'ARRAY') { |
132
|
|
|
|
|
|
|
my $copy = $self->{url}->clone; |
133
|
|
|
|
|
|
|
$copy->path_segments($copy->path_segments, @$uri); |
134
|
|
|
|
|
|
|
$uri = $copy; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
http_request $http_method, $uri, %$params, $handle_result; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub do_get { |
142
|
|
|
|
|
|
|
my ( $self, $uri, $method, $cb ) = @_; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
$self->do_request(GET => $uri, {}, $method, $cb); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub do_delete { |
148
|
|
|
|
|
|
|
my ( $self, $uri, $method, $cb ) = @_; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
$self->do_request(DELETE => $uri, {}, $method, $cb); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub do_post { |
154
|
|
|
|
|
|
|
my ( $self, $uri, $body, $method, $cb ) = @_; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
$self->do_request(POST => $uri, { body => $body }, $method, $cb); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub do_put { |
160
|
|
|
|
|
|
|
my ( $self, $uri, $body, $method, $cb ) = @_; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
$self->do_request(PUT => $uri, { body => $body }, $method, $cb); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub parse_entities { |
166
|
|
|
|
|
|
|
my ( $self, $xml, $type, $target_depth ) = @_; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
my @entities; |
169
|
|
|
|
|
|
|
my $current_entity; |
170
|
|
|
|
|
|
|
my $current_tag; |
171
|
|
|
|
|
|
|
my $current_attrs; |
172
|
|
|
|
|
|
|
my $depth = 0; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
my $parser = XML::Parser->new( |
175
|
|
|
|
|
|
|
Handlers => { |
176
|
|
|
|
|
|
|
Start => sub { |
177
|
|
|
|
|
|
|
my ( undef, $tag, %attrs ) = @_; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
if($depth == $target_depth) { |
180
|
|
|
|
|
|
|
$current_entity = {}; |
181
|
|
|
|
|
|
|
} elsif($depth > $target_depth) { |
182
|
|
|
|
|
|
|
$current_tag = $tag; |
183
|
|
|
|
|
|
|
$current_attrs = \%attrs; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
$current_tag =~ tr/-/_/; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
my $nil = $attrs{'nil'}; |
188
|
|
|
|
|
|
|
$nil = defined($nil) && $nil eq 'true'; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
if($nil) { |
191
|
|
|
|
|
|
|
$current_entity->{$current_tag} = undef; |
192
|
|
|
|
|
|
|
} else { |
193
|
|
|
|
|
|
|
$current_entity->{$current_tag} = ''; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
$depth++; |
198
|
|
|
|
|
|
|
}, |
199
|
|
|
|
|
|
|
End => sub { |
200
|
|
|
|
|
|
|
my ( undef, $tag ) = @_; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
$depth--; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
if($depth == $target_depth) { |
205
|
|
|
|
|
|
|
if(defined $type) { |
206
|
|
|
|
|
|
|
push @entities, $type->new(parent => $self, |
207
|
|
|
|
|
|
|
%$current_entity); |
208
|
|
|
|
|
|
|
} else { |
209
|
|
|
|
|
|
|
push @entities, $current_entity; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
undef $current_entity; |
213
|
|
|
|
|
|
|
undef $current_tag; |
214
|
|
|
|
|
|
|
undef $current_attrs; |
215
|
|
|
|
|
|
|
} elsif($depth > $target_depth) { |
216
|
|
|
|
|
|
|
my $type = $current_attrs->{'type'}; |
217
|
|
|
|
|
|
|
$type = '' unless defined $type; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
if($type eq 'datetime') { |
220
|
|
|
|
|
|
|
my $value = $current_entity->{$current_tag}; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
if(defined $value) { |
223
|
|
|
|
|
|
|
$current_entity->{$current_tag} = |
224
|
|
|
|
|
|
|
$self->parse_datetime($value); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
undef $current_tag; |
228
|
|
|
|
|
|
|
undef $current_attrs; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
}, |
231
|
|
|
|
|
|
|
Char => sub { |
232
|
|
|
|
|
|
|
my ( undef, $chars ) = @_; |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
if(defined $current_tag) { |
235
|
|
|
|
|
|
|
$current_entity->{$current_tag} .= $chars; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
}, |
238
|
|
|
|
|
|
|
}, |
239
|
|
|
|
|
|
|
); |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
$parser->parse($xml); |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
return \@entities; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
sub parse_single { |
247
|
|
|
|
|
|
|
my ( $self, $type, $xml ) = @_; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
return $self->parse_entities($xml, $type, 0)->[0]; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
sub parse_multiple { |
253
|
|
|
|
|
|
|
my ( $self, $type, $xml ) = @_; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
return $self->parse_entities($xml, $type, 1); |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub fetch_multiple { |
259
|
|
|
|
|
|
|
my ( $self, $path, $type, $cb ) = @_; |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
my $uri = $self->{'url'}->clone; |
262
|
|
|
|
|
|
|
my @segments = split /\//, $path . '.xml'; |
263
|
|
|
|
|
|
|
$uri->path_segments($uri->path_segments, @segments); |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
$self->do_get($uri, sub { |
266
|
|
|
|
|
|
|
my ( undef, $data ) = @_; |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
return $self->parse_multiple($type, $data); |
269
|
|
|
|
|
|
|
}, $cb); |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
sub fetch_from_location { |
273
|
|
|
|
|
|
|
my ( $self, $url, $type, $cb ) = @_; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
$self->do_get($url, sub { |
276
|
|
|
|
|
|
|
my ( undef, $data ) = @_; |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
return $self->parse_single($type, $data); |
279
|
|
|
|
|
|
|
}, $cb); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub fetch_single { |
283
|
|
|
|
|
|
|
my ( $self, $path, $id, $type, $cb ) = @_; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
my $uri = $self->{'url'}->clone; |
286
|
|
|
|
|
|
|
$uri->path_segments($uri->path_segments, $path, "$id.xml"); |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
$self->fetch_from_location($uri, $type, $cb); |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub create { |
292
|
|
|
|
|
|
|
my ( $self, $path, $type, $root, $attrs, $cb ) = @_; |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
my $uri = $self->{'url'}->clone; |
295
|
|
|
|
|
|
|
$uri->path_segments($uri->path_segments, $path . '.xml'); |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
my $xml = $self->generate_xml($root, $attrs); |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
$self->do_post($uri, $xml, sub { |
300
|
|
|
|
|
|
|
# pass the data and headers along to the following callback |
301
|
|
|
|
|
|
|
return @_[1, 2]; |
302
|
|
|
|
|
|
|
}, sub { |
303
|
|
|
|
|
|
|
my ( $data, $headers ) = @_; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# handle errors during the last phase |
306
|
|
|
|
|
|
|
unless(defined $data) { |
307
|
|
|
|
|
|
|
$cb->($data, $headers); |
308
|
|
|
|
|
|
|
return; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
if($self->status_successful($headers->{'Status'})) { |
312
|
|
|
|
|
|
|
my $location = $headers->{'location'}; |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
$self->fetch_from_location($location, $type, $cb); |
315
|
|
|
|
|
|
|
} else { |
316
|
|
|
|
|
|
|
$self->handle_error($data, $headers, $cb); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
}); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub projects { |
322
|
|
|
|
|
|
|
my ( $self, $cb ) = @_; |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
$self->fetch_multiple('projects', 'AnyEvent::WebService::Tracks::Project', $cb); |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
sub contexts { |
328
|
|
|
|
|
|
|
my ( $self, $cb ) = @_; |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
$self->fetch_multiple('contexts', 'AnyEvent::WebService::Tracks::Context', $cb); |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub todos { |
334
|
|
|
|
|
|
|
my ( $self, $cb ) = @_; |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
$self->fetch_multiple('todos', 'AnyEvent::WebService::Tracks::Todo', $cb); |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
sub create_context { |
340
|
|
|
|
|
|
|
my $self = shift; |
341
|
|
|
|
|
|
|
my $cb = pop; |
342
|
|
|
|
|
|
|
my %params; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
if(@_ == 1) { |
345
|
|
|
|
|
|
|
( $params{'name'} ) = @_; |
346
|
|
|
|
|
|
|
} else { |
347
|
|
|
|
|
|
|
%params = @_; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
if(exists $params{'hide'}) { |
350
|
|
|
|
|
|
|
$params{'hide'} = $params{'hide'} ? 'true' : 'false'; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
$self->create('contexts', 'AnyEvent::WebService::Tracks::Context', |
354
|
|
|
|
|
|
|
context => \%params, $cb); |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub create_project { |
358
|
|
|
|
|
|
|
my $self = shift; |
359
|
|
|
|
|
|
|
my $cb = pop; |
360
|
|
|
|
|
|
|
my %params; |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
if(@_ == 1) { |
363
|
|
|
|
|
|
|
( $params{'name'} ) = @_; |
364
|
|
|
|
|
|
|
} else { |
365
|
|
|
|
|
|
|
%params = @_; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
if(exists $params{'default_context'}) { |
368
|
|
|
|
|
|
|
my $ctx = delete $params{'default_context'}; |
369
|
|
|
|
|
|
|
if(defined $ctx) { |
370
|
|
|
|
|
|
|
unless(ref($ctx) eq 'AnyEvent::WebService::Tracks::Context') { |
371
|
|
|
|
|
|
|
croak "Parameter 'default_context' is not an AnyEvent::WebService::Tracks::Context"; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
$params{'default_context_id'} = $ctx->id; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
$self->create('projects', 'AnyEvent::WebService::Tracks::Project', |
378
|
|
|
|
|
|
|
project => \%params, $cb); |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub create_todo { |
382
|
|
|
|
|
|
|
my $self = shift; |
383
|
|
|
|
|
|
|
my $cb = pop; |
384
|
|
|
|
|
|
|
my %params; |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
if(@_ == 2) { |
387
|
|
|
|
|
|
|
if(ref($_[1]) eq 'AnyEvent::WebService::Tracks::Project') { |
388
|
|
|
|
|
|
|
( @params{qw/description project/} ) = @_; |
389
|
|
|
|
|
|
|
} else { |
390
|
|
|
|
|
|
|
( @params{qw/description context/} ) = @_; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
} else { |
393
|
|
|
|
|
|
|
%params = @_; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
if(my $context = delete $params{'context'}) { |
396
|
|
|
|
|
|
|
unless(ref($context) eq 'AnyEvent::WebService::Tracks::Context') { |
397
|
|
|
|
|
|
|
croak "Parameter 'context' is not an AnyEvent::WebService::Tracks::Context"; |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
$params{'context_id'} = $context->id; |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
if(my $project = delete $params{'project'}) { |
402
|
|
|
|
|
|
|
unless(ref($project) eq 'AnyEvent::WebService::Tracks::Project') { |
403
|
|
|
|
|
|
|
croak "Parameter 'project' is not an AnyEvent::WebService::Tracks::Project"; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
$params{'project_id'} = $project->id; |
406
|
|
|
|
|
|
|
# naughty...violation of privacy |
407
|
|
|
|
|
|
|
if(! exists($params{'context_id'}) && defined($project->{'default_context_id'})) { |
408
|
|
|
|
|
|
|
$params{'context_id'} = $project->{'default_context_id'}; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
unless(exists $params{'context_id'} || exists $params{'project_id'}) { |
412
|
|
|
|
|
|
|
croak "Required parameters 'context' and 'project' not found; you must specify at least one of them"; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
if(my $project = delete $params{'project'}) { |
416
|
|
|
|
|
|
|
unless(ref($project) eq 'AnyEvent::WebService::Tracks::Project') { |
417
|
|
|
|
|
|
|
croak "Parameter 'project' is not an AnyEvent::WebService::Tracks::Project"; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
$params{'project_id'} = $project->id; |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
$self->create('todos', 'AnyEvent::WebService::Tracks::Todo', |
423
|
|
|
|
|
|
|
todo => \%params, $cb); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
1; |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
__END__ |