summaryrefslogtreecommitdiffstats
path: root/qa/t/lib/QA/RPC/JSONRPC.pm
diff options
context:
space:
mode:
Diffstat (limited to 'qa/t/lib/QA/RPC/JSONRPC.pm')
-rw-r--r--qa/t/lib/QA/RPC/JSONRPC.pm192
1 files changed, 99 insertions, 93 deletions
diff --git a/qa/t/lib/QA/RPC/JSONRPC.pm b/qa/t/lib/QA/RPC/JSONRPC.pm
index 4175b10fc..1e43e9eaf 100644
--- a/qa/t/lib/QA/RPC/JSONRPC.pm
+++ b/qa/t/lib/QA/RPC/JSONRPC.pm
@@ -11,24 +11,26 @@ package QA::RPC::JSONRPC;
use strict;
use QA::RPC;
-BEGIN {
- our @ISA = qw(QA::RPC);
- if (eval { require JSON::RPC::Client }) {
- push(@ISA, 'JSON::RPC::Client');
- }
- else {
- require JSON::RPC::Legacy::Client;
- push(@ISA, 'JSON::RPC::Legacy::Client');
- }
+BEGIN {
+ our @ISA = qw(QA::RPC);
+
+ if (eval { require JSON::RPC::Client }) {
+ push(@ISA, 'JSON::RPC::Client');
+ }
+ else {
+ require JSON::RPC::Legacy::Client;
+ push(@ISA, 'JSON::RPC::Legacy::Client');
+ }
}
use URI::Escape;
use constant DATETIME_REGEX => qr/^\d{4}-\d\d-\d\dT\d\d:\d\d:\d\dZ$/;
+
sub TYPE {
- my ($self) = @_;
- return $self->bz_get_mode ? 'JSON-RPC GET' : 'JSON-RPC';
+ my ($self) = @_;
+ return $self->bz_get_mode ? 'JSON-RPC GET' : 'JSON-RPC';
}
#################################
@@ -36,85 +38,88 @@ sub TYPE {
#################################
sub ua {
- my $self = shift;
- if ($self->{ua} and not $self->{ua}->isa('QA::RPC::UserAgent')) {
- bless $self->{ua}, 'QA::RPC::UserAgent';
- }
- return $self->SUPER::ua(@_);
+ my $self = shift;
+ if ($self->{ua} and not $self->{ua}->isa('QA::RPC::UserAgent')) {
+ bless $self->{ua}, 'QA::RPC::UserAgent';
+ }
+ return $self->SUPER::ua(@_);
}
sub transport { $_[0]->ua }
sub bz_get_mode {
- my ($self, $value) = @_;
- $self->{bz_get_mode} = $value if @_ > 1;
- return $self->{bz_get_mode};
+ my ($self, $value) = @_;
+ $self->{bz_get_mode} = $value if @_ > 1;
+ return $self->{bz_get_mode};
}
sub _bz_callback {
- my ($self, $value) = @_;
- $self->{bz_callback} = $value if @_ > 1;
- return $self->{bz_callback};
+ my ($self, $value) = @_;
+ $self->{bz_callback} = $value if @_ > 1;
+ return $self->{bz_callback};
}
sub call {
- my $self = shift;
- my ($method, $args) = @_;
- my %params = ( method => $method );
- $params{params} = $args ? [$args] : [];
-
- my $config = $self->bz_config;
- my $url = $config->{browser_url} . "/"
- . $config->{bugzilla_installation} . "/jsonrpc.cgi";
- my $result;
- if ($self->bz_get_mode) {
- my $method_escaped = uri_escape($method);
- $url .= "?method=$method_escaped";
- if (my $cred = $self->_bz_credentials) {
- $args->{Bugzilla_login} = $cred->{user}
- if !exists $args->{Bugzilla_login};
- $args->{Bugzilla_password} = $cred->{pass}
- if !exists $args->{Bugzilla_password};
- }
- if ($args) {
- my $params_json = $self->json->encode($args);
- my $params_escaped = uri_escape($params_json);
- $url .= "&params=$params_escaped";
- }
- if ($self->version eq '1.1') {
- $url .= "&version=1.1";
- }
- my $callback = delete $args->{callback};
- if (defined $callback) {
- $self->_bz_callback($callback);
- $url .= "&callback=" . uri_escape($callback);
- }
- $result = $self->SUPER::call($url);
+ my $self = shift;
+ my ($method, $args) = @_;
+ my %params = (method => $method);
+ $params{params} = $args ? [$args] : [];
+
+ my $config = $self->bz_config;
+ my $url
+ = $config->{browser_url} . "/"
+ . $config->{bugzilla_installation}
+ . "/jsonrpc.cgi";
+ my $result;
+ if ($self->bz_get_mode) {
+ my $method_escaped = uri_escape($method);
+ $url .= "?method=$method_escaped";
+ if (my $cred = $self->_bz_credentials) {
+ $args->{Bugzilla_login} = $cred->{user} if !exists $args->{Bugzilla_login};
+ $args->{Bugzilla_password} = $cred->{pass}
+ if !exists $args->{Bugzilla_password};
}
- else {
- $result = $self->SUPER::call($url, \%params);
+ if ($args) {
+ my $params_json = $self->json->encode($args);
+ my $params_escaped = uri_escape($params_json);
+ $url .= "&params=$params_escaped";
}
-
- if ($result) {
- bless $result, 'QA::RPC::JSONRPC::ReturnObject';
+ if ($self->version eq '1.1') {
+ $url .= "&version=1.1";
+ }
+ my $callback = delete $args->{callback};
+ if (defined $callback) {
+ $self->_bz_callback($callback);
+ $url .= "&callback=" . uri_escape($callback);
}
- return $result;
+ $result = $self->SUPER::call($url);
+ }
+ else {
+ $result = $self->SUPER::call($url, \%params);
+ }
+
+ if ($result) {
+ bless $result, 'QA::RPC::JSONRPC::ReturnObject';
+ }
+ return $result;
}
sub _get {
- my $self = shift;
- my $result = $self->SUPER::_get(@_);
- # Simple JSONP support for tests. We just remove the callback from
- # the return value.
- my $callback = $self->_bz_callback;
- if (defined $callback and $result->is_success) {
- my $content = $result->content;
- $content =~ s/^(?:\/\*\*\/)?\Q$callback(\E(.*)\)$/$1/s;
- $result->content($content);
- # We don't need this anymore, and we don't want it to affect
- # future calls.
- delete $self->{bz_callback};
- }
- return $result;
+ my $self = shift;
+ my $result = $self->SUPER::_get(@_);
+
+ # Simple JSONP support for tests. We just remove the callback from
+ # the return value.
+ my $callback = $self->_bz_callback;
+ if (defined $callback and $result->is_success) {
+ my $content = $result->content;
+ $content =~ s/^(?:\/\*\*\/)?\Q$callback(\E(.*)\)$/$1/s;
+ $result->content($content);
+
+ # We don't need this anymore, and we don't want it to affect
+ # future calls.
+ delete $self->{bz_callback};
+ }
+ return $result;
}
1;
@@ -123,13 +128,13 @@ package QA::RPC::JSONRPC::ReturnObject;
use strict;
BEGIN {
- if (eval { require JSON::RPC::Client }) {
- our @ISA = qw(JSON::RPC::ReturnObject);
- }
- else {
- require JSON::RPC::Legacy::Client;
- our @ISA = qw(JSON::RPC::Legacy::ReturnObject);
- }
+ if (eval { require JSON::RPC::Client }) {
+ our @ISA = qw(JSON::RPC::ReturnObject);
+ }
+ else {
+ require JSON::RPC::Legacy::Client;
+ our @ISA = qw(JSON::RPC::Legacy::ReturnObject);
+ }
}
#################################
@@ -137,8 +142,8 @@ BEGIN {
#################################
sub faultstring { $_[0]->{content}->{error}->{message} }
-sub faultcode { $_[0]->{content}->{error}->{code} }
-sub fault { $_[0]->is_error }
+sub faultcode { $_[0]->{content}->{error}->{code} }
+sub fault { $_[0]->is_error }
1;
@@ -151,18 +156,19 @@ use base qw(LWP::UserAgent);
########################################
sub send_request {
- my $self = shift;
- my $response = $self->SUPER::send_request(@_);
- $self->http_response($response);
- # JSON::RPC::Client can't handle 500 responses, even though
- # they're required by the JSON-RPC spec.
- $response->code(200);
- return $response;
+ my $self = shift;
+ my $response = $self->SUPER::send_request(@_);
+ $self->http_response($response);
+
+ # JSON::RPC::Client can't handle 500 responses, even though
+ # they're required by the JSON-RPC spec.
+ $response->code(200);
+ return $response;
}
# Copied directly from SOAP::Lite::Transport::HTTP.
sub http_response {
- my $self = shift;
- if (@_) { $self->{'_http_response'} = shift; return $self }
- return $self->{'_http_response'};
+ my $self = shift;
+ if (@_) { $self->{'_http_response'} = shift; return $self }
+ return $self->{'_http_response'};
}
generated by cgit v1.2.3-24-g4f1b (git 2.32.0) at 2024-05-03 10:41:13 +0200