view release on metacpan or  search on metacpan

lib/BZ/Client/XMLRPC.pm  view on Meta::CPAN

    my $contentType = $params->{'contentType'};
    my $contents = $params->{'contents'};
    if (ref($contents) eq 'ARRAY') {
        my $uri = URI->new('http:');
        $uri->query_form($contents);
        $contents = $uri->query();
    }

    my %options = (
        headers => {
            'Content-Type' => $contentType,
        },
        content => $contents, # carefull of the s
    );

    my $wa = $self->web_agent();

    my($logDir,$logId) = $self->logDirectory();

    if ($logDir) {
        $logId = ++$counter;
        my $fileName = File::Spec->catfile($logDir, "$$.$logId.request.log");
        if (open(my $fh, '>', $fileName)) {
            while (my($header,$value) = each %{$options{headers}} ) {
                print $fh "$header: $value\n";
            }
            print $fh 'user-agent: ', $wa->agent(), "\n";
            if ($wa->{cookie_jar}) {
                print $fh join("\n", $wa->{cookie_jar}->dump_cookies());
            }
            print $fh "\n";
            print $fh $contents;
            close($fh);
        }
    }

    my $res = $wa->request(POST => $url, \%options);
    my $response = $res->{success} ? $res->{content} : undef;
    if ($logDir) {
        my $fileName = File::Spec->catfile($logDir, "$$.$logId.response.log");
        if (open(my $fh, '>', $fileName)) {
            for my $header (sort keys %{$res->{headers}}) {
                my $value = $res->{headers}->{$header};
                if (ref $value) {
                    print $fh "$header: $_\n" for @$value;
                }
                else {
                    print $fh "$header: $value\n";
                }
            }
            print $fh "\n";
            print $fh $res->{content} if $res->{content};
            close($fh);
        }
    }
    if (!$res->{success}) {
        my $code = $res->{status};
        if ($code == 401) {
            $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);
        }
        else {
            my $msg = $res->{reason};
            $msg .= ' : ' . $res->{content} if $res->{content};
            $self->error("Unknown error: $msg", $code);
        }
    }

    return $response
}

sub parse_response {
    my($self, $contents) = @_;
    my $parser = BZ::Client::XMLRPC::Parser->new();
    return $parser->parse($contents)
}

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 $contents = $self->create_request($methodName, $params);
    $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");
    return $self->parse_response($response)
}

sub log {
    my($self, $level, $msg) = @_;
    my $logger = $self->logger();
    if ($logger) {
        &$logger($level, $msg);
    }
}

sub logger {
    my($self) = shift;
    if (@_) {
        $self->{'logger'} = shift;
    }
    else {
        return $self->{'logger'};
    }
}

sub logDirectory {
    my($self) = shift;
    if (@_) {
        $self->{'logDirectory'} = shift;
    }
    else {