r46082 - in /trunk/libjira-client-perl: Changes MANIFEST META.yml Makefile.PL README debian/changelog debian/control debian/copyright debian/rules lib/JIRA/Client.pm t/01-online.t t/01-setup.t t/pod-coverage.t t/pod.t

angelabad-guest at users.alioth.debian.org angelabad-guest at users.alioth.debian.org
Mon Oct 19 09:52:52 UTC 2009


Author: angelabad-guest
Date: Mon Oct 19 09:52:46 2009
New Revision: 46082

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=46082
Log:
New upstream 0.17

Added:
    trunk/libjira-client-perl/t/01-online.t
      - copied unchanged from r46081, branches/upstream/libjira-client-perl/current/t/01-online.t
Removed:
    trunk/libjira-client-perl/t/01-setup.t
Modified:
    trunk/libjira-client-perl/Changes
    trunk/libjira-client-perl/MANIFEST
    trunk/libjira-client-perl/META.yml
    trunk/libjira-client-perl/Makefile.PL
    trunk/libjira-client-perl/README
    trunk/libjira-client-perl/debian/changelog
    trunk/libjira-client-perl/debian/control
    trunk/libjira-client-perl/debian/copyright
    trunk/libjira-client-perl/debian/rules
    trunk/libjira-client-perl/lib/JIRA/Client.pm
    trunk/libjira-client-perl/t/pod-coverage.t
    trunk/libjira-client-perl/t/pod.t

Modified: trunk/libjira-client-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/Changes?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/Changes (original)
+++ trunk/libjira-client-perl/Changes Mon Oct 19 09:52:46 2009
@@ -1,4 +1,16 @@
 Revision history for JIRA-Client
+
+0.17	2009-10-18
+
+	Implements the method get_issue_custom_field_values, to more
+	easily grok the custom field values from an issue.
+
+	Refactors some code in a bunch of helper functions.
+
+	Implements many more online tests. There are 39 now.
+
+	Makes the POD tests disabled by default. They are meant to be
+	used by the author only.
 
 0.16	2009-10-04
 

Modified: trunk/libjira-client-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/MANIFEST?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/MANIFEST (original)
+++ trunk/libjira-client-perl/MANIFEST Mon Oct 19 09:52:46 2009
@@ -5,7 +5,7 @@
 TODO
 lib/JIRA/Client.pm
 t/00-load.t
-t/01-setup.t
+t/01-online.t
 t/pod-coverage.t
 t/pod.t
 META.yml                                 Module meta-data (added by MakeMaker)

Modified: trunk/libjira-client-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/META.yml?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/META.yml (original)
+++ trunk/libjira-client-perl/META.yml Mon Oct 19 09:52:46 2009
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                JIRA-Client
-version:             0.16
+version:             0.17
 abstract:            An extended interface to JIRA's SOAP API.
 license:             ~
 author:              

Modified: trunk/libjira-client-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/Makefile.PL?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/Makefile.PL (original)
+++ trunk/libjira-client-perl/Makefile.PL Mon Oct 19 09:52:46 2009
@@ -7,22 +7,40 @@
 # clean up the online testing flag file.
 unlink("t/online.enabled");
 
-my $usage        = "$0 [--online-tests=JIRA_URL,USER,PASS,PRJKEY]\n";
+my $usage = "$0 [--author-tests] [--online-tests=JIRAURL,USER,PASS,PRJKEY,ISSUETYPE,PRIORITY,COMPONENT,VERSION,CUSTOMFIELDNAME,CUSTOMFIELDVALUE,FILTER,ACTION]\n";
+my $author_tests = 0;
 my $online_tests;
 GetOptions(
+    'author-tests'   => \$author_tests,
     'online-tests=s' => \$online_tests,
 ) or die $usage;
 
+if ($author_tests) {
+    open(ENABLED, '>t/author.enabled') or die "Can't touch ./t/author.enabled: $!";
+    close(ENABLED)                     or die "Can't touch ./t/author.enabled: $!";
+}
+
 if ($online_tests) {
-    my ($url, $user, $pass, $prjkey) = split /,/, $online_tests;
+    # These are the author's personal test configuration. :-)
+    $online_tests = 'http://localhost:8080/,gustavo,senhaforte,TST,Bug,Major,comp1,1.1,cor,azul,filtro,Close Issue'
+	if $online_tests eq 'default';
+    my ($url, $user, $pass, $prjkey, $type, $prio, $component, $version, $cfname, $cfvalue, $filter, $action) = split /,/, $online_tests;
     defined $prjkey or die $usage;
     open(ENABLED, ">t/online.enabled") or die "Can't touch ./t/online.enabled: $!";
     print ENABLED <<"EOS";
 {
-    url    => '$url',
-    user   => '$user',
-    pass   => '$pass',
-    prjkey => '$prjkey',
+    url       => '$url',
+    user      => '$user',
+    pass      => '$pass',
+    prjkey    => '$prjkey',
+    type      => '$type',
+    priority  => '$prio',
+    component => '$component',
+    version   => '$version',
+    cfname    => '$cfname',
+    cfvalue   => '$cfvalue',
+    filter    => '$filter',
+    action    => '$action',
 };
 EOS
     close(ENABLED) or die "Can't touch ./t/online.enabled: $!";
@@ -40,5 +58,5 @@
 	'SOAP::Lite' => 0,
     },
     dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
