line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package JIRA::Client; |
2
|
|
|
|
|
|
|
{ |
3
|
|
|
|
|
|
|
$JIRA::Client::VERSION = '0.42'; |
4
|
|
|
|
|
|
|
} |
5
|
|
|
|
|
|
|
# ABSTRACT: Extended interface to JIRA's SOAP API |
6
|
|
|
|
|
|
|
|
7
|
2
|
|
|
2
|
|
55650
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
76
|
|
8
|
2
|
|
|
2
|
|
11
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
53
|
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
10
|
use Carp; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
197
|
|
11
|
2
|
|
|
2
|
|
1644
|
use Data::Util qw(:check); |
|
2
|
|
|
|
|
2253
|
|
|
2
|
|
|
|
|
439
|
|
12
|
2
|
|
|
2
|
|
2274
|
use SOAP::Lite; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
16
|
|
|
|
|
|
|
my ($class, @args) = @_; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
my $args; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
if (@args == 1) { |
21
|
|
|
|
|
|
|
$args = shift @args; |
22
|
|
|
|
|
|
|
is_hash_ref($args) or croak "$class::new sole argument must be a hash-ref.\n"; |
23
|
|
|
|
|
|
|
foreach my $arg (qw/baseurl user password/) { |
24
|
|
|
|
|
|
|
exists $args->{$arg} |
25
|
|
|
|
|
|
|
or croak "Missing $arg key to $class::new hash argument.\n"; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
$args->{soapargs} = [] unless exists $args->{soapargs}; |
28
|
|
|
|
|
|
|
} elsif (@args >= 3) { |
29
|
|
|
|
|
|
|
my $baseurl = shift @args; |
30
|
|
|
|
|
|
|
my $user = shift @args; |
31
|
|
|
|
|
|
|
my $password = shift @args; |
32
|
|
|
|
|
|
|
$args = { |
33
|
|
|
|
|
|
|
baseurl => $baseurl, |
34
|
|
|
|
|
|
|
user => $user, |
35
|
|
|
|
|
|
|
password => $password, |
36
|
|
|
|
|
|
|
soapargs => \@args, |
37
|
|
|
|
|
|
|
}; |
38
|
|
|
|
|
|
|
} else { |
39
|
|
|
|
|
|
|
croak "Invalid number of arguments to $class::new.\n"; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
$args->{wsdl} = '/rpc/soap/jirasoapservice-v2?wsdl' unless exists $args->{wsdl}; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $url = $args->{baseurl}; |
45
|
|
|
|
|
|
|
$url =~ s{/$}{}; # clean trailing slash |
46
|
|
|
|
|
|
|
$url .= $args->{wsdl}; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
my $soap = SOAP::Lite->proxy($url, @{$args->{soapargs}}); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# Make all scalars be encoded as strings by default. |
51
|
|
|
|
|
|
|
$soap->typelookup({default => [0, sub {1}, 'as_string']}); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
my $auth = $soap->login($args->{user}, $args->{password}); |
54
|
|
|
|
|
|
|
croak $auth->faultcode(), ', ', $auth->faultstring() |
55
|
|
|
|
|
|
|
if defined $auth->fault(); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
my $auth_result = $auth->result() |
58
|
|
|
|
|
|
|
or croak "Unknown error while connecting to JIRA. Please, check the URL.\n"; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
my $self = { |
61
|
|
|
|
|
|
|
soap => $soap, |
62
|
|
|
|
|
|
|
auth => $auth_result, |
63
|
|
|
|
|
|
|
iter => undef, |
64
|
|
|
|
|
|
|
cache => { |
65
|
|
|
|
|
|
|
components => {}, # project_key => {name => RemoteComponent} |
66
|
|
|
|
|
|
|
versions => {}, # project_key => {name => RemoteVersion} |
67
|
|
|
|
|
|
|
}, |
68
|
|
|
|
|
|
|
}; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
return bless $self, $class; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# This empty DESTROY is necessary because we're using AUTOLOAD. |
74
|
|
|
|
|
|
|
# http://www.perlmonks.org/?node_id=93045 |
75
|
|
|
|
|
|
|
sub DESTROY { } |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# The issue "https://jira.atlassian.com/browse/JRA-12300" explains why |
78
|
|
|
|
|
|
|
# some fields in JIRA have nonintuitive names. Here we map them. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
my %JRA12300 = ( |
81
|
|
|
|
|
|
|
affectsVersions => 'versions', |
82
|
|
|
|
|
|
|
type => 'issuetype', |
83
|
|
|
|
|
|
|
); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
my %JRA12300_backwards = reverse %JRA12300; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# These are some helper functions to convert names into ids. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub _convert_type { |
90
|
|
|
|
|
|
|
my ($self, $type) = @_; |
91
|
|
|
|
|
|
|
if ($type =~ /\D/) { |
92
|
|
|
|
|
|
|
my $types = $self->get_issue_types(); |
93
|
|
|
|
|
|
|
return $types->{$type}{id} if exists $types->{$type}; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
$types = $self->get_subtask_issue_types(); |
96
|
|
|
|
|
|
|
return $types->{$type}{id} if exists $types->{$type}; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
croak "There is no issue type called '$type'.\n"; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
return $type; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
sub _convert_priority { |
104
|
|
|
|
|
|
|
my ($self, $prio) = @_; |
105
|
|
|
|
|
|
|
if ($prio =~ /\D/) { |
106
|
|
|
|
|
|
|
my $prios = $self->get_priorities(); |
107
|
|
|
|
|
|
|
croak "There is no priority called '$prio'.\n" |
108
|
|
|
|
|
|
|
unless exists $prios->{$prio}; |
109
|
|
|
|
|
|
|
return $prios->{$prio}{id}; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
return $prio; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub _convert_resolution { |
115
|
|
|
|
|
|
|
my ($self, $resolution) = @_; |
116
|
|
|
|
|
|
|
if ($resolution =~ /\D/) { |
117
|
|
|
|
|
|
|
my $resolutions = $self->get_resolutions(); |
118
|
|
|
|
|
|
|
croak "There is no resolution called '$resolution'.\n" |
119
|
|
|
|
|
|
|
unless exists $resolutions->{$resolution}; |
120
|
|
|
|
|
|
|
return $resolutions->{$resolution}{id}; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
return $resolution; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub _convert_security_level { |
126
|
|
|
|
|
|
|
my ($self, $seclevel, $project) = @_; |
127
|
|
|
|
|
|
|
if ($seclevel =~ /\D/) { |
128
|
|
|
|
|
|
|
my $seclevels = $self->get_security_levels($project); |
129
|
|
|
|
|
|
|
croak "There is no security level called '$seclevel'.\n" |
130
|
|
|
|
|
|
|
unless exists $seclevels->{$seclevel}; |
131
|
|
|
|
|
|
|
return $seclevels->{$seclevel}{id}; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
return $seclevel; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# This routine receives an array with a list of $components specified |
137
|
|
|
|
|
|
|
# by RemoteComponent objects, names, and ids. It returns an array of |
138
|
|
|
|
|
|
|
# RemoteComponent objects. |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub _convert_components { |
141
|
|
|
|
|
|
|
my ($self, $components, $project) = @_; |
142
|
|
|
|
|
|
|
is_array_ref($components) or croak "The 'components' value must be an ARRAY ref.\n"; |
143
|
|
|
|
|
|
|
my @converted; |
144
|
|
|
|
|
|
|
my $pcomponents; # project components |
145
|
|
|
|
|
|
|
foreach my $component (@{$components}) { |
146
|
|
|
|
|
|
|
if (is_instance($component => 'RemoteComponent')) { |
147
|
|
|
|
|
|
|
push @converted, $component; |
148
|
|
|
|
|
|
|
} elsif (is_integer($component)) { |
149
|
|
|
|
|
|
|
push @converted, RemoteComponent->new($component); |
150
|
|
|
|
|
|
|
} else { |
151
|
|
|
|
|
|
|
# It's a component name. Let us convert it into its id. |
152
|
|
|
|
|
|
|
croak "Cannot convert component names because I don't know for which project.\n" |
153
|
|
|
|
|
|
|
unless $project; |
154
|
|
|
|
|
|
|
$pcomponents = $self->get_components($project) unless defined $pcomponents; |
155
|
|
|
|
|
|
|
croak "There is no component called '$component'.\n" |
156
|
|
|
|
|
|
|
unless exists $pcomponents->{$component}; |
157
|
|
|
|
|
|
|
push @converted, RemoteComponent->new($pcomponents->{$component}{id}); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
return \@converted; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# This routine receives an array with a list of $versions specified by |
164
|
|
|
|
|
|
|
# RemoteVersion objects, names, and ids. It returns an array of |
165
|
|
|
|
|
|
|
# RemoteVersion objects. |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub _convert_versions { |
168
|
|
|
|
|
|
|
my ($self, $versions, $project) = @_; |
169
|
|
|
|
|
|
|
is_array_ref($versions) or croak "The '$versions' value must be an ARRAY ref.\n"; |
170
|
|
|
|
|
|
|
my @converted; |
171
|
|
|
|
|
|
|
my $pversions; # project versions |
172
|
|
|
|
|
|
|
foreach my $version (@{$versions}) { |
173
|
|
|
|
|
|
|
if (is_instance($version => 'RemoteVersion')) { |
174
|
|
|
|
|
|
|
push @converted, $version; |
175
|
|
|
|
|
|
|
} elsif (is_integer($version)) { |
176
|
|
|
|
|
|
|
push @converted, RemoteVersion->new($version); |
177
|
|
|
|
|
|
|
} else { |
178
|
|
|
|
|
|
|
# It is a version name. Let us convert it into its id. |
179
|
|
|
|
|
|
|
croak "Cannot convert version names because I don't know for which project.\n" |
180
|
|
|
|
|
|
|
unless $project; |
181
|
|
|
|
|
|
|
$pversions = $self->get_versions($project) unless defined $pversions; |
182
|
|
|
|
|
|
|
croak "There is no version called '$version'.\n" |
183
|
|
|
|
|
|
|
unless exists $pversions->{$version}; |
184
|
|
|
|
|
|
|
push @converted, RemoteVersion->new($pversions->{$version}{id}); |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
return \@converted; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# This routine returns a duedate as a SOAP::Data object with type |
191
|
|
|
|
|
|
|
# 'date'. It can generate this from a DateTime object or from a string |
192
|
|
|
|
|
|
|
# in the format YYYY-MM-DD. |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub _convert_duedate { |
195
|
|
|
|
|
|
|
my ($self, $duedate) = @_; |
196
|
|
|
|
|
|
|
if (is_instance($duedate => 'DateTime')) { |
197
|
|
|
|
|
|
|
return SOAP::Data->type(date => $duedate->strftime('%F')); |
198
|
|
|
|
|
|
|
} elsif (is_string($duedate)) { |
199
|
|
|
|
|
|
|
if (my ($year, $month, $day) = ($duedate =~ /^(\d{4})-(\d{2})-(\d{2})/)) { |
200
|
|
|
|
|
|
|
$month >= 1 and $month <= 12 |
201
|
|
|
|
|
|
|
or croak "Invalid duedate ($duedate).\n"; |
202
|
|
|
|
|
|
|
return SOAP::Data->type(date => $duedate); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
return $duedate; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# This routine receives a hash mapping custom field's ids to |
209
|
|
|
|
|
|
|
# values. The ids can be specified by their real id or by their id's |
210
|
|
|
|
|
|
|
# numeric suffix (as the 1000 in 'customfield_1000'). Scalar values |
211
|
|
|
|
|
|
|
# are substituted by references to arrays containing the original |
212
|
|
|
|
|
|
|
# value. The routine returns a hash-ref to another hash with converted |
213
|
|
|
|
|
|
|
# keys and values. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
sub _convert_custom_fields { |
216
|
|
|
|
|
|
|
my ($self, $custom_fields) = @_; |
217
|
|
|
|
|
|
|
is_hash_ref($custom_fields) or croak "The 'custom_fields' value must be a HASH ref.\n"; |
218
|
|
|
|
|
|
|
my %converted; |
219
|
|
|
|
|
|
|
while (my ($id, $values) = each %$custom_fields) { |
220
|
|
|
|
|
|
|
my $realid = $id; |
221
|
|
|
|
|
|
|
unless ($realid =~ /^customfield_\d+$/) { |
222
|
|
|
|
|
|
|
my $cfs = $self->get_custom_fields(); |
223
|
|
|
|
|
|
|
croak "Can't find custom field named '$id'.\n" |
224
|
|
|
|
|
|
|
unless exists $cfs->{$id}; |
225
|
|
|
|
|
|
|
$realid = $cfs->{$id}{id}; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# Custom field values must be specified as ARRAYs but we allow for some short-cuts. |
229
|
|
|
|
|
|
|
if (is_value($values)) { |
230
|
|
|
|
|
|
|
$converted{$realid} = [$values]; |
231
|
|
|
|
|
|
|
} elsif (is_array_ref($values)) { |
232
|
|
|
|
|
|
|
$converted{$realid} = $values; |
233
|
|
|
|
|
|
|
} elsif (is_hash_ref($values)) { |
234
|
|
|
|
|
|
|
# This is a short-cut for a Cascading select field, which |
235
|
|
|
|
|
|
|
# must be specified like this: http://tinyurl.com/2bmthoa |
236
|
|
|
|
|
|
|
# The short-cut requires a HASH where each cascading level |
237
|
|
|
|
|
|
|
# is indexed by its level number, starting at zero. |
238
|
|
|
|
|
|
|
foreach my $level (sort {$a <=> $b} keys %$values) { |
239
|
|
|
|
|
|
|
my $level_values = $values->{$level}; |
240
|
|
|
|
|
|
|
$level_values = [$level_values] unless ref $level_values; |
241
|
|
|
|
|
|
|
if ($level eq '0') { |
242
|
|
|
|
|
|
|
# The first level doesn't have a colon |
243
|
|
|
|
|
|
|
$converted{$realid} = $level_values |
244
|
|
|
|
|
|
|
} elsif ($level =~ /^\d+$/) { |
245
|
|
|
|
|
|
|
$converted{"$realid:$level"} = $level_values; |
246
|
|
|
|
|
|
|
} else { |
247
|
|
|
|
|
|
|
croak "Invalid cascading field values level spec ($level). It must be a natural number.\n"; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} else { |
251
|
|
|
|
|
|
|
croak "Custom field '$id' got a '", ref($values), "' reference as a value.\nValues can only be specified as scalars, ARRAYs, or HASHes though.\n"; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
return \%converted; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
my %_converters = ( |
258
|
|
|
|
|
|
|
affectsVersions => \&_convert_versions, |
259
|
|
|
|
|
|
|
components => \&_convert_components, |
260
|
|
|
|
|
|
|
custom_fields => \&_convert_custom_fields, |
261
|
|
|
|
|
|
|
duedate => \&_convert_duedate, |
262
|
|
|
|
|
|
|
fixVersions => \&_convert_versions, |
263
|
|
|
|
|
|
|
priority => \&_convert_priority, |
264
|
|
|
|
|
|
|
resolution => \&_convert_resolution, |
265
|
|
|
|
|
|
|
type => \&_convert_type, |
266
|
|
|
|
|
|
|
); |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# Accept both names for fields with duplicate names. |
269
|
|
|
|
|
|
|
foreach my $field (keys %JRA12300) { |
270
|
|
|
|
|
|
|
$_converters{$JRA12300{$field}} = $_converters{$field}; |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# This routine applies all the previous conversions to the $params |
274
|
|
|
|
|
|
|
# hash. It returns a reference another hash with converted keys and |
275
|
|
|
|
|
|
|
# values, which is the base for invoking the methods createIssue, |
276
|
|
|
|
|
|
|
# UpdateIssue, and progressWorkflowAction. |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
sub _convert_params { |
279
|
|
|
|
|
|
|
my ($self, $params, $project) = @_; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
my %converted; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# Convert fields' values |
284
|
|
|
|
|
|
|
while (my ($field, $value) = each %$params) { |
285
|
|
|
|
|
|
|
$converted{$field} = |
286
|
|
|
|
|
|
|
exists $_converters{$field} |
287
|
|
|
|
|
|
|
? $_converters{$field}->($self, $value, $project) |
288
|
|
|
|
|
|
|
: $value; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
return \%converted; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# This routine gets a hash produced by _convert_params and flatens in |
295
|
|
|
|
|
|
|
# place its Component, Version, and custom_fields fields. It also |
296
|
|
|
|
|
|
|
# converts the hash's key according with the %JRA12300 table. It goes |
297
|
|
|
|
|
|
|
# a step further before invoking the methods UpdateIssue and |
298
|
|
|
|
|
|
|
# progressWorkflowAction. |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
sub _flaten_components_and_versions { |
301
|
|
|
|
|
|
|
my ($params) = @_; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# Flaten Component and Version fields |
304
|
|
|
|
|
|
|
for my $field (grep {exists $params->{$_}} qw/components affectsVersions fixVersions/) { |
305
|
|
|
|
|
|
|
$params->{$field} = [map {$_->{id}} @{$params->{$field}}]; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
# Flaten the customFieldValues field |
309
|
|
|
|
|
|
|
if (my $custom_fields = delete $params->{custom_fields}) { |
310
|
|
|
|
|
|
|
while (my ($id, $values) = each %$custom_fields) { |
311
|
|
|
|
|
|
|
$params->{$id} = $values; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# Due to a bug in JIRA we have to substitute the names of some fields. |
316
|
|
|
|
|
|
|
foreach my $field (grep {exists $params->{$_}} keys %JRA12300) { |
317
|
|
|
|
|
|
|
$params->{$JRA12300{$field}} = delete $params->{$field}; |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
return; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
sub create_issue |
325
|
|
|
|
|
|
|
{ |
326
|
|
|
|
|
|
|
my ($self, $params, $seclevel) = @_; |
327
|
|
|
|
|
|
|
is_hash_ref($params) or croak "create_issue's requires a HASH-ref argument.\n"; |
328
|
|
|
|
|
|
|
for my $field (qw/project summary type/) { |
329
|
|
|
|
|
|
|
croak "create_issue's HASH ref must define a '$field'.\n" |
330
|
|
|
|
|
|
|
unless exists $params->{$field}; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
$params = $self->_convert_params($params, $params->{project}); |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
# Substitute customFieldValues array for custom_fields hash |
336
|
|
|
|
|
|
|
if (my $cfs = delete $params->{custom_fields}) { |
337
|
|
|
|
|
|
|
$params->{customFieldValues} = [map {RemoteCustomFieldValue->new($_, $cfs->{$_})} keys %$cfs]; |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
if (my $parent = delete $params->{parent}) { |
341
|
|
|
|
|
|
|
if (defined $seclevel) { |
342
|
|
|
|
|
|
|
return $self->createIssueWithParentWithSecurityLevel($params, $parent, _convert_security_level($self, $seclevel, $params->{project})); |
343
|
|
|
|
|
|
|
} else { |
344
|
|
|
|
|
|
|
return $self->createIssueWithParent($params, $parent); |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
} else { |
347
|
|
|
|
|
|
|
if (defined $seclevel) { |
348
|
|
|
|
|
|
|
return $self->createIssueWithSecurityLevel($params, _convert_security_level($self, $seclevel, $params->{project})); |
349
|
|
|
|
|
|
|
} else { |
350
|
|
|
|
|
|
|
return $self->createIssue($params); |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
sub update_issue |
357
|
|
|
|
|
|
|
{ |
358
|
|
|
|
|
|
|
my ($self, $issue, $params) = @_; |
359
|
|
|
|
|
|
|
my $key; |
360
|
|
|
|
|
|
|
if (is_instance($issue => 'RemoteIssue')) { |
361
|
|
|
|
|
|
|
$key = $issue->{key}; |
362
|
|
|
|
|
|
|
} else { |
363
|
|
|
|
|
|
|
$key = $issue; |
364
|
|
|
|
|
|
|
$issue = $self->getIssue($key); |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
is_hash_ref($params) or croak "update_issue second argument must be a HASH ref.\n"; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
my ($project) = ($key =~ /^([^-]+)/); |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
$params = $self->_convert_params($params, $project); |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
_flaten_components_and_versions($params); |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
return $self->updateIssue($key, $params); |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
sub get_issue_types { |
380
|
|
|
|
|
|
|
my ($self) = @_; |
381
|
|
|
|
|
|
|
$self->{cache}{issue_types} ||= {map {$_->{name} => $_} @{$self->getIssueTypes()}}; |
382
|
|
|
|
|
|
|
return $self->{cache}{issue_types}; |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub get_subtask_issue_types { |
387
|
|
|
|
|
|
|
my ($self) = @_; |
388
|
|
|
|
|
|
|
$self->{cache}{subtask_issue_types} ||= {map {$_->{name} => $_} @{$self->getSubTaskIssueTypes()}}; |
389
|
|
|
|
|
|
|
return $self->{cache}{subtask_issue_types}; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub get_statuses { |
394
|
|
|
|
|
|
|
my ($self) = @_; |
395
|
|
|
|
|
|
|
$self->{cache}{statuses} ||= {map {$_->{name} => $_} @{$self->getStatuses()}}; |
396
|
|
|
|
|
|
|
return $self->{cache}{statuses}; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
sub get_priorities { |
401
|
|
|
|
|
|
|
my ($self) = @_; |
402
|
|
|
|
|
|
|
$self->{cache}{priorities} ||= {map {$_->{name} => $_} @{$self->getPriorities()}}; |
403
|
|
|
|
|
|
|
return $self->{cache}{priorities}; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub get_resolutions { |
408
|
|
|
|
|
|
|
my ($self) = @_; |
409
|
|
|
|
|
|
|
$self->{cache}{resolutions} ||= {map {$_->{name} => $_} @{$self->getResolutions()}}; |
410
|
|
|
|
|
|
|
return $self->{cache}{resolutions}; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
sub get_security_levels { |
415
|
|
|
|
|
|
|
my ($self, $project_key) = @_; |
416
|
|
|
|
|
|
|
$self->{cache}{seclevels}{$project_key} ||= {map {$_->{name} => $_} @{$self->getSecurityLevels($project_key)}}; |
417
|
|
|
|
|
|
|
return $self->{cache}{seclevels}{$project_key}; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub get_custom_fields { |
422
|
|
|
|
|
|
|
my ($self) = @_; |
423
|
|
|
|
|
|
|
$self->{cache}{custom_fields} ||= {map {$_->{name} => $_} @{$self->getCustomFields()}}; |
424
|
|
|
|
|
|
|
return $self->{cache}{custom_fields}; |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub set_custom_fields { |
429
|
|
|
|
|
|
|
my ($self, $cfs) = @_; |
430
|
|
|
|
|
|
|
$self->{cache}{custom_fields} = $cfs; |
431
|
|
|
|
|
|
|
return; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub get_components { |
436
|
|
|
|
|
|
|
my ($self, $project_key) = @_; |
437
|
|
|
|
|
|
|
$self->{cache}{components}{$project_key} ||= {map {$_->{name} => $_} @{$self->getComponents($project_key)}}; |
438
|
|
|
|
|
|
|
return $self->{cache}{components}{$project_key}; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
sub get_versions { |
443
|
|
|
|
|
|
|
my ($self, $project_key) = @_; |
444
|
|
|
|
|
|
|
$self->{cache}{versions}{$project_key} ||= {map {$_->{name} => $_} @{$self->getVersions($project_key)}}; |
445
|
|
|
|
|
|
|
return $self->{cache}{versions}{$project_key}; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
sub get_favourite_filters { |
450
|
|
|
|
|
|
|
my ($self) = @_; |
451
|
|
|
|
|
|
|
$self->{cache}{filters} ||= {map {$_->{name} => $_} @{$self->getFavouriteFilters()}}; |
452
|
|
|
|
|
|
|
return $self->{cache}{filters}; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
sub set_filter_iterator { |
457
|
|
|
|
|
|
|
my ($self, $filter, $cache_size) = @_; |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
if ($filter =~ /\D/) { |
460
|
|
|
|
|
|
|
my $filters = $self->getSavedFilters(); |
461
|
|
|
|
|
|
|
foreach my $f (@$filters) { |
462
|
|
|
|
|
|
|
if ($f->{name} eq $filter) { |
463
|
|
|
|
|
|
|
$filter = $f->{id}; |
464
|
|
|
|
|
|
|
last; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
croak "Can't find filter '$filter'\n" if $filter =~ /\D/; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
if ($cache_size) { |
471
|
|
|
|
|
|
|
croak "set_filter_iterator's second arg must be a number ($cache_size).\n" |
472
|
|
|
|
|
|
|
if $cache_size =~ /\D/; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
$self->{iter} = { |
476
|
|
|
|
|
|
|
id => $filter, |
477
|
|
|
|
|
|
|
offset => 0, # offset to be used in the next call to getIssuesFromFilterWithLimit |
478
|
|
|
|
|
|
|
issues => [], # issues returned by the last call to getIssuesFromFilterWithLimit |
479
|
|
|
|
|
|
|
size => $cache_size || 128, |
480
|
|
|
|
|
|
|
}; |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
return; |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
sub next_issue { |
487
|
|
|
|
|
|
|
my ($self) = @_; |
488
|
|
|
|
|
|
|
defined $self->{iter} |
489
|
|
|
|
|
|
|
or croak "You must call setFilterIterator before calling nextIssue\n"; |
490
|
|
|
|
|
|
|
my $iter = $self->{iter}; |
491
|
|
|
|
|
|
|
if (@{$iter->{issues}} == 0) { |
492
|
|
|
|
|
|
|
if ($iter->{id}) { |
493
|
|
|
|
|
|
|
my $issues = eval {$self->getIssuesFromFilterWithLimit($iter->{id}, $iter->{offset}, $iter->{size})}; |
494
|
|
|
|
|
|
|
if ($@) { |
495
|
|
|
|
|
|
|
# The getIssuesFromFilterWithLimit appeared in JIRA |
496
|
|
|
|
|
|
|
# 3.13.4. Before that we had to use the unsafe |
497
|
|
|
|
|
|
|
# getIssuesFromFilter. Here we detect that we're talking |
498
|
|
|
|
|
|
|
# with an old JIRA and resort to the deprecated method |
499
|
|
|
|
|
|
|
# instead. |
500
|
|
|
|
|
|
|
croak $@ unless $@ =~ /No such operation/; |
501
|
|
|
|
|
|
|
$iter->{issues} = $self->getIssuesFromFilter($iter->{id}); |
502
|
|
|
|
|
|
|
$iter->{id} = undef; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
elsif (@$issues) { |
505
|
|
|
|
|
|
|
$iter->{offset} += @$issues; |
506
|
|
|
|
|
|
|
$iter->{issues} = $issues; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
else { |
509
|
|
|
|
|
|
|
$self->{iter} = undef; |
510
|
|
|
|
|
|
|
return; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
else { |
514
|
|
|
|
|
|
|
return; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
return shift @{$iter->{issues}}; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
sub progress_workflow_action_safely { |
522
|
|
|
|
|
|
|
my ($self, $issue, $action, $params) = @_; |
523
|
|
|
|
|
|
|
my $key; |
524
|
|
|
|
|
|
|
if (is_instance($issue => 'RemoteIssue')) { |
525
|
|
|
|
|
|
|
$key = $issue->{key}; |
526
|
|
|
|
|
|
|
} else { |
527
|
|
|
|
|
|
|
$key = $issue; |
528
|
|
|
|
|
|
|
$issue = undef; |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
$params = {} unless defined $params; |
531
|
|
|
|
|
|
|
is_hash_ref($params) or croak "progress_workflow_action_safely's third arg must be a HASH-ref\n"; |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
# Grok the action id if it's not a number |
534
|
|
|
|
|
|
|
if ($action =~ /\D/) { |
535
|
|
|
|
|
|
|
my @available_actions = @{$self->getAvailableActions($key)}; |
536
|
|
|
|
|
|
|
my @named_actions = grep {$action eq $_->{name}} @available_actions; |
537
|
|
|
|
|
|
|
if (@named_actions) { |
538
|
|
|
|
|
|
|
$action = $named_actions[0]->{id}; |
539
|
|
|
|
|
|
|
} else { |
540
|
|
|
|
|
|
|
croak "Unavailable action ($action).\n"; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
# Make sure $params contains all the fields that are present in |
545
|
|
|
|
|
|
|
# the action screen. |
546
|
|
|
|
|
|
|
my @fields = @{$self->getFieldsForAction($key, $action)}; |
547
|
|
|
|
|
|
|
foreach my $id (map {$_->{id}} @fields) { |
548
|
|
|
|
|
|
|
# Due to a bug in JIRA we have to substitute the names of some fields. |
549
|
|
|
|
|
|
|
$id = $JRA12300_backwards{$id} if $JRA12300_backwards{$id}; |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
next if exists $params->{$id}; |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
$issue = $self->getIssue($key) unless defined $issue; |
554
|
|
|
|
|
|
|
if (exists $issue->{$id}) { |
555
|
|
|
|
|
|
|
$params->{$id} = $issue->{$id} if defined $issue->{$id}; |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
# NOTE: It's not a problem if we can't find a missing |
558
|
|
|
|
|
|
|
# parameter in the issue. It will simply stay undefined. |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
my ($project) = ($key =~ /^([^-]+)/); |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
$params = $self->_convert_params($params, $project); |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
_flaten_components_and_versions($params); |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
return $self->progressWorkflowAction($key, $action, $params); |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
sub get_issue_custom_field_values { |
572
|
|
|
|
|
|
|
my ($self, $issue, @cfs) = @_; |
573
|
|
|
|
|
|
|
my @values; |
574
|
|
|
|
|
|
|
my $cfs; |
575
|
|
|
|
|
|
|
CUSTOM_FIELD: |
576
|
|
|
|
|
|
|
foreach my $cf (@cfs) { |
577
|
|
|
|
|
|
|
unless ($cf =~ /^customfield_\d+$/) { |
578
|
|
|
|
|
|
|
$cfs = $self->get_custom_fields() unless defined $cfs; |
579
|
|
|
|
|
|
|
croak "Can't find custom field named '$cf'.\n" |
580
|
|
|
|
|
|
|
unless exists $cfs->{$cf}; |
581
|
|
|
|
|
|
|
$cf = $cfs->{$cf}{id}; |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
foreach my $rcfv (@{$issue->{customFieldValues}}) { |
584
|
|
|
|
|
|
|
if ($rcfv->{customfieldId} eq $cf) { |
585
|
|
|
|
|
|
|
push @values, $rcfv->{values}; |
586
|
|
|
|
|
|
|
next CUSTOM_FIELD; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
push @values, undef; # unset custom field |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
return wantarray ? @values : \@values; |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
sub attach_files_to_issue { |
596
|
|
|
|
|
|
|
my ($self, $issue, @files) = @_; |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
# First we process the @files specification. Filenames are pushed |
599
|
|
|
|
|
|
|
# in @filenames and @attachments will end up with IO objects from |
600
|
|
|
|
|
|
|
# which the file contents are going to be read later. |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
my (@filenames, @attachments); |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
for my $file (@files) { |
605
|
|
|
|
|
|
|
if (is_string($file)) { |
606
|
|
|
|
|
|
|
require File::Basename; |
607
|
|
|
|
|
|
|
push @filenames, File::Basename::basename($file); |
608
|
|
|
|
|
|
|
open my $fh, '<:raw', $file |
609
|
|
|
|
|
|
|
or croak "Can't open $file: $!\n"; |
610
|
|
|
|
|
|
|
push @attachments, $fh; |
611
|
|
|
|
|
|
|
close $fh; |
612
|
|
|
|
|
|
|
} elsif (is_hash_ref($file)) { |
613
|
|
|
|
|
|
|
while (my ($name, $contents) = each %$file) { |
614
|
|
|
|
|
|
|
push @filenames, $name; |
615
|
|
|
|
|
|
|
if (is_string($contents)) { |
616
|
|
|
|
|
|
|
open my $fh, '<:raw', $contents |
617
|
|
|
|
|
|
|
or croak "Can't open $contents: $!\n"; |
618
|
|
|
|
|
|
|
push @attachments, $fh; |
619
|
|
|
|
|
|
|
close $fh; |
620
|
|
|
|
|
|
|
} elsif (is_glob_ref($contents) |
621
|
|
|
|
|
|
|
|| is_instance($contents => 'IO::File') |
622
|
|
|
|
|
|
|
|| is_instance($contents => 'FileHandle')) { |
623
|
|
|
|
|
|
|
push @attachments, $contents; |
624
|
|
|
|
|
|
|
} else { |
625
|
|
|
|
|
|
|
croak "Invalid content specification for file $name.\n"; |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
} else { |
629
|
|
|
|
|
|
|
croak "Files must be specified by STRINGs or HASHes, not by " . ref($file) . "s\n"; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
# Now we have to read all file contents and encode them to Base64. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
require MIME::Base64; |
636
|
|
|
|
|
|
|
for my $i (0 .. $#attachments) { |
637
|
|
|
|
|
|
|
my $fh = $attachments[$i]; |
638
|
|
|
|
|
|
|
my $attachment = ''; |
639
|
|
|
|
|
|
|
my $chars_read; |
640
|
|
|
|
|
|
|
while ($chars_read = read $fh, my $buf, 57*72) { |
641
|
|
|
|
|
|
|
$attachment .= MIME::Base64::encode_base64($buf); |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
defined $chars_read |
644
|
|
|
|
|
|
|
or croak "Error reading '$filenames[$i]': $!\n"; |
645
|
|
|
|
|
|
|
length $attachment |
646
|
|
|
|
|
|
|
or croak "Can't attach empty file '$filenames[$i]'\n"; |
647
|
|
|
|
|
|
|
$attachments[$i] = $attachment; |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
return $self->addBase64EncodedAttachmentsToIssue($issue, \@filenames, \@attachments); |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
sub attach_strings_to_issue { |
655
|
|
|
|
|
|
|
my ($self, $issue, $hash) = @_; |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
require MIME::Base64; |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
my (@filenames, @attachments); |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
while (my ($filename, $contents) = each %$hash) { |
662
|
|
|
|
|
|
|
push @filenames, $filename; |
663
|
|
|
|
|
|
|
push @attachments, MIME::Base64::encode_base64($contents); |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
return $self->addBase64EncodedAttachmentsToIssue($issue, \@filenames, \@attachments); |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
sub filter_issues_unsorted { |
671
|
|
|
|
|
|
|
my ($self, $filter, $limit) = @_; |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
$filter =~ s/^\s*"?//; |
674
|
|
|
|
|
|
|
$filter =~ s/"?\s*$//; |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
if ($filter =~ /^(?:[A-Z]+-\d+\s+)*[A-Z]+-\d+$/i) { |
677
|
|
|
|
|
|
|
# space separated key list |
678
|
|
|
|
|
|
|
return map {$self->getIssue(uc $_)} split / /, $filter; |
679
|
|
|
|
|
|
|
} elsif ($filter =~ /^[\w-]+$/i) { |
680
|
|
|
|
|
|
|
# saved filter |
681
|
|
|
|
|
|
|
return @{$self->getIssuesFromFilterWithLimit($filter, 0, $limit || 1000)}; |
682
|
|
|
|
|
|
|
} else { |
683
|
|
|
|
|
|
|
# JQL filter |
684
|
|
|
|
|
|
|
return @{$self->getIssuesFromJqlSearch($filter, $limit || 1000)}; |
685
|
|
|
|
|
|
|
} |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
sub filter_issues { |
690
|
|
|
|
|
|
|
my ($self, $filter, $limit) = @_; |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
# Order the issues by project key and then by numeric value using |
693
|
|
|
|
|
|
|
# a Schwartzian transform. |
694
|
|
|
|
|
|
|
return |
695
|
|
|
|
|
|
|
map {$_->[2]} |
696
|
|
|
|
|
|
|
sort {$a->[0] cmp $b->[0] or $a->[1] <=> $b->[1]} |
697
|
|
|
|
|
|
|
map {my ($p, $n) = ($_->{key} =~ /([A-Z]+)-(\d+)/); [$p, $n, $_]} |
698
|
|
|
|
|
|
|
filter_issues_unsorted($self, $filter, $limit); |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
## no critic (Modules::ProhibitMultiplePackages) |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
package RemoteFieldValue; |
705
|
|
|
|
|
|
|
{ |
706
|
|
|
|
|
|
|
$RemoteFieldValue::VERSION = '0.42'; |
707
|
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
sub new { |
710
|
|
|
|
|
|
|
my ($class, $id, $values) = @_; |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
# Due to a bug in JIRA we have to substitute the names of some fields. |
713
|
|
|
|
|
|
|
$id = $JRA12300{$id} if exists $JRA12300{$id}; |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
$values = [$values] unless ref $values; |
716
|
|
|
|
|
|
|
return bless({id => $id, values => $values}, $class); |
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
package RemoteCustomFieldValue; |
721
|
|
|
|
|
|
|
{ |
722
|
|
|
|
|
|
|
$RemoteCustomFieldValue::VERSION = '0.42'; |
723
|
|
|
|
|
|
|
} |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
sub new { |
726
|
|
|
|
|
|
|
my ($class, $id, $values) = @_; |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
$values = [$values] unless ref $values; |
729
|
|
|
|
|
|
|
return bless({customfieldId => $id, key => undef, values => $values} => $class); |
730
|
|
|
|
|
|
|
} |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
package RemoteComponent; |
734
|
|
|
|
|
|
|
{ |
735
|
|
|
|
|
|
|
$RemoteComponent::VERSION = '0.42'; |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
sub new { |
739
|
|
|
|
|
|
|
my ($class, $id, $name) = @_; |
740
|
|
|
|
|
|
|
my $o = bless({id => $id}, $class); |
741
|
|
|
|
|
|
|
$o->{name} = $name if $name; |
742
|
|
|
|
|
|
|
return $o; |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
package RemoteVersion; |
747
|
|
|
|
|
|
|
{ |
748
|
|
|
|
|
|
|
$RemoteVersion::VERSION = '0.42'; |
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
sub new { |
752
|
|
|
|
|
|
|
my ($class, $id, $name) = @_; |
753
|
|
|
|
|
|
|
my $o = bless({id => $id}, $class); |
754
|
|
|
|
|
|
|
$o->{name} = $name if $name; |
755
|
|
|
|
|
|
|
return $o; |
756
|
|
|
|
|
|
|
} |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
package JIRA::Client; |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
# Almost all of the JIRA API parameters are strings. The %typeof hash |
761
|
|
|
|
|
|
|
# specifies the exceptions. It maps a method name to a hash mapping a |
762
|
|
|
|
|
|
|
# parameter position to its type. (The parameter position is |
763
|
|
|
|
|
|
|
# zero-based, after the authentication token. |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
my %typeof = ( |
766
|
|
|
|
|
|
|
addActorsToProjectRole => {1 => \&_cast_remote_project_role}, |
767
|
|
|
|
|
|
|
addAttachmentsToIssue => \&_cast_attachments, |
768
|
|
|
|
|
|
|
addBase64EncodedAttachmentsToIssue => \&_cast_base64encodedattachments, |
769
|
|
|
|
|
|
|
addComment => {0 => \&_cast_issue_key, 1 => \&_cast_remote_comment}, |
770
|
|
|
|
|
|
|
addDefaultActorsToProjectRole => {1 => \&_cast_remote_project_role}, |
771
|
|
|
|
|
|
|
# addPermissionTo |
772
|
|
|
|
|
|
|
# addUserToGroup |
773
|
|
|
|
|
|
|
# addVersion |
774
|
|
|
|
|
|
|
addWorklogAndAutoAdjustRemainingEstimate => {0 => \&_cast_issue_key}, |
775
|
|
|
|
|
|
|
addWorklogAndRetainRemainingEstimate => {0 => \&_cast_issue_key}, |
776
|
|
|
|
|
|
|
addWorklogWithNewRemainingEstimate => {0 => \&_cast_issue_key}, |
777
|
|
|
|
|
|
|
archiveVersion => {2 => 'boolean'}, |
778
|
|
|
|
|
|
|
# createGroup |
779
|
|
|
|
|
|
|
# createIssue |
780
|
|
|
|
|
|
|
createIssueWithParent => {1 => \&_cast_issue_key}, |
781
|
|
|
|
|
|
|
createIssueWithParentWithSecurityLevel => {1 => \&_cast_issue_key, 2 => 'long'}, |
782
|
|
|
|
|
|
|
createIssueWithSecurityLevel => {1 => 'long'}, |
783
|
|
|
|
|
|
|
# createPermissionScheme |
784
|
|
|
|
|
|
|
# createProject |
785
|
|
|
|
|
|
|
# createProjectFromObject |
786
|
|
|
|
|
|
|
createProjectRole => {0 => \&_cast_remote_project_role}, |
787
|
|
|
|
|
|
|
# createUser |
788
|
|
|
|
|
|
|
# deleteGroup |
789
|
|
|
|
|
|
|
deleteIssue => {0 => \&_cast_issue_key}, |
790
|
|
|
|
|
|
|
# deletePermissionFrom |
791
|
|
|
|
|
|
|
# deletePermissionScheme |
792
|
|
|
|
|
|
|
# deleteProject |
793
|
|
|
|
|
|
|
deleteProjectAvatar => {0 => 'long'}, |
794
|
|
|
|
|
|
|
deleteProjectRole => {0 => \&_cast_remote_project_role, 1 => 'boolean'}, |
795
|
|
|
|
|
|
|
# deleteUser |
796
|
|
|
|
|
|
|
# deleteWorklogAndAutoAdjustRemainingEstimate |
797
|
|
|
|
|
|
|
# deleteWorklogAndRetainRemainingEstimate |
798
|
|
|
|
|
|
|
# deleteWorklogWithNewRemainingEstimate |
799
|
|
|
|
|
|
|
# editComment |
800
|
|
|
|
|
|
|
# getAllPermissions |
801
|
|
|
|
|
|
|
getAssociatedNotificationSchemes => {0 => \&_cast_remote_project_role}, |
802
|
|
|
|
|
|
|
getAssociatedPermissionSchemes => {0 => \&_cast_remote_project_role}, |
803
|
|
|
|
|
|
|
getAttachmentsFromIssue => {0 => \&_cast_issue_key}, |
804
|
|
|
|
|
|
|
getAvailableActions => {0 => \&_cast_issue_key}, |
805
|
|
|
|
|
|
|
getComment => {0 => 'long'}, |
806
|
|
|
|
|
|
|
getComments => {0 => \&_cast_issue_key}, |
807
|
|
|
|
|
|
|
# getComponents |
808
|
|
|
|
|
|
|
# getConfiguration |
809
|
|
|
|
|
|
|
# getCustomFields |
810
|
|
|
|
|
|
|
getDefaultRoleActors => {0 => \&_cast_remote_project_role}, |
811
|
|
|
|
|
|
|
# getFavouriteFilters |
812
|
|
|
|
|
|
|
getFieldsForAction => {0 => \&_cast_issue_key}, |
813
|
|
|
|
|
|
|
getFieldsForCreate => {1 => 'long'}, |
814
|
|
|
|
|
|
|
getFieldsForEdit => {0 => \&_cast_issue_key}, |
815
|
|
|
|
|
|
|
# getGroup |
816
|
|
|
|
|
|
|
getIssue => {0 => \&_cast_issue_key}, |
817
|
|
|
|
|
|
|
# getIssueById |
818
|
|
|
|
|
|
|
getIssueCountForFilter => {0 => \&_cast_filter_name_to_id}, |
819
|
|
|
|
|
|
|
getIssuesFromFilter => {0 => \&_cast_filter_name_to_id}, |
820
|
|
|
|
|
|
|
getIssuesFromFilterWithLimit => {0 => \&_cast_filter_name_to_id, 1 => 'int', 2 => 'int'}, |
821
|
|
|
|
|
|
|
getIssuesFromJqlSearch => {1 => 'int'}, |
822
|
|
|
|
|
|
|
# getIssuesFromTextSearch |
823
|
|
|
|
|
|
|
getIssuesFromTextSearchWithLimit => {1 => 'int', 2 => 'int'}, |
824
|
|
|
|
|
|
|
getIssuesFromTextSearchWithProject => {2 => 'int'}, |
825
|
|
|
|
|
|
|
# getIssueTypes |
826
|
|
|
|
|
|
|
# getIssueTypesForProject |
827
|
|
|
|
|
|
|
# getNotificationSchemes |
828
|
|
|
|
|
|
|
# getPermissionSchemes |
829
|
|
|
|
|
|
|
# getPriorities |
830
|
|
|
|
|
|
|
# getProjectAvatar |
831
|
|
|
|
|
|
|
getProjectAvatars => {1 => 'boolean'}, |
832
|
|
|
|
|
|
|
getProjectById => {0 => 'long'}, |
833
|
|
|
|
|
|
|
# getProjectByKey |
834
|
|
|
|
|
|
|
getProjectRole => {0 => 'long'}, |
835
|
|
|
|
|
|
|
getProjectRoleActors => {0 => \&_cast_remote_project_role}, |
836
|
|
|
|
|
|
|
# getProjectRoles |
837
|
|
|
|
|
|
|
# getProjectsNoSchemes |
838
|
|
|
|
|
|
|
getProjectWithSchemesById => {0 => 'long'}, |
839
|
|
|
|
|
|
|
getResolutionDateById => {0 => 'long'}, |
840
|
|
|
|
|
|
|
getResolutionDateByKey => {0 => \&_cast_issue_key}, |
841
|
|
|
|
|
|
|
# getResolutions |
842
|
|
|
|
|
|
|
# getSavedFilters |
843
|
|
|
|
|
|
|
getSecurityLevel => {0 => \&_cast_issue_key}, |
844
|
|
|
|
|
|
|
# getSecurityLevels |
845
|
|
|
|
|
|
|
# getSecuritySchemes |
846
|
|
|
|
|
|
|
# getServerInfo |
847
|
|
|
|
|
|
|
# getStatuses |
848
|
|
|
|
|
|
|
# getSubTaskIssueTypes |
849
|
|
|
|
|
|
|
# getSubTaskIssueTypesForProject |
850
|
|
|
|
|
|
|
# getUser |
851
|
|
|
|
|
|
|
# getVersions |
852
|
|
|
|
|
|
|
getWorklogs => {0 => \&_cast_issue_key}, |
853
|
|
|
|
|
|
|
hasPermissionToCreateWorklog => {0 => \&_cast_issue_key}, |
854
|
|
|
|
|
|
|
# hasPermissionToDeleteWorklog |
855
|
|
|
|
|
|
|
# hasPermissionToEditComment |
856
|
|
|
|
|
|
|
# hasPermissionToUpdateWorklog |
857
|
|
|
|
|
|
|
# isProjectRoleNameUnique |
858
|
|
|
|
|
|
|
# login ##NOT USED## |
859
|
|
|
|
|
|
|
# logout ##NOT USED## |
860
|
|
|
|
|
|
|
progressWorkflowAction => {0 => \&_cast_issue_key, 2 => \&_cast_remote_field_values}, |
861
|
|
|
|
|
|
|
# refreshCustomFields |
862
|
|
|
|
|
|
|
# releaseVersion |
863
|
|
|
|
|
|
|
removeActorsFromProjectRole => {1 => \&_cast_remote_project_role}, |
864
|
|
|
|
|
|
|
# removeAllRoleActorsByNameAndType |
865
|
|
|
|
|
|
|
# removeAllRoleActorsByProject |
866
|
|
|
|
|
|
|
removeDefaultActorsFromProjectRole => {1 => \&_cast_remote_project_role}, |
867
|
|
|
|
|
|
|
# removeUserFromGroup |
868
|
|
|
|
|
|
|
# setNewProjectAvatar |
869
|
|
|
|
|
|
|
setProjectAvatar => {1 => 'long'}, |
870
|
|
|
|
|
|
|
# setUserPassword |
871
|
|
|
|
|
|
|
# updateGroup |
872
|
|
|
|
|
|
|
updateIssue => {0 => \&_cast_issue_key, 1 => \&_cast_remote_field_values}, |
873
|
|
|
|
|
|
|
# updateProject |
874
|
|
|
|
|
|
|
updateProjectRole => {0 => \&_cast_remote_project_role}, |
875
|
|
|
|
|
|
|
# updateUser |
876
|
|
|
|
|
|
|
# updateWorklogAndAutoAdjustRemainingEstimate |
877
|
|
|
|
|
|
|
# updateWorklogAndRetainRemainingEstimate |
878
|
|
|
|
|
|
|
# updateWorklogWithNewRemainingEstimate |
879
|
|
|
|
|
|
|
); |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
sub _cast_issue_key { |
882
|
|
|
|
|
|
|
my ($self, $issue) = @_; |
883
|
|
|
|
|
|
|
return ref $issue ? $issue->{key} : $issue; |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
sub _cast_remote_comment { |
887
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
888
|
|
|
|
|
|
|
return ref $arg ? $arg : bless({body => $arg} => 'RemoteComment'); |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
sub _cast_filter_name_to_id { |
892
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
893
|
|
|
|
|
|
|
is_string($arg) or croak "Filter arg must be a string.\n"; |
894
|
|
|
|
|
|
|
return $arg unless $arg =~ /\D/; |
895
|
|
|
|
|
|
|
my $filters = $self->get_favourite_filters(); |
896
|
|
|
|
|
|
|
exists $filters->{$arg} or croak "Unknown filter: $arg\n"; |
897
|
|
|
|
|
|
|
return $filters->{$arg}{id}; |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
sub _cast_remote_field_values { |
901
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
902
|
|
|
|
|
|
|
return is_hash_ref($arg) ? [map {RemoteFieldValue->new($_, $arg->{$_})} keys %$arg] : $arg; |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
sub _cast_remote_project_role { |
906
|
|
|
|
|
|
|
my ($self, $arg) = @_; |
907
|
|
|
|
|
|
|
if (is_instance($arg => 'RemoteProjectRole') && exists $arg->{id} && is_string($arg->{id})) { |
908
|
|
|
|
|
|
|
$arg->{id} = SOAP::Data->type(long => $arg->{id}); |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
return $arg; |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
sub _cast_attachments { |
914
|
|
|
|
|
|
|
my ($self, $method, $args) = @_; |
915
|
|
|
|
|
|
|
# The addAttachmentsToIssue method is deprecated and requires too |
916
|
|
|
|
|
|
|
# much overhead to pass the file contents over the wire. Here we |
917
|
|
|
|
|
|
|
# convert the arguments to call the newer |
918
|
|
|
|
|
|
|
# addBase64EncodedAttachmentsToIssue method instead. |
919
|
|
|
|
|
|
|
require MIME::Base64; |
920
|
|
|
|
|
|
|
for my $content (@{$args->[2]}) { |
921
|
|
|
|
|
|
|
$content = MIME::Base64::encode_base64($content); |
922
|
|
|
|
|
|
|
} |
923
|
|
|
|
|
|
|
$$method = 'addBase64EncodedAttachmentsToIssue'; |
924
|
|
|
|
|
|
|
_cast_base64encodedattachments($self, $method, $args); |
925
|
|
|
|
|
|
|
return; |
926
|
|
|
|
|
|
|
} |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
sub _cast_base64encodedattachments { |
929
|
|
|
|
|
|
|
my ($self, $method, $args) = @_; |
930
|
|
|
|
|
|
|
$args->[0] = _cast_issue_key($self, $args->[0]); |
931
|
|
|
|
|
|
|
# We have to set the names of the arrays and of its elements |
932
|
|
|
|
|
|
|
# because the default naming isn't properly understood by JIRA. |
933
|
|
|
|
|
|
|
for my $i (1 .. 2) { |
934
|
|
|
|
|
|
|
$args->[$i] = SOAP::Data->name( |
935
|
|
|
|
|
|
|
"array$i", |
936
|
|
|
|
|
|
|
[map {SOAP::Data->name("elem$i", $_)} @{$args->[$i]}], |
937
|
|
|
|
|
|
|
); |
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
return; |
940
|
|
|
|
|
|
|
} |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
# All methods follow the same call convention, which makes it easy to |
943
|
|
|
|
|
|
|
# implement them all with an AUTOLOAD. |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
our $AUTOLOAD; |
946
|
|
|
|
|
|
|
sub AUTOLOAD { |
947
|
|
|
|
|
|
|
my ($self, @args) = @_; |
948
|
|
|
|
|
|
|
(my $method = $AUTOLOAD) =~ s/.*:://; |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
# Perform any non-default type coersion |
951
|
|
|
|
|
|
|
if (my $typeof = $typeof{$method}) { |
952
|
|
|
|
|
|
|
if (is_hash_ref($typeof)) { |
953
|
|
|
|
|
|
|
while (my ($i, $type) = each %$typeof) { |
954
|
|
|
|
|
|
|
if (is_code_ref($type)) { |
955
|
|
|
|
|
|
|
$args[$i] = $type->($self, $args[$i]); |
956
|
|
|
|
|
|
|
} elsif (is_value($args[$i])) { |
957
|
|
|
|
|
|
|
$args[$i] = SOAP::Data->type($type => $args[$i]); |
958
|
|
|
|
|
|
|
} elsif (is_array_ref($args[$i])) { |
959
|
|
|
|
|
|
|
foreach (@{$args[$i]}) { |
960
|
|
|
|
|
|
|
$_ = SOAP::Data->type($type => $_); |
961
|
|
|
|
|
|
|
} |
962
|
|
|
|
|
|
|
} elsif (is_hash_ref($args[$i])) { |
963
|
|
|
|
|
|
|
foreach (values %{$args[$i]}) { |
964
|
|
|
|
|
|
|
$_ = SOAP::Data->type($type => $_); |
965
|
|
|
|
|
|
|
} |
966
|
|
|
|
|
|
|
} else { |
967
|
|
|
|
|
|
|
croak "Can't coerse argument $i of method $AUTOLOAD.\n"; |
968
|
|
|
|
|
|
|
} |
969
|
|
|
|
|
|
|
} |
970
|
|
|
|
|
|
|
} elsif (is_code_ref($typeof)) { |
971
|
|
|
|
|
|
|
$typeof->($self, \$method, \@args); |
972
|
|
|
|
|
|
|
} |
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
my $call = $self->{soap}->call($method, $self->{auth}, @args); |
976
|
|
|
|
|
|
|
croak $call->faultcode(), ', ', $call->faultstring() |
977
|
|
|
|
|
|
|
if defined $call->fault(); |
978
|
|
|
|
|
|
|
return $call->result(); |
979
|
|
|
|
|
|
|
} |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
1; # End of JIRA::Client |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
__END__ |