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