-    clean               => { FILES => 'JIRA-Client-*' },
+    clean               => { FILES => 'JIRA-Client-* t/author.enabled t/online.enabled' },
 );

Modified: trunk/libjira-client-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/README?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/README (original)
+++ trunk/libjira-client-perl/README Mon Oct 19 09:52:46 2009
@@ -1,6 +1,6 @@
 Name:    JIRA-Client
 What:    A OO interface to JIRA's SOAP API.
-Version: 0.16
+Version: 0.17
 Author:  Gustavo Chaves <gnustavo at cpan.org>
 
 JIRA is a proprietary bug tracking system from Atlassian

Modified: trunk/libjira-client-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/debian/changelog?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/debian/changelog (original)
+++ trunk/libjira-client-perl/debian/changelog Mon Oct 19 09:52:46 2009
@@ -1,4 +1,4 @@
-libjira-client-perl (0.16-2) UNRELEASED; urgency=low
+libjira-client-perl (0.17-1) unstable; urgency=low
 
   [ gregor herrmann ]
   * debian/control: improve long description, thanks to Gerfried Fuchs for the
@@ -6,8 +6,11 @@
 
   [ Angel Abad ]
   * Update my email address
+  * New upstream release
+  * debian/rules: Enable author tests
+  * debian/control: Build-Depends on debhelper (>= 7.0.50) for overrides
 
- -- Angel Abad <angelabad at gmail.com>  Sun, 18 Oct 2009 02:15:49 +0200
+ -- Angel Abad <angelabad at gmail.com>  Mon, 19 Oct 2009 11:41:29 +0200
 
 libjira-client-perl (0.16-1) unstable; urgency=low
 

Modified: trunk/libjira-client-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/debian/control?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/debian/control (original)
+++ trunk/libjira-client-perl/debian/control Mon Oct 19 09:52:46 2009
@@ -1,7 +1,7 @@
 Source: libjira-client-perl
 Section: perl
 Priority: optional
-Build-Depends: debhelper (>= 7)
+Build-Depends: debhelper (>= 7.0.50)
 Build-Depends-Indep: perl, libsoap-lite-perl, libtest-pod-perl (>= 1.22),
  libtest-pod-coverage-perl (>= 1.08)
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>

Modified: trunk/libjira-client-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/debian/copyright?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/debian/copyright (original)
+++ trunk/libjira-client-perl/debian/copyright Mon Oct 19 09:52:46 2009
@@ -5,11 +5,13 @@
 Upstream-Name: JIRA-Client
 
 Files: *
