r47580 - in /branches/upstream/libjira-client-perl/current: Changes MANIFEST META.yml README lib/JIRA/Client.pm t/00-load.t t/01-online.t t/perlcritic.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Nov 21 17:47:45 UTC 2009
Author: jawnsy-guest
Date: Sat Nov 21 17:47:40 2009
New Revision: 47580
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=47580
Log:
[svn-upgrade] Integrating new upstream version, libjira-client-perl (0.20)
Added:
branches/upstream/libjira-client-perl/current/t/perlcritic.t (with props)
Modified:
branches/upstream/libjira-client-perl/current/Changes
branches/upstream/libjira-client-perl/current/MANIFEST
branches/upstream/libjira-client-perl/current/META.yml
branches/upstream/libjira-client-perl/current/README
branches/upstream/libjira-client-perl/current/lib/JIRA/Client.pm
branches/upstream/libjira-client-perl/current/t/00-load.t
branches/upstream/libjira-client-perl/current/t/01-online.t
Modified: branches/upstream/libjira-client-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjira-client-perl/current/Changes?rev=47580&op=diff
==============================================================================
--- branches/upstream/libjira-client-perl/current/Changes (original)
+++ branches/upstream/libjira-client-perl/current/Changes Sat Nov 21 17:47:40 2009
@@ -1,9 +1,19 @@
Revision history for JIRA-Client
+
+0.20 2009-11-20
+
+ Converts the 'duedate' field from the ISO format (YYYY-MM-DD)
+ into the JIRA required format (d/MMM/yy) in create_issue and
+ progress_workflow_action_safely. This is necessary because
+ while JIRA requires the later, it gives the former in
+ getIssue. Thanks to Andrey Belous for alerting me about this.
+
+ Adds a perlcritic test and placates some of its criticisms.
0.19 2009-11-06
Updates the default conversions for the new JIRA 4.0 methods.
- Thanks to Mário Moreira for alerting me about this.
+ Thanks to Mário Moreira for alerting me about this.
0.18 2009-10-24
@@ -71,7 +81,7 @@
<jon AT figsandfudge DOT com>.
Makes it easier to call some methods by accepting simpler
- arguments using an idea from Bjørn-Olav Strand <BOLAV AT cpan
+ arguments using an idea from Bjørn-Olav Strand <BOLAV AT cpan
DOT org>.
Implements constructors for some helper objects.
Modified: branches/upstream/libjira-client-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjira-client-perl/current/MANIFEST?rev=47580&op=diff
==============================================================================
--- branches/upstream/libjira-client-perl/current/MANIFEST (original)
+++ branches/upstream/libjira-client-perl/current/MANIFEST Sat Nov 21 17:47:40 2009
@@ -7,6 +7,7 @@
t/00-load.t
t/01-online.t
t/kwalitee.t
+t/perlcritic.t
t/pod-coverage.t
t/pod.t
META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libjira-client-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjira-client-perl/current/META.yml?rev=47580&op=diff
==============================================================================
--- branches/upstream/libjira-client-perl/current/META.yml (original)
+++ branches/upstream/libjira-client-perl/current/META.yml Sat Nov 21 17:47:40 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: JIRA-Client
-version: 0.19
+version: 0.20
abstract: An extended interface to JIRA's SOAP API.
license: ~
author:
Modified: branches/upstream/libjira-client-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjira-client-perl/current/README?rev=47580&op=diff
==============================================================================
--- branches/upstream/libjira-client-perl/current/README (original)
+++ branches/upstream/libjira-client-perl/current/README Sat Nov 21 17:47:40 2009
@@ -1,6 +1,6 @@
Name: JIRA-Client
What: A OO interface to JIRA's SOAP API.
-Version: 0.19
+Version: 0.20
Author: Gustavo Chaves <gnustavo at cpan.org>
JIRA is a proprietary bug tracking system from Atlassian
Modified: branches/upstream/libjira-client-perl/current/lib/JIRA/Client.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjira-client-perl/current/lib/JIRA/Client.pm?rev=47580&op=diff
==============================================================================
--- branches/upstream/libjira-client-perl/current/lib/JIRA/Client.pm (original)
+++ branches/upstream/libjira-client-perl/current/lib/JIRA/Client.pm Sat Nov 21 17:47:40 2009
@@ -11,11 +11,11 @@
=head1 VERSION
-Version 0.19
-
-=cut
-
-our $VERSION = '0.19';
+Version 0.20
+
+=cut
+
+our $VERSION = '0.20';
=head1 SYNOPSIS
@@ -50,7 +50,7 @@
This module implements an Object Oriented wrapper around JIRA's SOAP
API, which is specified in
L<http://docs.atlassian.com/software/jira/docs/api/rpc-jira-plugin/latest/com/atlassian/jira/rpc/soap/JiraSoapService.html>.
-(This version was tested against JIRA 3.13.4.)
+(This version is known to work with JIRA 4 but it was tested by the author only against JIRA 3.13.4 so far.)
Moreover, it implements some other methods to make it easier to do
some common operations.
@@ -111,7 +111,7 @@
sub _fault_details {
my $r = shift;
- join(', ', $r->faultcode(), $r->faultstring());
+ return join(', ', $r->faultcode(), $r->faultstring());
}
sub new {
@@ -123,20 +123,20 @@
%{$soap->typelookup()} = (default => [0, sub {1}, 'as_string']);
my $auth = $soap->login($user, $pass);
- die _fault_details($auth), "\n"
- if defined $auth->fault();
+ croak _fault_details($auth), "\n"
+ if defined $auth->fault();
my $self = {
- soap => $soap,
- auth => scalar($auth->result()),
- iter => undef,
- cache => {
- components => {}, # project_key => {name => RemoteComponent}
- versions => {}, # project_key => {name => RemoteVersion}
- },
+ soap => $soap,
+ auth => scalar($auth->result()),
+ iter => undef,
+ cache => {
+ components => {}, # project_key => {name => RemoteComponent}
+ versions => {}, # project_key => {name => RemoteVersion}
+ },
};
- bless $self, $class;
+ return bless $self, $class;
}
sub DESTROY {
@@ -155,33 +155,36 @@
# These are some helper functions to convert names into ids.
sub _convert_type {
- my ($self, $type) = @_;
+ my ($self, $hash) = @_;
+ my $type = $hash->{type};
if ($type =~ /\D/) {
- my $types = $self->get_issue_types();
- croak "There is no issue type called '$type'.\n"
- unless exists $types->{$type};
- return $types->{$type}{id};
- }
- return $type;
+ my $types = $self->get_issue_types();
+ croak "There is no issue type called '$type'.\n"
+ unless exists $types->{$type};
+ $hash->{type} = $types->{$type}{id};
+ }
+ return;
}
sub _convert_priority {
- my ($self, $prio) = @_;
+ my ($self, $hash) = @_;
+ my $prio = $hash->{priority};
if ($prio =~ /\D/) {
- my $prios = $self->get_priorities();
- croak "There is no priority called '$prio'.\n"
- unless exists $prios->{$prio};
- return $prios->{$prio}{id};
- }
- return $prio;
+ my $prios = $self->get_priorities();
+ croak "There is no priority called '$prio'.\n"
+ unless exists $prios->{$prio};
+ $hash->{priority} = $prios->{$prio}{id};
+ }
+ return;
}
sub _convert_components {
- my ($self, $icomps, $project) = @_; # issue components, project key
+ my ($self, $hash, $key, $project) = @_;
+ my $comps = $hash->{components};
croak "The 'components' value must be an ARRAY ref.\n"
- unless ref $icomps && ref $icomps eq 'ARRAY';
- my $pcomps; # project components
- foreach my $c (@{$icomps}) {
+ unless ref $comps && ref $comps eq 'ARRAY';
+ my $pcomps; # project components
+ foreach my $c (@{$comps}) {
next if ref $c;
if ($c =~ /\D/) {
# It's a component name. Let us convert it into its id.
@@ -192,14 +195,16 @@
# Now we can convert it into an object.
$c = RemoteComponent->new($c);
}
+ return;
}
sub _convert_versions {
- my ($self, $iversions, $project) = @_; # issue versions, project key
- croak "The '$iversions' value must be a ARRAY ref.\n"
- unless ref $iversions && ref $iversions eq 'ARRAY';
+ my ($self, $hash, $key, $project) = @_;
+ my $versions = $hash->{$key};
+ croak "The '$versions' value must be a ARRAY ref.\n"
+ unless ref $versions && ref $versions eq 'ARRAY';
my $pversions;
- foreach my $v (@{$iversions}) {
+ foreach my $v (@{$versions}) {
next if ref $v;
if ($v =~ /\D/) {
# It is a version name. Let us convert it into its id.
@@ -210,24 +215,52 @@
# Now we can convert it into an object.
$v = RemoteVersion->new($v);
}
+ return;
+}
+
+sub _convert_duedate {
+ my ($self, $hash) = @_;
+ if (my ($year, $month, $day) = ($hash->{duedate} =~ /^(\d{4})-(\d{2})-(\d{2})/)) {
+ $month >= 1 and $month <= 12
+ or croak "Invalid duedate ($hash->{duedate})";
+ $hash->{duedate} = join(
+ '/',
+ $day,
+ qw/zero Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dez/[$month],
+ substr($year, 2, 2),
+ );
+ }
+ return;
}
sub _convert_custom_fields {
- my ($self, $custom_fields) = @_;
+ my ($self, $hash) = @_;
+ my $custom_fields = $hash->{custom_fields};
croak "The 'custom_fields' value must be a HASH ref.\n"
- unless ref $custom_fields && ref $custom_fields eq 'HASH';
+ unless ref $custom_fields && ref $custom_fields eq 'HASH';
my %id2values;
while (my ($id, $values) = each %$custom_fields) {
- unless ($id =~ /^customfield_\d+$/) {
- my $cfs = $self->get_custom_fields();
- croak "Can't find custom field named '$id'.\n"
- unless exists $cfs->{$id};
- $id = $cfs->{$id}{id};
- }
- $id2values{$id} = ref $values ? $values : [$values];
- }
- return \%id2values;
-}
+ unless ($id =~ /^customfield_\d+$/) {
+ my $cfs = $self->get_custom_fields();
+ croak "Can't find custom field named '$id'.\n"
+ unless exists $cfs->{$id};
+ $id = $cfs->{$id}{id};
+ }
+ $id2values{$id} = ref $values ? $values : [$values];
+ }
+ $hash->{custom_fields} = \%id2values;
+ return;
+}
+
+my %_converters = (
+ affectsVersions => \&_convert_versions,
+ components => \&_convert_components,
+ custom_fields => \&_convert_custom_fields,
+ duedate => \&_convert_duedate,
+ fixVersions => \&_convert_versions,
+ priority => \&_convert_priority,
+ type => \&_convert_type,
+);
=item B<create_issue> HASH_REF
@@ -251,6 +284,9 @@
=item C<affectsVersions> and C<fixVersions> can be specified by a list
of version I<names> or I<ids> instead of a list of C<RemoteVersion>
objects.
+
+=item C<duedate> can be specified in the ISO standard format
+(YYYY-MM-DD...) instead of the required format (d/MMM/yy).
=back
@@ -267,42 +303,25 @@
{
my ($self, $hash) = @_;
croak "create_issue requires an argument.\n"
- unless defined $hash;
+ unless defined $hash;
croak "create_issue's argument must be a HASH ref.\n"
- unless ref $hash && ref $hash eq 'HASH';
+ unless ref $hash && ref $hash eq 'HASH';
for my $field (qw/project summary type/) {
- croak "create_issue's HASH ref must define a '$field'.\n"
- unless exists $hash->{$field};
- }
-
- # Convert type names
- $hash->{type} = $self->_convert_type($hash->{type});
-
- # Convert priority names
- $hash->{priority} = $self->_convert_priority($hash->{priority})
- if exists $hash->{priority};
-
- # Convert component names
- $self->_convert_components($hash->{components}, $hash->{project})
- if exists $hash->{components};
-
- # Convert version ids and names into RemoteVersion objects
- for my $versions (qw/fixVersions affectsVersions/) {
- $self->_convert_versions($hash->{$versions}, $hash->{project})
- if exists $hash->{$versions};
- }
-
- # Convert custom fields
- if (my $custom_fields = delete $hash->{custom_fields}) {
- my @cfvs;
- my $id2values = $self->_convert_custom_fields($custom_fields);
- while (my ($id, $values) = each %$id2values) {
- push @cfvs, RemoteCustomFieldValue->new($id, $values);
- }
- $hash->{customFieldValues} = \@cfvs;
- }
-
- $self->createIssue($hash);
+ croak "create_issue's HASH ref must define a '$field'.\n"
+ unless exists $hash->{$field};
+ }
+
+ # Convert some fields' values
+ foreach my $field (grep {exists $_converters{$_}} keys %$hash) {
+ &{$_converters{$field}}($self, $hash, $field, $hash->{project});
+ }
+
+ # Substitute customFieldValues for custom_fields
+ if (my $cfs = delete $hash->{custom_fields}) {
+ $hash->{customFieldValues} = [map {RemoteCustomFieldValue->new($_, $cfs->{$_})} keys %$cfs];
+ }
+
+ return $self->createIssue($hash);
}
=item B<get_issue_types>
@@ -315,14 +334,14 @@
sub get_issue_types {
my ($self) = @_;
unless (defined $self->{cache}{issue_types}) {
- my %issue_types;
- my $types = $self->getIssueTypes();
- foreach my $type (@$types) {
- $issue_types{$type->{name}} = $type;
- }
- $self->{cache}{issue_types} = \%issue_types;
- }
- $self->{cache}{issue_types};
+ my %issue_types;
+ my $types = $self->getIssueTypes();
+ foreach my $type (@$types) {
+ $issue_types{$type->{name}} = $type;
+ }
+ $self->{cache}{issue_types} = \%issue_types;
+ }
+ return $self->{cache}{issue_types};
}
=item B<get_priorities>
@@ -335,14 +354,14 @@
sub get_priorities {
my ($self) = @_;
unless (exists $self->{cache}{priorities}) {
- my %priorities;
- my $prios = $self->getPriorities();
- foreach my $prio (@$prios) {
- $priorities{$prio->{name}} = $prio;
- }
- $self->{cache}{priorities} = \%priorities;
- }
- $self->{cache}{priorities};
+ my %priorities;
+ my $prios = $self->getPriorities();
+ foreach my $prio (@$prios) {
+ $priorities{$prio->{name}} = $prio;
+ }
+ $self->{cache}{priorities} = \%priorities;
+ }
+ return $self->{cache}{priorities};
}
=item B<get_custom_fields>
@@ -361,14 +380,14 @@
sub get_custom_fields {
my ($self) = @_;
unless (exists $self->{cache}{custom_fields}) {
- my %custom_fields;
- my $cfs = $self->getCustomFields();
- foreach my $cf (@$cfs) {
- $custom_fields{$cf->{name}} = $cf;
- }
- $self->{cache}{custom_fields} = \%custom_fields;
- }
- $self->{cache}{custom_fields};
+ my %custom_fields;
+ my $cfs = $self->getCustomFields();
+ foreach my $cf (@$cfs) {
+ $custom_fields{$cf->{name}} = $cf;
+ }
+ $self->{cache}{custom_fields} = \%custom_fields;
+ }
+ return $self->{cache}{custom_fields};
}
=item B<set_custom_fields> HASHREF
@@ -384,6 +403,7 @@
sub set_custom_fields {
my ($self, $cfs) = @_;
$self->{cache}{custom_fields} = $cfs;
+ return;
}
=item B<get_components> PROJECT_KEY
@@ -397,14 +417,14 @@
my ($self, $project_key) = @_;
my $cache = $self->{cache}{components};
unless (exists $cache->{$project_key}) {
- my %components;
- my $components = $self->getComponents($project_key);
- foreach my $component (@$components) {
- $components{$component->{name}} = $component;
- }
- $cache->{$project_key} = \%components;
- }
- $cache->{$project_key};
+ my %components;
+ my $components = $self->getComponents($project_key);
+ foreach my $component (@$components) {
+ $components{$component->{name}} = $component;
+ }
+ $cache->{$project_key} = \%components;
+ }
+ return $cache->{$project_key};
}
=item B<get_versions> PROJECT_KEY
@@ -418,14 +438,14 @@
my ($self, $project_key) = @_;
my $cache = $self->{cache}{versions};
unless (exists $cache->{$project_key}) {
- my %versions;
- my $versions = $self->getVersions($project_key);
- foreach my $version (@$versions) {
- $versions{$version->{name}} = $version;
- }
- $cache->{$project_key} = \%versions;
- }
- $cache->{$project_key};
+ my %versions;
+ my $versions = $self->getVersions($project_key);
+ foreach my $version (@$versions) {
+ $versions{$version->{name}} = $version;
+ }
+ $cache->{$project_key} = \%versions;
+ }
+ return $cache->{$project_key};
}
=item B<get_favourite_filters>
@@ -439,14 +459,14 @@
my ($self) = @_;
my $cache = $self->{cache};
unless (exists $cache->{filters}) {
- my %filters;
- my $filters = $self->getFavouriteFilters();
- foreach my $filter (@$filters) {
- $filters{$filter->{name}} = $filter;
- }
- $cache->{filters} = \%filters;
- }
- $cache->{filters};
+ my %filters;
+ my $filters = $self->getFavouriteFilters();
+ foreach my $filter (@$filters) {
+ $filters{$filter->{name}} = $filter;
+ }
+ $cache->{filters} = \%filters;
+ }
+ return $cache->{filters};
}
=item B<set_filter_iterator> FILTER [, CACHE_SIZE]
@@ -467,27 +487,29 @@
my ($self, $filter, $cache_size) = @_;
if ($filter =~ /\D/) {
- my $filters = $self->getSavedFilters();
- foreach my $f (@$filters) {
- if ($f->{name} eq $filter) {
- $filter = $f->{id};
- last;
- }
- }
- croak "Can't find filter '$filter'\n" if $filter =~ /\D/;
+ my $filters = $self->getSavedFilters();
+ foreach my $f (@$filters) {
+ if ($f->{name} eq $filter) {
+ $filter = $f->{id};
+ last;
+ }
+ }
+ croak "Can't find filter '$filter'\n" if $filter =~ /\D/;
}
if ($cache_size) {
- croak "set_filter_iterator's second arg must be a number ($cache_size).\n"
- if $cache_size =~ /\D/;
+ croak "set_filter_iterator's second arg must be a number ($cache_size).\n"
+ if $cache_size =~ /\D/;
}
$self->{iter} = {
- id => $filter,
- offset => 0, # offset to be used in the next call to getIssuesFromFilterWithLimit
- issues => [], # issues returned by the last call to getIssuesFromFilterWithLimit
- size => $cache_size || 128,
+ id => $filter,
+ offset => 0, # offset to be used in the next call to getIssuesFromFilterWithLimit
+ issues => [], # issues returned by the last call to getIssuesFromFilterWithLimit
+ size => $cache_size || 128,
};
+
+ return;
}
=item B<next_issue>
@@ -501,33 +523,33 @@
sub next_issue {
my ($self) = @_;
defined $self->{iter}
- or croak "You must call setFilterIterator before calling nextIssue\n";
+ or croak "You must call setFilterIterator before calling nextIssue\n";
my $iter = $self->{iter};
if (@{$iter->{issues}} == 0) {
- if ($iter->{id}) {
- my $issues = eval {$self->getIssuesFromFilterWithLimit($iter->{id}, $iter->{offset}, $iter->{size})};
- if ($@) {
- # The getIssuesFromFilterWithLimit appeared in JIRA
- # 3.13.4. Before that we had to use the unsafe
- # getIssuesFromFilter. Here we detect that we're talking
- # with an old JIRA and resort to the deprecated method
- # instead.
- die $@ unless $@ =~ /No such operation/;
- $iter->{issues} = $self->getIssuesFromFilter($iter->{id});
- $iter->{id} = undef;
- }
- elsif (@$issues) {
- $iter->{offset} += @$issues;
- $iter->{issues} = $issues;
- }
- else {
- $self->{iter} = undef;
- return undef;
- }
- }
- else {
- return undef;
- }
+ if ($iter->{id}) {
+ my $issues = eval {$self->getIssuesFromFilterWithLimit($iter->{id}, $iter->{offset}, $iter->{size})};
+ if ($@) {
+ # The getIssuesFromFilterWithLimit appeared in JIRA
+ # 3.13.4. Before that we had to use the unsafe
+ # getIssuesFromFilter. Here we detect that we're talking
+ # with an old JIRA and resort to the deprecated method
+ # instead.
+ croak $@ unless $@ =~ /No such operation/;
+ $iter->{issues} = $self->getIssuesFromFilter($iter->{id});
+ $iter->{id} = undef;
+ }
+ elsif (@$issues) {
+ $iter->{offset} += @$issues;
+ $iter->{issues} = $issues;
+ }
+ else {
+ $self->{iter} = undef;
+ return;
+ }
+ }
+ else {
+ return;
+ }
}
return shift @{$iter->{issues}};
}
@@ -586,85 +608,83 @@
my ($self, $key, $action, $params) = @_;
my $issue;
if (ref $key) {
- $issue = $key;
- $key = $issue->{key};
+ $issue = $key;
+ $key = $issue->{key};
}
my ($project) = (split /-/, $key)[0];
$params = {} unless defined $params;
ref $params and ref $params eq 'HASH'
- or croak "progress_workflow_action_safely's third arg must be a HASH-ref\n";
+ or croak "progress_workflow_action_safely's third arg must be a HASH-ref\n";
# Grok the action id if it's not a number
if ($action =~ /\D/) {
- my @available_actions = @{$self->getAvailableActions($key)};
- my @named_actions = grep {$action eq $_->{name}} @available_actions;
- if (@named_actions) {
- $action = $named_actions[0]->{id};
- }
- else {
- croak "Unavailable action ($action).\n";
- }
+ my @available_actions = @{$self->getAvailableActions($key)};
+ my @named_actions = grep {$action eq $_->{name}} @available_actions;
+ if (@named_actions) {
+ $action = $named_actions[0]->{id};
+ }
+ else {
+ croak "Unavailable action ($action).\n";
+ }
}
# Make sure $params contains all the fields that are present in
# the action screen.
my @fields = @{$self->getFieldsForAction($key, $action)};
foreach my $id (map {$_->{id}} @fields) {
- # This is due to a bug in JIRA
- # http://jira.atlassian.com/browse/JRA-12300
- $id = 'affectsVersions' if $id eq 'versions';
-
- next if exists $params->{$id};
-
- $issue = $self->getIssue($key) unless defined $issue;
- if (exists $issue->{$id}) {
- $params->{$id} = $issue->{$id} if defined $issue->{$id};
- }
- else {
- foreach my $cf (@{$issue->{customFieldValues}}) {
- if ($cf->{customfieldId} eq $id) {
- $params->{$id} = $cf->{values};
- last;
- }
- }
- # NOTE: It's not a problem if we can't find a missing
- # parameter in the issue. It will simply stay undefined.
- }
- }
-
- # Convert priority names
- $params->{priority} = $self->_convert_priority($params->{priority})
- if exists $params->{priority};
-
- # Convert component names
- if (exists $params->{components}) {
- $self->_convert_components($params->{components}, $project);
- # Now convert objects into ids.
- $_ = $_->{id} foreach @{$params->{components}};
- }
-
- # Convert version names and RemoteVersion objects into version ids
- for my $versions (qw/fixVersions affectsVersions/) {
- if (exists $params->{$versions}) {
- $self->_convert_versions($params->{$versions}, $project);
- # Now convert objects into ids.
- $_ = $_->{id} foreach @{$params->{$versions}};
- }
- }
- if (exists $params->{affectsVersions}) {
- # This is due to a bug in JIRA: http://jira.atlassian.com/browse/JRA-12300
- $params->{versions} = delete $params->{affectsVersions};
- }
-
- # Convert custom fields
+ # This is due to a bug in JIRA
+ # http://jira.atlassian.com/browse/JRA-12300
+ $id = 'affectsVersions' if $id eq 'versions';
+
+ next if exists $params->{$id};
+
+ $issue = $self->getIssue($key) unless defined $issue;
+ if (exists $issue->{$id}) {
+ $params->{$id} = $issue->{$id} if defined $issue->{$id};
+ }
+ else {
+ foreach my $cf (@{$issue->{customFieldValues}}) {
+ if ($cf->{customfieldId} eq $id) {
+ $params->{$id} = $cf->{values};
+ last;
+ }
+ }
+ # NOTE: It's not a problem if we can't find a missing
+ # parameter in the issue. It will simply stay undefined.
+ }
+ }
+
+ # Convert some fields' values
+ foreach my $field (grep {exists $_converters{$_}} keys %$params) {
+ &{$_converters{$field}}($self, $params, $field, $project);
+ }
+
+ # Convert RemoteComponent objects into component ids
+ if (my $comps = $params->{components}) {
+ $_ = $_->{id} foreach @$comps;
+ }
+
+ # Convert RemoteVersion objects into version ids
+ for my $field (qw/fixVersions affectsVersions/) {
+ if (my $versions = $params->{$field}) {
+ $_ = $_->{id} foreach @$versions;
+ }
+ }
+ # Due to a bug in JIRA
+ # (http://jira.atlassian.com/browse/JRA-12300) we have to
+ # substitute 'versions' for the 'affectsVersions' key
+ if (my $versions = delete $params->{affectsVersions}) {
+ $params->{versions} = $versions;
+ }
+
+ # Expand the custom_fields hash into the custom fields themselves.
if (my $custom_fields = delete $params->{custom_fields}) {
- my $id2values = $self->_convert_custom_fields($custom_fields);
- while (my ($id, $values) = each %$id2values) {
- $params->{$id} = $values;
- }
- }
-
- $self->progressWorkflowAction($key, $action, $params);
+ while (my ($id, $values) = each %$custom_fields) {
+ $params->{$id} = $values;
+ }
+ }
+
+ return $self->progressWorkflowAction($key, $action, $params);
}
=item B<get_issue_custom_field_values> ISSUE, NAME_OR_IDs
@@ -684,19 +704,19 @@
my $cfs;
CUSTOM_FIELD:
foreach my $cf (@cfs) {
- unless ($cf =~ /^customfield_\d+$/) {
- $cfs = $self->get_custom_fields() unless defined $cfs;
- croak "Can't find custom field named '$cf'.\n"
- unless exists $cfs->{$cf};
- $cf = $cfs->{$cf}{id};
- }
- foreach my $rcfv (@{$issue->{customFieldValues}}) {
- if ($rcfv->{customfieldId} eq $cf) {
- push @values, $rcfv->{values};
- next CUSTOM_FIELD;
- }
- }
- push @values, undef; # unset custom field
+ unless ($cf =~ /^customfield_\d+$/) {
+ $cfs = $self->get_custom_fields() unless defined $cfs;
+ croak "Can't find custom field named '$cf'.\n"
+ unless exists $cfs->{$cf};
+ $cf = $cfs->{$cf}{id};
+ }
+ foreach my $rcfv (@{$issue->{customFieldValues}}) {
+ if ($rcfv->{customfieldId} eq $cf) {
+ push @values, $rcfv->{values};
+ next CUSTOM_FIELD;
+ }
+ }
+ push @values, undef; # unset custom field
}
return wantarray ? @values : \@values;
}
@@ -740,7 +760,7 @@
$id = 'versions' if $id eq 'affectsVersions';
$values = [$values] unless ref $values;
- bless({id => $id, values => $values}, $class);
+ return bless({id => $id, values => $values}, $class);
}
=item B<RemoteCustomFieldValue-E<gt>new> ID, VALUES
@@ -768,7 +788,7 @@
my ($class, $id, $values) = @_;
$values = [$values] unless ref $values;
- bless({customfieldId => $id, key => undef, values => $values} => $class);
+ return bless({customfieldId => $id, key => undef, values => $values} => $class);
}
=item B<RemoteComponent-E<gt>new> ID, NAME
@@ -781,7 +801,7 @@
my ($class, $id, $name) = @_;
my $o = bless({id => $id}, $class);
$o->{name} = $name if $name;
- $o;
+ return $o;
}
=item B<RemoteVersion-E<gt>new> ID, NAME
@@ -794,7 +814,7 @@
my ($class, $id, $name) = @_;
my $o = bless({id => $id}, $class);
$o->{name} = $name if $name;
- $o;
+ return $o;
}
=back
@@ -835,7 +855,7 @@
sub _cast_remote_comment {
my ($self, $arg) = @_;
unless (ref $arg) {
- return bless({body => $arg}, 'RemoteComment');
+ return bless({body => $arg}, 'RemoteComment');
}
return $arg;
}
@@ -852,11 +872,11 @@
sub _cast_remote_field_values {
my ($self, $arg) = @_;
if (ref $arg && ref $arg eq 'HASH') {
- my @params;
- while (my ($id, $values) = each %$arg) {
- push @params, RemoteFieldValue->new($id, $values);
- }
- return \@params;
+ my @params;
+ while (my ($id, $values) = each %$arg) {
+ push @params, RemoteFieldValue->new($id, $values);
+ }
+ return \@params;
}
return $arg;
}
@@ -871,33 +891,35 @@
# Perform any non-default type coersion
if (my $typeof = $typeof{$method}) {
- while (my ($i, $type) = each %$typeof) {
- if (ref $type && ref $type eq 'CODE') {
+ while (my ($i, $type) = each %$typeof) {
+ if (ref $type) {
+ ref $type eq 'CODE'
+ or croak "Invalid coersion spec to (", ref($type), ").\n";
$args[$i] = $type->($self, $args[$i]);
- }
- elsif (! ref $args[$i]) {
- $args[$i] = SOAP::Data->type($type => $args[$i]);
- }
- elsif (ref $args[$i] eq 'ARRAY') {
- foreach (@{$args[$i]}) {
- $_ = SOAP::Data->type($type => $_);
- }
- }
- elsif (ref $args[$i] eq 'HASH') {
- foreach (values %{$args[$i]}) {
- $_ = SOAP::Data->type($type => $_);
- }
- }
- else {
- croak "Can't coerse argument $i of method $AUTOLOAD.\n";
- }
- }
+ }
+ elsif (! ref $args[$i]) {
+ $args[$i] = SOAP::Data->type($type => $args[$i]);
+ }
+ elsif (ref $args[$i] eq 'ARRAY') {
+ foreach (@{$args[$i]}) {
+ $_ = SOAP::Data->type($type => $_);
+ }
+ }
+ elsif (ref $args[$i] eq 'HASH') {
+ foreach (values %{$args[$i]}) {
+ $_ = SOAP::Data->type($type => $_);
+ }
+ }
+ else {
+ croak "Can't coerse argument $i of method $AUTOLOAD.\n";
+ }
+ }
}
my $call = $self->{soap}->call($method, $self->{auth}, @args);
- die _fault_details($call), "\n"
- if defined $call->fault();
- $call->result();
+ croak _fault_details($call), "\n"
+ if defined $call->fault();
+ return $call->result();
}
=head1 AUTHOR
Modified: branches/upstream/libjira-client-perl/current/t/00-load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjira-client-perl/current/t/00-load.t?rev=47580&op=diff
==============================================================================
--- branches/upstream/libjira-client-perl/current/t/00-load.t (original)
+++ branches/upstream/libjira-client-perl/current/t/00-load.t Sat Nov 21 17:47:40 2009
@@ -1,5 +1,3 @@
-#!perl -T
-
use Test::More tests => 1;
BEGIN {
Modified: branches/upstream/libjira-client-perl/current/t/01-online.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjira-client-perl/current/t/01-online.t?rev=47580&op=diff
==============================================================================
--- branches/upstream/libjira-client-perl/current/t/01-online.t (original)
+++ branches/upstream/libjira-client-perl/current/t/01-online.t Sat Nov 21 17:47:40 2009
@@ -1,5 +1,3 @@
-#!/usr/bin/perl
-
use strict;
use warnings;
use Test::More;
Added: branches/upstream/libjira-client-perl/current/t/perlcritic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libjira-client-perl/current/t/perlcritic.t?rev=47580&op=file
==============================================================================
--- branches/upstream/libjira-client-perl/current/t/perlcritic.t (added)
+++ branches/upstream/libjira-client-perl/current/t/perlcritic.t Sat Nov 21 17:47:40 2009
@@ -1,0 +1,20 @@
+use strict;
+use warnings;
+use File::Spec;
+use Test::More;
+use English qw(-no_match_vars);
+
+unless (-e 't/author.enabled') {
+ plan skip_all => "Author-only tests";
+ exit 0;
+}
+
+eval { require Test::Perl::Critic; };
+
+if ( $EVAL_ERROR ) {
+ my $msg = 'Test::Perl::Critic required to criticise code';
+ plan( skip_all => $msg );
+}
+
+Test::Perl::Critic->import( -verbose => 5 );
+all_critic_ok();
Propchange: branches/upstream/libjira-client-perl/current/t/perlcritic.t
------------------------------------------------------------------------------
svn:executable = *
More information about the Pkg-perl-cvs-commits
mailing list