File Coverage

blib/lib/JIRA/Client.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


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__