-Copyright: 2009, CPqD (http://www.cpqd.com.br/) 
+Copyright: 2009, CPqD (http://www.cpqd.com.br/)
+License-Alias: Perl 
 License: Artistic | GPL-1+
 
 Files: debian/*
 Copyright: 2009, Angel Abad (Ikusnet SLL) <angel at grupoikusnet.com>
+ 2009, gregor herrmann <gregoa at debian.org>
 License: Artistic | GPL-1+
 
 License: Artistic

Modified: trunk/libjira-client-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/debian/rules?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/debian/rules (original)
+++ trunk/libjira-client-perl/debian/rules Mon Oct 19 09:52:46 2009
@@ -2,3 +2,6 @@
 
 %:
 	dh $@
+
+override_dh_auto_configure:
+	dh_auto_configure -- --author-tests

Modified: trunk/libjira-client-perl/lib/JIRA/Client.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/lib/JIRA/Client.pm?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/lib/JIRA/Client.pm (original)
+++ trunk/libjira-client-perl/lib/JIRA/Client.pm Mon Oct 19 09:52:46 2009
@@ -11,11 +11,11 @@
 
 =head1 VERSION
 
-Version 0.16
-
-=cut
-
-our $VERSION = '0.16';
+Version 0.17
+
+=cut
+
+our $VERSION = '0.17';
 
 =head1 SYNOPSIS
 
@@ -150,6 +150,83 @@
     # to not call it.
 
     # shift->logout();
+}
+
+# These are some helper functions to convert names into ids.
+
+sub _convert_type {
+    my ($self, $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;
+}
+
+sub _convert_priority {
+    my ($self, $prio) = @_;
+    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;
+}
+
+sub _convert_components {
+    my ($self, $icomps, $project) = @_; # issue components, project key
+    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}) {
+       next if ref $c;
+       if ($c =~ /\D/) {
+           # It's a component name. Let us convert it into its id.
+           $pcomps = $self->get_components($project) unless defined $pcomps;
+           croak "There is no component called '$c'.\n" unless exists $pcomps->{$c};
+           $c = $pcomps->{$c}{id};
+       }
+       # Now we can convert it into an object.
+       $c = RemoteComponent->new($c);
+    }
+}
+
+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 $pversions;
+    foreach my $v (@{$iversions}) {
+       next if ref $v;
+       if ($v =~ /\D/) {
+           # It is a version name. Let us convert it into its id.
+           $pversions = $self->get_versions($project) unless defined $pversions;
+           croak "There is no version called '$v'.\n" unless exists $pversions->{$v};
+           $v = $pversions->{$v}{id};
+       }
+       # Now we can convert it into an object.
+       $v = RemoteVersion->new($v);
+    }
+}
+
+sub _convert_custom_fields {
+    my ($self, $custom_fields) = @_;
+    croak "The 'custom_fields' value must be a HASH ref.\n"
+	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;
 }
 
 =item B<create_issue> HASH_REF
@@ -199,83 +276,28 @@
     }
 
     # Convert type names
-    if ($hash->{type} =~ /\D/) {
-	my $type  = $hash->{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};
-    }
+    $hash->{type} = $self->_convert_type($hash->{type});
 
     # Convert priority names
-    if (exists $hash->{priority} && $hash->{priority} =~ /\D/) {
-	my $prio  = $hash->{priority};
-	my $prios = $self->get_priorities();
-
-	croak "There is no priority called '$prio'.\n"
-	    unless exists $prios->{$prio};
-	$hash->{priority} = $prios->{$prio}{id};
-    }
+    $hash->{priority} = $self->_convert_priority($hash->{priority})
+	if exists $hash->{priority};
 
     # Convert component names
-    if (exists $hash->{components}) {
-	croak "The 'components' value must be an ARRAY ref.\n"
-	    unless ref $hash->{components} && ref $hash->{components} eq 'ARRAY';
-	my $comps;
-	foreach my $c (@{$hash->{components}}) {
-	    if (! ref $c) {
-		if ($c =~ /\D/) {
-		    # It is a component name. Let us convert it into its id.
-		    $comps = $self->get_components($hash->{project}) unless defined $comps;
-		    croak "There is no component called '$c'.\n" unless exists $comps->{$c};
-		    $c = $comps->{$c}{id};
-		}
-		# Now we can convert it into an object.
-		$c = RemoteComponent->new($c);
-	    }
-	}
-    }
+    $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/) {
-	if (exists $hash->{$versions}) {
-	    croak "The '$versions' value must be a ARRAY ref.\n"
-		unless ref $hash->{$versions} && ref $hash->{$versions} eq 'ARRAY';
-	    my $verss;
-	    foreach my $v (@{$hash->{$versions}}) {
-		if (! ref $v) {
-		    if ($v =~ /\D/) {
-			# It is a version name. Let us convert it into its id.
-			$verss = $self->get_versions($hash->{project}) unless defined $verss;
-			croak "There is no version called '$v'.\n" unless exists $verss->{$v};
-			$v = $verss->{$v}{id};
-		    }
-		    # Now we can convert it into an object.
-		    $v = RemoteVersion->new($v);
-		}
-	    }
-	}
+	$self->_convert_versions($hash->{$versions}, $hash->{project})
+	    if exists $hash->{$versions};
     }
 
     # Convert custom fields
-    if (my $cfs = delete $hash->{custom_fields}) {
-	croak "The 'custom_fields' value must be a HASH ref.\n"
-	    unless ref $cfs && ref $cfs eq 'HASH';
+    if (my $custom_fields = delete $hash->{custom_fields}) {
 	my @cfvs;
-	while (my ($id, $values) = each %$cfs) {
-	    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};
-	    }
-	    $values = [$values] unless ref $values;
-	    push @cfvs, bless({
-		customfieldId => $id,
-		key => undef,
-		values => $values,
-	    } => 'RemoteCustomFieldValue');
+	my $id2values = $self->_convert_custom_fields($custom_fields);
+	while (my ($id, $values) = each %$id2values) {
+	    push @cfvs, RemoteCustomFieldValue->new($id, $values);
 	}
 	$hash->{customFieldValues} = \@cfvs;
     }
@@ -611,76 +633,72 @@
     }
 
     # Convert priority names
-    if (exists $params->{priority} && $params->{priority} =~ /\D/) {
-	my $prio  = $params->{priority};
-	my $prios = $self->get_priorities();
-
-	croak "There is no priority called '$prio'.\n"
-	    unless exists $prios->{$prio};
-	$params->{priority} = $prios->{$prio}{id};
-    }
+    $params->{priority} = $self->_convert_priority($params->{priority})
+	if exists $params->{priority};
 
     # Convert component names
     if (exists $params->{components}) {
-	croak "The 'components' value must be an ARRAY ref.\n"
-	    unless ref $params->{components} && ref $params->{components} eq 'ARRAY';
-	foreach my $c (@{$params->{components}}) {
-	    if (ref $c) {
-		die "Unexpected object in components list (", ref($c), ")\n"
-		    unless ref $c eq 'RemoteComponent';
-		$c = $c->{id};
-	    }
-	    elsif ($c =~ /\D/) {
-		# It is a component name. Let us convert it into its id.
-		my $components = $self->get_components($project);
-		croak "There is no component called '$c'.\n" unless exists $components->{$c};
-		$c = $components->{$c}{id};
-	    }
-	}
+	$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}) {
-	    croak "The '$versions' value must be a ARRAY ref.\n"
-		unless ref $params->{$versions} && ref $params->{$versions} eq 'ARRAY';
-	    foreach my $v (@{$params->{$versions}}) {
-		if (ref $v) {
-		    die "Unexpected object in version list (", ref($v), ")\n"
-			unless ref $v eq 'RemoteVersion';
-		    $v = $v->{id};
-		}
-		elsif ($v =~ /\D/) {
-		    # It is a version name. Let us convert it into its id.
-		    my $versions = $self->get_versions($project);
-		    croak "There is no version called '$v'.\n" unless exists $versions->{$v};
-		    $v = $versions->{$v}{id};
-		}
-	    }
+	    $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
+	# This is due to a bug in JIRA: http://jira.atlassian.com/browse/JRA-12300
 	$params->{versions} = delete $params->{affectsVersions};
     }
 
     # Convert custom fields
     if (my $custom_fields = delete $params->{custom_fields}) {
-	croak "The 'custom_fields' value must be a HASH ref.\n"
-	    unless ref $custom_fields && ref $custom_fields eq 'HASH';
-	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};
-	    }
-	    $params->{$id} = [$values] unless ref $values;
+	my $id2values = $self->_convert_custom_fields($custom_fields);
+	while (my ($id, $values) = each %$id2values) {
+	    $params->{$id} = $values;
 	}
     }
 
     $self->progressWorkflowAction($key, $action, $params);
+}
+
+=item B<get_issue_custom_field_values> ISSUE, NAME_OR_IDs
+
+This method receives a RemoteField object and a list of names or ids
+of custom fields. It returns a list of references to the ARRAYs
+containing the values of the ISSUE's custom fields denoted by their
+NAME_OR_IDs. Returns undef for custom fields not set on the issue.
+
+In scalar context it returns a reference to the list.
+
+=cut
+
+sub get_issue_custom_field_values {
+    my ($self, $issue, @cfs) = @_;
+    my @values;
+    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
+    }
+    return wantarray ? @values : \@values;
 }
 
 =back
@@ -723,6 +741,34 @@
 
     $values = [$values] unless ref $values;
     bless({id => $id, values => $values}, $class);
+}
+
+=item B<RemoteCustomFieldValue-E<gt>new> ID, VALUES
+
+The RemoteCustomFieldValue object represents the value of a
+custom_field of an issue. It needs two arguments:
+
+=over
+
+=item ID
+
+The field name, which must be a valid custom_field key.
+
+=item VALUES
+
+A scalar or an array of scalars.
+
+=back
+
+=cut
+
+package RemoteCustomFieldValue;
+
+sub new {
+    my ($class, $id, $values) = @_;
+
+    $values = [$values] unless ref $values;
+    bless({customfieldId => $id, key => undef, values => $values} => $class);
 }
 
 =item B<RemoteComponent-E<gt>new> ID, NAME

Modified: trunk/libjira-client-perl/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/t/pod-coverage.t?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/t/pod-coverage.t (original)
+++ trunk/libjira-client-perl/t/pod-coverage.t Mon Oct 19 09:52:46 2009
@@ -1,6 +1,8 @@
 use strict;
 use warnings;
 use Test::More;
+
+plan skip_all => "Author-only tests" unless -e 't/author.enabled';
 
 # Ensure a recent version of Test::Pod::Coverage
 my $min_tpc = 1.08;

Modified: trunk/libjira-client-perl/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libjira-client-perl/t/pod.t?rev=46082&op=diff
==============================================================================
--- trunk/libjira-client-perl/t/pod.t (original)
+++ trunk/libjira-client-perl/t/pod.t Mon Oct 19 09:52:46 2009
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 use Test::More;
+
+plan skip_all => "Author-only tests" unless -e 't/author.enabled';
 
 # Ensure a recent version of Test::Pod
 my $min_tp = 1.22;




More information about the Pkg-perl-cvs-commits mailing list