@@ -1,5 +1,17 @@
Revision history for Perl extension BZ::Client.
+1.061 Wed Apr 22 13:43:00 2015
+
+ - Fix for RT103873
+ - BZ::Client::Bugs - now uses wantarray
+
+1.06 Thu Dec 12 14:06:00 2013
+ - Applied patch from https://rt.cpan.org/Public/Bug/Display.html?id=78467, needs a test.
+ - Applied patch from https://rt.cpan.org/Ticket/Display.html?id=78694, needs a test.
+
+1.05 Fri Nov 29 14:11:00 2013
+ - Applied patch from http://hg.mozilla.org/webtools/bzapi/raw-file/24eba717cf5b/patches/xmlrpc-fix.diff
+
1.04 Mon Aug 22 19:23:00 2011
- Added support for dateTime via instances of DateTime
@@ -15,5 +27,5 @@ Revision history for Perl extension BZ::Client.
1.0 Tue Jun 23 07:18:25 2009
- Created
+ - Created
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/LICENSE b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/LICENSE
old mode 100755
new mode 100644
@@ -1,5 +1,6 @@
Changes
Makefile.PL
+TODO
LICENSE
MANIFEST
MANIFEST.SKIP
@@ -27,3 +28,4 @@ lib/BZ/Client/Test.pm
lib/BZ/Client.pm
META.yml Module meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
@@ -6,4 +6,5 @@
^Makefile.old$
^pm_to_blib$
^BZ-Client-\d+.*\.tar\.gz$
+^.git\/
@@ -0,0 +1,44 @@
+{
+ "abstract" : "BZ::Client - A client for the Bugzilla web services API.",
+ "author" : [
+ "Jochen Wiedmann <jochen.wiedmann@gmail.com>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.143240",
+ "license" : [
+ "unknown"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "BZ-Client",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "DateTime::Format::ISO8601" : "0",
+ "URI" : "0",
+ "XML::Parser" : "0",
+ "XML::Writer" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "version" : "1.061"
+}
@@ -1,24 +1,25 @@
---- #YAML:1.0
-name: BZ-Client
-version: 1.04
-abstract: BZ::Client - A client for the Bugzilla web services API.
+---
+abstract: 'BZ::Client - A client for the Bugzilla web services API.'
author:
- - Jochen Wiedmann <jochen.wiedmann@gmail.com>
-license: unknown
-distribution_type: module
-configure_requires:
- ExtUtils::MakeMaker: 0
+ - 'Jochen Wiedmann <jochen.wiedmann@gmail.com>'
build_requires:
- ExtUtils::MakeMaker: 0
-requires:
- URI: 0
- XML::Parser: 0
- XML::Writer: 0
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.55_02
+ ExtUtils::MakeMaker: '0'
+configure_requires:
+ ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.143240'
+license: unknown
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: BZ-Client
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ DateTime::Format::ISO8601: '0'
+ URI: '0'
+ XML::Parser: '0'
+ XML::Writer: '0'
+version: '1.061'
@@ -28,11 +28,11 @@ USAGE
my($testUrl, $testUser, $testPassword, $logDirectory);
Getopt::Long::GetOptions(
- "help" => \&Usage,
- "logDirectory=s" => \$logDirectory,
- "testUrl=s" => \$testUrl,
- "testUser=s" => \$testUser,
- "testPassword=s" => \$testPassword
+ 'help' => \&Usage,
+ 'logDirectory=s' => \$logDirectory,
+ 'testUrl=s' => \$testUrl,
+ 'testUser=s' => \$testUser,
+ 'testPassword=s' => \$testPassword
) || die Usage();
my $config = {
@@ -43,19 +43,19 @@ my $config = {
};
my $configFile = 't/config.pl';
-open(my $fh, ">", $configFile)
+open(my $fh, '>', $configFile)
or die "Failed to create $configFile: $!";
(print $fh Data::Dumper->new([$config])->Indent(1)->Terse(1)->Dump())
or die "Failed to write to $configFile: $!";
close($fh)
or die "Failed to close $configFile: $!";
-
+
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'BZ::Client',
VERSION_FROM => 'lib/BZ/Client.pm', # finds $VERSION
- PREREQ_PM => { 'XML::Parser' => 0, 'XML::Writer' => 0, 'URI' => 0 }, # e.g., Module::Name => 1.1
+ PREREQ_PM => { 'XML::Parser' => 0, 'XML::Writer' => 0, 'URI' => 0, 'DateTime::Format::ISO8601' => 0 }, # e.g., Module::Name => 1.1
ABSTRACT => 'BZ::Client - A client for the Bugzilla web services API.',
AUTHOR => 'Jochen Wiedmann <jochen.wiedmann@gmail.com>',
);
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/README b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/README
old mode 100755
new mode 100644
@@ -0,0 +1,3 @@
+Add bug comments stuff ie.
+my $resp = $bz->api_call('Bug.comments', { ids => [ 52053 ] });
+and add_comments
@@ -1,9 +1,11 @@
+#!/bin/false
+
#
# BZ::Client::API - Abstract base class for the clients of the Bugzilla API.
#
use strict;
-use warnings "all";
+use warnings 'all';
package BZ::Client::API;
@@ -34,4 +36,4 @@ are subclassing this one, in order to inherit common functionality.
=head1 SEE ALSO
L<BZ::Client>
-
\ No newline at end of file
+
@@ -1,9 +1,11 @@
+#!/bin/false
+
#
# BZ::Client::Bug - Client side representation of a bug in Bugzilla
#
use strict;
-use warnings "all";
+use warnings 'all';
package BZ::Client::Bug;
@@ -14,58 +16,58 @@ our @ISA = qw(BZ::Client::API);
sub legal_values($$$) {
my($class, $client, $field) = @_;
- $client->log("debug", "BZ::Client::Bug::legal_values: Asking for $field");
- my $params = { "field" => $field };
- my $result = $class->api_call($client, "Bug.legal_values", $params);
- my $values = $result->{"values"};
- if (!$values || "ARRAY" ne ref($values)) {
+ $client->log('debug', "BZ::Client::Bug::legal_values: Asking for $field");
+ my $params = { 'field' => $field };
+ my $result = $class->api_call($client, 'Bug.legal_values', $params);
+ my $values = $result->{'values'};
+ if (!$values || 'ARRAY' ne ref($values)) {
$class->error($client, "Invalid reply by server, expected array of values.");
}
- $client->log("debug", "BZ::Client::Bug::legal_values: Got " . join(",", @$values));
+ $client->log('debug', 'BZ::Client::Bug::legal_values: Got ' . join(',', @$values));
return $values;
}
sub get($$;$) {
my($class, $client, $ids, $permissive) = @_;
- $client->log("debug", "BZ::Client::Bug::get: Asking for " . (ref($ids) eq "ARRAY" ? join(",", @$ids) : $ids));
+ $client->log('debug', 'BZ::Client::Bug::get: Asking for ' . (ref($ids) eq 'ARRAY' ? join(',', @$ids) : $ids));
my $params = { ids => $ids };
- $params->{"permissive"} = BZ::Client::XMLRPC::boolean::TRUE() if $permissive;
- my $result = $class->api_call($client, "Bug.get", $params);
- my $bugs = $result->{"bugs"};
- if (!$bugs || "ARRAY" ne ref($bugs)) {
- $class->error($client, "Invalid reply by server, expected array of bugs.");
+ $params->{'permissive'} = BZ::Client::XMLRPC::boolean::TRUE() if $permissive;
+ my $result = $class->api_call($client, 'Bug.get', $params);
+ my $bugs = $result->{'bugs'};
+ if (!$bugs || 'ARRAY' ne ref($bugs)) {
+ $class->error($client, 'Invalid reply by server, expected array of bugs.');
}
my @result;
- foreach my $bug (@$bugs) {
+ for my $bug (@$bugs) {
push(@result, BZ::Client::Bug->new(%$bug));
}
- $client->log("debug", "BZ::Client::Bug::get: Got " . scalar(@result));
- return \@result;
+ $client->log('debug', 'BZ::Client::Bug::get: Got ' . scalar(@result));
+ return wantarray ? @result : \@result;
}
sub search($$$) {
my($class, $client, $params) = @_;
- $client->log("debug", "BZ::Client::Bug::search: Searching");
- my $result = $class->api_call($client, "Bug.search", $params);
- my $bugs = $result->{"bugs"};
- if (!$bugs || "ARRAY" ne ref($bugs)) {
- $class->error($client, "Invalid reply by server, expected array of bugs.");
+ $client->log('debug', 'BZ::Client::Bug::search: Searching');
+ my $result = $class->api_call($client, 'Bug.search', $params);
+ my $bugs = $result->{'bugs'};
+ if (!$bugs || 'ARRAY' ne ref($bugs)) {
+ $class->error($client, 'Invalid reply by server, expected array of bugs.');
}
my @result;
- foreach my $bug (@$bugs) {
+ for my $bug (@$bugs) {
push(@result, BZ::Client::Bug->new(%$bug));
}
- $client->log("debug", "BZ::Client::Bug::search: Got " . scalar(@result));
- return \@result;
+ $client->log('debug', 'BZ::Client::Bug::search: Got ' . scalar(@result));
+ return wantarray ? @result : \@result;
}
sub create($$$) {
my($class, $client, $params) = @_;
- $client->log("debug", "BZ::Client::Bug::create: Creating");
+ $client->log('debug', 'BZ::Client::Bug::create: Creating');
my $result = $class->api_call($client, "Bug.create", $params);
my $id = $result->{"id"};
if (!$id) {
- $class->error($client, "Invalid reply by server, expected bug ID.");
+ $class->error($client, 'Invalid reply by server, expected bug ID.');
}
return $id;
}
@@ -80,135 +82,135 @@ sub new($@) {
sub id($;$) {
my $self = shift;
if (@_) {
- $self->{"id"} = shift;
+ $self->{'id'} = shift;
} else {
- return $self->{"id"}
+ return $self->{'id'}
}
}
sub alias($;$) {
my $self = shift;
if (@_) {
- $self->{"alias"} = shift;
+ $self->{'alias'} = shift;
} else {
- return $self->{"alias"}
+ return $self->{'alias'}
}
}
sub assigned_to($;$) {
my $self = shift;
if (@_) {
- $self->{"assigned_to"} = shift;
+ $self->{'assigned_to'} = shift;
} else {
- return $self->{"assigned_to"}
+ return $self->{'assigned_to'}
}
}
sub component($;$) {
my $self = shift;
if (@_) {
- $self->{"component"} = shift;
+ $self->{'component'} = shift;
} else {
- return $self->{"component"}
+ return $self->{'component'}
}
}
sub creation_time($;$) {
my $self = shift;
if (@_) {
- $self->{"creation_time"} = shift;
+ $self->{'creation_time'} = shift;
} else {
- return $self->{"creation_time"}
+ return $self->{'creation_time'}
}
}
sub dupe_of($;$) {
my $self = shift;
if (@_) {
- $self->{"dupe_of"} = shift;
+ $self->{'dupe_of'} = shift;
} else {
- return $self->{"dupe_of"}
+ return $self->{'dupe_of'}
}
}
sub internals($;$) {
my $self = shift;
if (@_) {
- $self->{"internals"} = shift;
+ $self->{'internals'} = shift;
} else {
- return $self->{"internals"}
+ return $self->{'internals'}
}
}
sub is_open($;$) {
my $self = shift;
if (@_) {
- $self->{"is_open"} = shift;
+ $self->{'is_open'} = shift;
} else {
- return $self->{"is_open"}
+ return $self->{'is_open'}
}
}
sub last_change_time($;$) {
my $self = shift;
if (@_) {
- $self->{"last_change_time"} = shift;
+ $self->{'last_change_time'} = shift;
} else {
- return $self->{"last_change_time"}
+ return $self->{'last_change_time'}
}
}
sub priority($;$) {
my $self = shift;
if (@_) {
- $self->{"priority"} = shift;
+ $self->{'priority'} = shift;
} else {
- return $self->{"priority"}
+ return $self->{'priority'}
}
}
sub product($;$) {
my $self = shift;
if (@_) {
- $self->{"product"} = shift;
+ $self->{'product'} = shift;
} else {
- return $self->{"product"}
+ return $self->{'product'}
}
}
sub resolution($;$) {
my $self = shift;
if (@_) {
- $self->{"resolution"} = shift;
+ $self->{'resolution'} = shift;
} else {
- return $self->{"resolution"}
+ return $self->{'resolution'}
}
}
sub severity($;$) {
my $self = shift;
if (@_) {
- $self->{"severity"} = shift;
+ $self->{'severity'} = shift;
} else {
- return $self->{"severity"}
+ return $self->{'severity'}
}
}
sub status($;$) {
my $self = shift;
if (@_) {
- $self->{"status"} = shift;
+ $self->{'status'} = shift;
} else {
- return $self->{"status"}
+ return $self->{'status'}
}
}
sub summary($;$) {
my $self = shift;
if (@_) {
- $self->{"summary"} = shift;
+ $self->{'summary'} = shift;
} else {
- return $self->{"summary"}
+ return $self->{'summary'}
}
}
@@ -218,7 +220,7 @@ sub summary($;$) {
=head1 NAME
- BZ::Client::Bug - Client side representation of a bug in Bugzilla
+ BZ::Client::Bug - Client side representation of a bug in Bugzilla
This class provides methods for accessing and managing bugs in Bugzilla.
@@ -367,4 +369,3 @@ Gets or sets the summary of this bug.
=head1 SEE ALSO
L<BZ::Client>, L<BZ::Client::API>
-
\ No newline at end of file
@@ -100,4 +100,4 @@ Returns the Bugzilla servers version.
=head1 SEE ALSO
L<BZ::Client>, L<BZ::Client::API>
-
\ No newline at end of file
+
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/lib/BZ/Client/Exception.pm b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/lib/BZ/Client/Exception.pm
old mode 100755
new mode 100644
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/lib/BZ/Client/Product.pm b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/lib/BZ/Client/Product.pm
old mode 100755
new mode 100644
@@ -1,9 +1,11 @@
+#!/bin/false
+
#
# BZ::Client::Test - Module for writing integration tests
#
use strict;
-use warnings "all";
+use warnings 'all';
package BZ::Client::Test;
@@ -15,7 +17,7 @@ sub new($;@) {
my $self;
if (@_ == 1) {
my $files = shift;
- foreach my $f (@$files) {
+ for my $f (@$files) {
if (-f $f) {
my $hash;
eval {
@@ -24,7 +26,7 @@ sub new($;@) {
if ($@) {
die "Failed to load configuration file $f: $@";
}
- if (!$hash || ref($hash) ne "HASH") {
+ if (!$hash || ref($hash) ne 'HASH') {
die "Configuration file $f didn't return a HASH value.";
}
# Create a copy of $hash
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/lib/BZ/Client/XMLRPC/Array.pm b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/lib/BZ/Client/XMLRPC/Array.pm
old mode 100755
new mode 100644
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/lib/BZ/Client/XMLRPC/Handler.pm b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/lib/BZ/Client/XMLRPC/Handler.pm
old mode 100755
new mode 100644
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/lib/BZ/Client/XMLRPC/Parser.pm b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/lib/BZ/Client/XMLRPC/Parser.pm
old mode 100755
new mode 100644
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/lib/BZ/Client/XMLRPC/Response.pm b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/lib/BZ/Client/XMLRPC/Response.pm
old mode 100755
new mode 100644
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/lib/BZ/Client/XMLRPC/Struct.pm b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/lib/BZ/Client/XMLRPC/Struct.pm
old mode 100755
new mode 100644
@@ -4,89 +4,112 @@
package BZ::Client::XMLRPC::Value;
use strict;
-use warnings "all";
+use warnings 'all';
use BZ::Client::XMLRPC::Handler();
use BZ::Client::XMLRPC::Struct();
use BZ::Client::XMLRPC::Array();
use DateTime::Format::ISO8601();
-our $VERSION = 1.0;
-our @ISA = qw(BZ::Client::XMLRPC::Handler);
+our $VERSION = 1.01;
+our @ISA = qw(BZ::Client::XMLRPC::Handler);
sub start($$) {
- my($self,$name) = @_;
+ my ( $self, $name ) = @_;
my $l = $self->inc_level();
- if ($l == 0) {
- if ("value" ne $name) {
+ if ( $l == 0 ) {
+ if ( 'value' ne $name ) {
$self->error("Expected value element, got $name");
}
- $self->{'level0_content'} = "";
- } elsif ($l == 1) {
- if ("struct" eq $name) {
+ $self->{'level0_content'} = q();
+ }
+ elsif ( $l == 1 ) {
+ if ( 'struct' eq $name ) {
my $handler = BZ::Client::XMLRPC::Struct->new();
- $self->parser()->register($self, $handler, sub {
- $self->{'result'} = $handler->result();
- });
+ $self->parser()->register(
+ $self, $handler,
+ sub {
+ $self->{'result'} = $handler->result();
+ }
+ );
$handler->start($name);
- } elsif ("array" eq $name) {
+ }
+ elsif ( 'array' eq $name ) {
my $handler = BZ::Client::XMLRPC::Array->new();
- $self->parser()->register($self, $handler, sub {
- $self->{'result'} = $handler->result();
- });
+ $self->parser()->register(
+ $self, $handler,
+ sub {
+ $self->{'result'} = $handler->result();
+ }
+ );
$handler->start($name);
- } elsif ("i4" eq $name
- || "int" eq $name
- || "string" eq $name
- || "double" eq $name
- || "dateTime.iso8601" eq $name
- || "base64" eq $name
- || "boolean" eq $name) {
- $self->{'level1_elem'} = $name;
+ }
+ elsif ('i4' eq $name
+ || 'int' eq $name
+ || 'string' eq $name
+ || 'double' eq $name
+ || 'dateTime.iso8601' eq $name
+ || 'base64' eq $name
+ || 'boolean' eq $name )
+ {
+ $self->{'level1_elem'} = $name;
$self->{'level1_content'} = "";
- } else {
- $self->error("Expected struct|array|i4|int|boolean|string|double|dateTime.iso8601|base64 element, got $name");
}
- } else {
+ else {
+ $self->error(
+"Expected struct|array|i4|int|boolean|string|double|dateTime.iso8601|base64 element, got $name"
+ );
+ }
+ }
+ else {
$self->error("Unexpected element $name at level $l");
}
}
sub end($$) {
- my($self,$name) = @_;
+ my ( $self, $name ) = @_;
my $l = $self->level();
- if ($l == 1) {
+ if ( $l == 1 ) {
my $content = $self->{'level0_content'};
- if (defined($self->{'result'})) {
- if ($content !~ /^\s*$/s) {
- $self->error("Unexpected non-whitespace content");
+ if ( defined( $self->{'result'} ) ) {
+ if ( $content !~ m/^\s*$/s ) {
+ $self->error('Unexpected non-whitespace content');
}
- } else {
+ }
+ else {
$self->{'result'} = $content;
}
- } elsif ($l == 2) {
+ }
+ elsif ( $l == 2 ) {
my $name = $name;
- if (defined($name)) {
- $self->{'result'} = $self->{'level1_content'};
+ if ( defined($name) ) {
+ $self->{'result'} = $self->{'level1_content'};
$self->{'level1_content'} = undef;
- $self->{'level1_elem'} = undef;
- if ("dateTime.iso8601" eq $name) {
- $self->{'result'} = DateTime::Format::ISO8601->parse_datetime( $self->{'result'} );
- }
+ $self->{'level1_elem'} = undef;
+ if ( 'dateTime.iso8601' eq $name ) {
+ my $val = $self->{'result'};
+ if ( $val =~ m/(\d\d\d\d)(\d\d)(\d\d)(T\d\d:\d\d:\d\d)/ )
+ { # See https://rt.cpan.org/Public/Bug/Display.html?id=78467
+ $val = "$1-$2-$3$4";
+ }
+ $self->{'result'} =
+ DateTime::Format::ISO8601->parse_datetime($val);
+ }
}
}
return $self->SUPER::end($name);
}
sub characters($$) {
- my($self,$text) = @_;
+ my ( $self, $text ) = @_;
my $l = $self->level();
- if ($l == 1) {
+ if ( $l == 1 ) {
$self->{'level0_content'} .= $text;
return;
- } elsif ($l == 2) {
+ }
+ elsif ( $l == 2 ) {
my $l1_elem = $self->{'level1_elem'};
- if (defined($l1_elem)) {
+ if ( defined($l1_elem) ) {
$self->{'level1_content'} .= $text;
return;
}
@@ -95,7 +118,7 @@ sub characters($$) {
}
sub result($) {
- my($self) = shift;
+ my ($self) = shift;
my $res = $self->{'result'};
$res = defined($res) ? $res : "";
return $res;
@@ -1,19 +1,22 @@
+#!/bin/false
+
#
# BZ::Client::XMLRPC.pm - Performs XML-RPC calls on behalf of the client.
#
use strict;
-use warnings "all";
+use warnings 'all';
package BZ::Client::XMLRPC;
use LWP();
use XML::Writer();
+use Encode;
use BZ::Client::XMLRPC::Parser();
use DateTime::Format::Strptime();
use DateTime::TimeZone();
-our $VERSION = 1.0;
+our $VERSION = 1.02;
our $counter;
our $fmt = DateTime::Format::Strptime->new(pattern=> '%C%Y-%m-%dT%T', time_zone=>'UTC');
our $tz = DateTime::TimeZone->new(name => 'UTC');
@@ -53,104 +56,103 @@ sub user_agent($;$) {
sub error($$;$$) {
my($self, $message, $http_code, $xmlrpc_code) = @_;
require BZ::Client::Exception;
- BZ::Client::Exception->throw("message" => $message,
- "http_code" => $http_code,
- "xmlrpc_code" => $xmlrpc_code);
+ BZ::Client::Exception->throw('message' => $message,
+ 'http_code' => $http_code,
+ 'xmlrpc_code' => $xmlrpc_code);
}
sub value($$$) {
my($self, $writer, $value) = @_;
- if (ref($value) eq "HASH") {
- $writer->startTag("value");
- $writer->startTag("struct");
- my ($key,$val);
- while (($key, $val) = each %$value) {
- $writer->startTag("member");
- $writer->startTag("name");
+ if (ref($value) eq 'HASH') {
+ $writer->startTag('value');
+ $writer->startTag('struct');
+ for my $key (sort keys %$value) {
+ $writer->startTag('member');
+ $writer->startTag('name');
$writer->characters($key);
- $writer->endTag("name");
- $self->value($writer, $val);
- $writer->endTag("member");
+ $writer->endTag('name');
+ $self->value($writer, $value->{$key});
+ $writer->endTag('member');
}
- $writer->endTag("struct");
- $writer->endTag("value");
- } elsif (ref($value) eq "ARRAY") {
- $writer->startTag("value");
- $writer->startTag("array");
- $writer->startTag("data");
- foreach my $val (@$value) {
+ $writer->endTag('struct');
+ $writer->endTag('value');
+ } elsif (ref($value) eq 'ARRAY') {
+ $writer->startTag('value');
+ $writer->startTag('array');
+ $writer->startTag('data');
+ for my $val (@$value) {
$self->value($writer, $val);
}
- $writer->endTag("data");
- $writer->endTag("array");
- $writer->endTag("value");
- } elsif (ref($value) eq "BZ::Client::XMLRPC::int") {
- $writer->startTag("value");
- $writer->startTag("i4");
+ $writer->endTag('data');
+ $writer->endTag('array');
+ $writer->endTag('value');
+ } elsif (ref($value) eq 'BZ::Client::XMLRPC::int') {
+ $writer->startTag('value');
+ $writer->startTag('i4');
$writer->characters($$value);
- $writer->endTag("i4");
- $writer->endTag("value");
- } elsif (ref($value) eq "BZ::Client::XMLRPC::boolean") {
- $writer->startTag("value");
- $writer->startTag("boolean");
- $writer->characters($$value ? "1" : "0");
- $writer->endTag("boolean");
- $writer->endTag("value");
- } elsif (ref($value) eq "BZ::Client::XMLRPC::double") {
- $writer->startTag("value");
- $writer->startTag("double");
+ $writer->endTag('i4');
+ $writer->endTag('value');
+ } elsif (ref($value) eq 'BZ::Client::XMLRPC::boolean') {
+ $writer->startTag('value');
+ $writer->startTag('boolean');
+ $writer->characters($$value ? '1' : '0');
+ $writer->endTag('boolean');
+ $writer->endTag('value');
+ } elsif (ref($value) eq 'BZ::Client::XMLRPC::double') {
+ $writer->startTag('value');
+ $writer->startTag('double');
$writer->characters($$value);
- $writer->endTag("double");
- $writer->endTag("value");
- } elsif (ref($value) eq "DateTime") {
+ $writer->endTag('double');
+ $writer->endTag('value');
+ } elsif (ref($value) eq 'DateTime') {
my $clone = $value->clone();
$clone->set_time_zone($tz);
$clone->set_formatter($fmt);
- $writer->startTag("value");
- $writer->startTag("dateTime.iso8601");
- $writer->characters($clone->iso8601(). "Z");
- $writer->endTag("dateTime.iso8601");
- $writer->endTag("value");
+ $writer->startTag('value');
+ $writer->startTag('dateTime.iso8601');
+ $writer->characters($clone->iso8601(). 'Z');
+ $writer->endTag('dateTime.iso8601');
+ $writer->endTag('value');
} else {
- $writer->startTag("value");
+ $writer->startTag('value');
$writer->characters($value);
- $writer->endTag("value");
+ $writer->endTag('value');
}
}
sub create_request($$$) {
my($self, $methodName, $params) = @_;
my $contents;
- my $writer = XML::Writer->new(OUTPUT => \$contents, ENCODING => "UTF-8");
- $writer->startTag("methodCall");
- $writer->startTag("methodName");
+ my $writer = XML::Writer->new(OUTPUT => \$contents, ENCODING => 'UTF-8');
+ $writer->startTag('methodCall');
+ $writer->startTag('methodName');
$writer->characters($methodName);
- $writer->endTag("methodName");
- $writer->startTag("params");
- foreach my $param (@$params) {
- $writer->startTag("param");
+ $writer->endTag('methodName');
+ $writer->startTag('params');
+ for my $param (@$params) {
+ $writer->startTag('param');
$self->value($writer, $param);
- $writer->endTag("param");
+ $writer->endTag('param');
}
- $writer->endTag("params");
- $writer->endTag("methodCall");
+ $writer->endTag('params');
+ $writer->endTag('methodCall');
$writer->end();
- return $contents;
+ return encode('utf8', $contents);
}
sub get_response($$) {
my($self, $contents) = @_;
- return _get_response($self, { "url" => $self->url() . "/xmlrpc.cgi",
- "contentType" => "text/xml",
- "contents" => $contents });
+ return _get_response($self, { 'url' => $self->url() . '/xmlrpc.cgi',
+ 'contentType' => 'text/xml',
+ 'contents' => encode_utf8($contents) });
}
sub _get_response($$) {
my($self, $params) = @_;
- my $url = $params->{"url"};
- my $contentType = $params->{"contentType"};
- my $contents = $params->{"contents"};
- if (ref($contents) eq "ARRAY") {
+ my $url = $params->{'url'};
+ my $contentType = $params->{'contentType'};
+ my $contents = $params->{'contents'};
+ if (ref($contents) eq 'ARRAY') {
require URI;
my $uri = URI->new('http:');
$uri->query_form($contents);
@@ -171,9 +173,9 @@ sub _get_response($$) {
$logId = ++$counter;
require File::Spec;
my $fileName = File::Spec->catfile($logDir, "$$.$logId.request.log");
- if (open(my $fh, ">", $fileName)) {
- foreach my $header ($req->header_field_names()) {
- foreach my $value ($req->header($header)) {
+ if (open(my $fh, '>', $fileName)) {
+ for my $header ($req->header_field_names()) {
+ for my $value ($req->header($header)) {
print $fh "$header: $value\n";
}
}
@@ -190,9 +192,9 @@ sub _get_response($$) {
my $response = $res->is_success() ? $res->content() : undef;
if ($logDir) {
my $fileName = File::Spec->catfile($logDir, "$$.$logId.response.log");
- if (open(my $fh, ">", $fileName)) {
- foreach my $header ($res->header_field_names()) {
- foreach my $value ($res->header($header)) {
+ if (open(my $fh, '>', $fileName)) {
+ for my $header ($res->header_field_names()) {
+ for my $value ($res->header($header)) {
print $fh "$header: $value\n";
}
}
@@ -207,9 +209,9 @@ sub _get_response($$) {
my $msg = $res->status_line();
my $code = $res->code();
if ($code == 401) {
- $self->error("Authorization error, perhaps invalid user name and/or password", $code);
+ $self->error('Authorization error, perhaps invalid user name and/or password', $code);
} elsif ($code == 404) {
- $self->error("Bugzilla server not found, perhaps invalid URL.", $code);
+ $self->error('Bugzilla server not found, perhaps invalid URL.', $code);
} else {
$self->error("Unknown error: $msg", $code);
}
@@ -227,15 +229,15 @@ sub parse_response($$) {
sub request($%) {
my $self = shift;
my %args = @_;
- my $methodName = $args{"methodName"};
- $self->error("Missing argument: methodName") unless defined($methodName);
- my $params = $args{"params"};
- $self->error("Missing argument: params") unless defined($params);
- $self->error("Invalid argument: params (Expected array)") unless ref($params) eq "ARRAY";
+ my $methodName = $args{'methodName'};
+ $self->error('Missing argument: methodName') unless defined($methodName);
+ my $params = $args{'params'};
+ $self->error('Missing argument: params') unless defined($params);
+ $self->error('Invalid argument: params (Expected array)') unless ref($params) eq 'ARRAY';
my $contents = $self->create_request($methodName, $params);
- $self->log("debug", "BZ::Client::XMLRPC::request: Sending method $methodName to " . $self->url());
+ $self->log('debug', "BZ::Client::XMLRPC::request: Sending method $methodName to " . $self->url());
my $response = $self->get_response($contents);
- $self->log("debug", "BZ::Client::XMLRPC::request: Got result for method $methodName");
+ $self->log('debug', "BZ::Client::XMLRPC::request: Got result for method $methodName");
return $self->parse_response($response);
}
@@ -299,8 +301,8 @@ sub new($$) {
=head1 SYNOPSIS
- my $xmlrpc = BZ::Client::XMLRPC->new("url" => $url);
- my $result = $xmlrpc->request("methodName" => $methodName, "params" => $params);
+ my $xmlrpc = BZ::Client::XMLRPC->new('url' => $url);
+ my $result = $xmlrpc->request('methodName' => $methodName, 'params' => $params);
An instance of BZ::Client::XMLRPC is able to perform XML-RPC calls against the
given URL. A request is performed by passing the method name and the method
@@ -312,7 +314,7 @@ This section lists the possible class methods.
=head2 new
- my $xmlrpc = BZ::Client::XMLRPC->new("url" => $url);
+ my $xmlrpc = BZ::Client::XMLRPC->new('url' => $url);
Creates a new instance with the given URL.
@@ -329,7 +331,7 @@ Returns or sets the XML-RPC servers URL.
=head2 request
- my $result = $xmlrpc->request("methodName" => $methodName, "params" => $params);
+ my $result = $xmlrpc->request('methodName' => $methodName, 'params' => $params);
Calls the XML-RPC servers method C<$methodCall>, passing the parameters given by
C<$params>, an array of parameters. Parameters may be hash refs, array refs, or
@@ -1,3 +1,5 @@
+#!/bin/false
+
#
# BZ::Client.pm - Web services client for the Bugzilla server
#
@@ -7,13 +9,12 @@ package BZ::Client;
use BZ::Client::XMLRPC();
use HTTP::Cookies();
-our $VERSION = '1.04';
-
+our $VERSION = '1.061';
sub new($%) {
my $class = shift;
- my $self = { @_ };
- bless($self, ref($class) || $class);
+ my $self = {@_};
+ bless( $self, ref($class) || $class );
return $self;
}
@@ -21,7 +22,8 @@ sub url($;$) {
my $self = shift;
if (@_) {
$self->{'url'} = shift;
- } else {
+ }
+ else {
return $self->{'url'};
}
}
@@ -30,7 +32,8 @@ sub user($;$) {
my $self = shift;
if (@_) {
$self->{'user'} = shift;
- } else {
+ }
+ else {
return $self->{'user'};
}
}
@@ -39,41 +42,46 @@ sub password($;$) {
my $self = shift;
if (@_) {
$self->{'password'} = shift;
- } else {
+ }
+ else {
return $self->{'password'};
}
}
sub error($$;$$) {
- my($self, $message, $http_code, $xmlrpc_code) = @_;
+ my ( $self, $message, $http_code, $xmlrpc_code ) = @_;
require BZ::Client::Exception;
- BZ::Client::Exception->throw(message => $message,
- http_code => $http_code,
- xmlrpc_code => $xmlrpc_code);
+ BZ::Client::Exception->throw(
+ message => $message,
+ http_code => $http_code,
+ xmlrpc_code => $xmlrpc_code
+ );
}
sub log($$$) {
- my($self, $level, $msg) = @_;
+ my ( $self, $level, $msg ) = @_;
my $logger = $self->logger();
if ($logger) {
- &$logger($level, $msg);
+ &$logger( $level, $msg );
}
}
sub logger($;$) {
- my($self) = shift;
+ my ($self) = shift;
if (@_) {
$self->{'logger'} = shift;
- } else {
+ }
+ else {
return $self->{'logger'};
}
}
sub logDirectory($;$) {
- my($self) = shift;
+ my ($self) = shift;
if (@_) {
$self->{'logDirectory'} = shift;
- } else {
+ }
+ else {
return $self->{'logDirectory'};
}
}
@@ -82,13 +90,15 @@ sub xmlrpc($;$) {
my $self = shift;
if (@_) {
$self->{'xmlrpc'} = shift;
- } else {
+ }
+ else {
my $xmlrpc = $self->{'xmlrpc'};
- if (!$xmlrpc) {
- my $url = $self->url() || $self->error("The Bugzilla servers URL is not set.");
- $xmlrpc = BZ::Client::XMLRPC->new("url" => $url);
- $xmlrpc->logDirectory($self->logDirectory());
- $xmlrpc->logger($self->logger());
+ if ( !$xmlrpc ) {
+ my $url = $self->url()
+ || $self->error('The Bugzilla servers URL is not set.');
+ $xmlrpc = BZ::Client::XMLRPC->new( 'url' => $url );
+ $xmlrpc->logDirectory( $self->logDirectory() );
+ $xmlrpc->logger( $self->logger() );
$self->xmlrpc($xmlrpc);
}
return $xmlrpc;
@@ -97,59 +107,79 @@ sub xmlrpc($;$) {
sub login($) {
my $self = shift;
- my $user = $self->user() || $self->error("The Bugzilla servers user name is not set.");
- my $password = $self->password() || $self->error("The Bugzilla servers password is not set.");
-
- my $params = { "login" => $user,
- "password" => $password,
- "remember" => BZ::Client::XMLRPC::boolean->new(0) };
+ my $user = $self->user()
+ or $self->error('The Bugzilla servers user name is not set.');
+ my $password = $self->password()
+ or $self->error('The Bugzilla servers password is not set.');
+
+ my $params = {
+ 'login' => $user,
+ 'password' => $password,
+ 'remember' => BZ::Client::XMLRPC::boolean->new(0)
+ };
my $cookies = HTTP::Cookies->new();
- my $response = $self->_api_call("User.login", $params, $cookies);
- if (!defined($response->{'id'}) || $response->{'id'} !~ /^\d+$/s) {
- $self->error("Server did not return a valid user ID.");
+ my $response = $self->_api_call( 'User.login', $params, $cookies );
+ if ( not defined( $response->{'id'} )
+ or $response->{'id'} !~ m/^\d+$/s )
+ {
+ $self->error('Server did not return a valid user ID.');
}
- $self->{"cookies"} = $cookies;
+ $self->{'cookies'} = $cookies;
+
return;
}
sub logout($) {
- my $self = shift;
- my $cookies = $self->{"cookies"};
+ my $self = shift;
+ my $cookies = $self->{'cookies'};
if ($cookies) {
- $self->{"cookies"} = undef;
+ $self->{'cookies'} = undef;
my $xmlrpc = $self->xmlrpc();
- $xmlrpc->request("methodName" => "User.logout", params => [] );
+ $xmlrpc->request( 'methodName' => 'User.logout', params => [] );
}
}
sub is_logged_in($) {
my $self = shift;
- return $self->{"cookies"} ? 1 : 0;
+ return ( $self->{'cookies'} or $self->{'payload'} ) ? 1 : 0;
}
sub api_call($$$) {
- my($self, $methodName, $params) = @_;
- if (!$self->is_logged_in()) {
+ my ( $self, $methodName, $params ) = @_;
+ if ( !$self->is_logged_in() ) {
$self->login();
}
- return $self->_api_call($methodName, $params);
+ return $self->_api_call( $methodName, $params );
}
sub _api_call($$$;$) {
- my($self, $methodName, $params, $cookies) = @_;
- $self->log("debug", "BZ::Client::_api_call, sending request for method $methodName to " . $self->url());
+
+ my ( $self, $methodName, $params, $cookies ) = @_;
+
+ $self->log( 'debug',
+ "BZ::Client::_api_call, sending request for method $methodName to "
+ . $self->url() );
+
my $xmlrpc = $self->xmlrpc();
+
if ($cookies) {
$xmlrpc->user_agent()->cookie_jar($cookies);
}
- my $response = $xmlrpc->request("methodName" => $methodName, params => [ $params ] );
- if (!$response) {
- $self->error("Empty response from server.");
+
+ my $response =
+ $xmlrpc->request( 'methodName' => $methodName, params => [$params] );
+
+ if ( not $response ) {
+ $self->error('Empty response from server.');
}
- if (ref($response) ne "HASH") {
+
+ if ( ref($response) ne 'HASH' ) {
$self->error("Invalid response from server: $response");
}
- $self->log("debug", "BZ::Client::_api_call, got response for method $methodName");
+
+ $self->log( 'debug',
+ "BZ::Client::_api_call, got response for method $methodName" );
+
return $response;
}
@@ -182,6 +212,10 @@ The new method constructs a new instance of BZ::Client. Whenever you
want to connect to the Bugzilla server, you must first create a
Bugzilla client. The methods input is a hash of parameters.
+For debuggign, you can pass in a subref named I<logger> which will be
+fed debugging information as the client works. Also the I<logDirectory>
+option is a directory where the raw http content will be dumped.
+
=over
=item url
@@ -242,4 +276,4 @@ hash ref of named result objects.
=head1 SEE ALSO
L<BZ::Client::Exception>
-
+
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/t/01load.t b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/t/01load.t
old mode 100755
new mode 100644
@@ -48,7 +48,7 @@ sub parse_error($) {
sub TestBasic() {
my $doc = <<"EOF";
-<methodResponse>
+<methodResponse>
<params>
<param>
<value><string>South Dakota</string></value>
@@ -61,7 +61,7 @@ EOF
sub TestStrings() {
my $doc = <<"EOF";
-<methodResponse>
+<methodResponse>
<params>
<param>
<value>
@@ -95,7 +95,7 @@ EOF
my $res2 = $result->[2];
if ("DateTime" ne ref($res2)){
return "Expected DateTime, got ". ref($res2);
- }
+ }
if ($res2->year != 2011){
return "Expected year 2022, got " . $res2-> year();
}
@@ -117,13 +117,13 @@ EOF
if ($res2->time_zone->name() ne 'UTC'){
return "Expectead timezone UTC, got " . $res2->time_zone->name();
}
-
+
return undef;
}
sub TestStructure() {
my $doc = <<"EOF";
-<methodResponse>
+<methodResponse>
<params>
<param>
<value>
@@ -162,7 +162,7 @@ EOF
sub TestFault() {
my $doc = <<"EOF";
-<methodResponse>
+<methodResponse>
<fault>
<value>
<struct>
@@ -8,7 +8,7 @@ use DateTime();
use Test;
-my $tz =DateTime::TimeZone->new(name => 'CET');
+my $tz = DateTime::TimeZone->new(name => 'CET');
die 'Unable to create CET timezone' unless $tz;
my $now = DateTime->new(
year => 2011,
@@ -23,11 +23,11 @@ my $now = DateTime->new(
sub TestBasic() {
my $xmlrpc = BZ::Client::XMLRPC->new();
- my $input = [ "123", BZ::Client::XMLRPC::int->new(345),
- BZ::Client::XMLRPC::double->new(4.6), [ "a", "b", "c" ],
+ my $input = [ '123', BZ::Client::XMLRPC::int->new(345),
+ BZ::Client::XMLRPC::double->new(4.6), [ 'a', 'b', 'c' ],
scalar($now),
- { "a" => BZ::Client::XMLRPC::int->new(0), "b" => "xyz" } ];
- my $contents = $xmlrpc->create_request("someMethod", $input);
+ { 'a' => BZ::Client::XMLRPC::int->new(0), 'b' => 'xyz' } ];
+ my $contents = $xmlrpc->create_request('someMethod', $input);
my $expect =
"<methodCall>"
. "<methodName>someMethod</methodName>"
@@ -62,7 +62,7 @@ sub TestBasic() {
. "</value>"
. "</param>"
. "</params>"
- ."</methodCall>\n";
+ ."</methodCall>\n";
if ($contents ne $expect) {
print STDERR "Expect: $expect\n";
print STDERR "Got: $contents\n";
@@ -73,8 +73,8 @@ sub TestBasic() {
sub TestGetProducts() {
my $xmlrpc = BZ::Client::XMLRPC->new();
- my $input = [ { "ids" => [ "0", "1", "2" ] } ];
- my $contents = $xmlrpc->create_request("Product.get", $input);
+ my $input = [ { 'ids' => [ '0', '1', '2' ] } ];
+ my $contents = $xmlrpc->create_request('Product.get', $input);
my $expect =
"<methodCall>"
. "<methodName>Product.get</methodName>"
@@ -90,7 +90,7 @@ sub TestGetProducts() {
. "</value>"
. "</param>"
. "</params>"
- ."</methodCall>\n";
+ ."</methodCall>\n";
if ($contents ne $expect) {
print STDERR "Expect: $expect\n";
print STDERR "Got: $contents\n";
@@ -100,6 +100,6 @@ sub TestGetProducts() {
}
plan(tests => 2);
-ok(TestBasic(), 1, "TestBasic");
-ok(TestGetProducts(), 1, "TestGetProducts");
+ok(TestBasic(), 1, 'TestBasic');
+ok(TestGetProducts(), 1, 'TestGetProducts');
@@ -1,7 +1,7 @@
#!/usr/bin/perl -w
use strict;
-use warnings "all";
+use warnings 'all';
use BZ::Client::Test();
use Test;
@@ -19,10 +19,10 @@ sub TestBasic() {
};
if ($@) {
my $err = $@;
- if (ref($err) eq "BZ::Client::Exception") {
- print STDERR "Error: " . (defined($err->http_code()) ? $err->http_code() : "undef")
- . ", " . (defined($err->xmlrpc_code()) ? $err->xmlrpc_code() : "undef")
- . ", " . (defined($err->message()) ? $err->message() : "undef") . "\n";
+ if (ref($err) eq 'BZ::Client::Exception') {
+ print STDERR 'Error: ' . (defined($err->http_code()) ? $err->http_code() : 'undef')
+ . ', ' . (defined($err->xmlrpc_code()) ? $err->xmlrpc_code() : 'undef')
+ . ', ' . (defined($err->message()) ? $err->message() : 'undef') . "\n";
} else {
print STDERR "Error $err\n";
}
@@ -36,10 +36,10 @@ sub TestBasic() {
};
if ($@) {
my $err = $@;
- if (ref($err) eq "BZ::Client::Exception") {
- print STDERR "Error: " . (defined($err->http_code()) ? $err->http_code() : "undef")
- . ", " . (defined($err->xmlrpc_code()) ? $err->xmlrpc_code() : "undef")
- . ", " . (defined($err->message()) ? $err->message() : "undef") . "\n";
+ if (ref($err) eq 'BZ::Client::Exception') {
+ print STDERR 'Error: ' . (defined($err->http_code()) ? $err->http_code() : 'undef')
+ . ', ' . (defined($err->xmlrpc_code()) ? $err->xmlrpc_code() : 'undef')
+ . ', ' . (defined($err->message()) ? $err->message() : 'undef') . "\n";
} else {
print STDERR "Error $err\n";
}
@@ -53,12 +53,12 @@ sub TestBasic() {
plan(tests => 1);
-$tester = BZ::Client::Test->new(["config.pl", "t/config.pl"]);
+$tester = BZ::Client::Test->new(['config.pl', 't/config.pl']);
my $skipping;
if ($tester->isSkippingIntegrationTests()) {
- $skipping = "No Bugzilla server configured, skipping";
+ $skipping = 'No Bugzilla server configured, skipping';
} else {
$skipping = 0;
}
-skip($skipping, \&TestBasic, 1, "TestBasic");
+skip($skipping, \&TestBasic, 1, 'TestBasic');
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/t/21products.t b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/t/21products.t
old mode 100755
new mode 100644
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/t/22bugs.t b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/t/22bugs.t
old mode 100755
new mode 100644
diff --git a/var/tmp/source/JWIED/BZ-Client-1.04/BZ-Client-1.04/t/23bugzilla.t b/var/tmp/source/DJZORT/BZ-Client-1.061/BZ-Client-1.061/t/23bugzilla.t
old mode 100755
new mode 100644