view release on metacpan or  search on metacpan

t/lib/App/CamelPKI/Test.pm  view on Meta::CPAN

        $req->header("Content-type" => "application/json");
        $req->method("POST");
        ## FIXME: presumably passing the POST payload was supposed to
        ## be done like this,
        # $req->add_content(scalar(JSON::to_json($struct)));
        ## but that doesn't work... so we use a global variable instead!
        ## (see L<App::CamelPKI::Action::JSON>):
        $App::CamelPKI::Action::JSON::request_body_for_tests =
            JSON::to_json($struct);
    }
    my $response = Catalyst::Test::local_request("App::CamelPKI", $req);
    die sprintf("plain request at $url failed with code %d\n%s\n",
                $response->code, $response->content)
        unless $response->is_success;
    my $retval = eval { JSON::from_json($response->content) };
    return $retval if defined $retval;
    die $response;
}

=item I<jsonreq_remote ($url, $struct, %args)>

Sends $struct to a real Apache server at $url, which must be
fully-qualified.  Returns the response as an L<HTTP::Response> object.

Available named options are:

=over

=item I<< -certificate => $certobj >>

=item I<< -certificate => $certpem >>

The certificate to identify oneself as, as an L<App::CamelPKI::Certificate>
instance or PEM string.

=item I<< -key => $keyobj >>

=item I<< -key => $keypem >>

The private key to use along with the certificate, as an
L<App::CamelPKI::PrivateKey> instance or PEM string.

=back

=cut

sub jsonreq_remote {
    my ($url, $structure, @args) = @_;

    my $req = http_request_prepare($url, @args);
    $req->method("POST");
    $req->header("Content-Type" => "application/json");
    $req->content(scalar(JSON::to_json($structure)));
    $req->header("Accept" => "application/json");
    return http_request_execute($req, @args);
}

=item I<jsoncall_remote($url, $struct, %args)>

Like L</jsonreq_remote> but instead of returning an L<HTTP::Response>
object, returns the decoded JSON data structure by reference and
throws an exception if the HTTP request isn't a success or doesn't
decode properly.

=cut

sub jsoncall_remote {
    my $response = jsonreq_remote(@_);
    my $content = $response->content;
    die sprintf("jsoncall_remote: failed with code %d\n%s\n",
                $response->code, $content) if ! $response->is_success;
    my $retval = eval { JSON::from_json($content) };
    return $retval if defined $retval;
    die $content;
}

=item I<call_remote($url)>

Gets $url and return the result.

=cut

sub call_remote {
	my ($url, @args) = @_;
	my $ua = LWP::UserAgent->new;
	my $req = http_request_prepare($url, @args);
    my $res = http_request_execute($req, @args);
 	
 	my $content = $res->content;
 	die sprintf("call_remote: failed with code %d\n%s\n",
                $res->code, $content) if ! $res->is_success;
    return $content if defined $content;
    die $content;
 	
}

=item I<formreq_remote($url $struct, $button, @args)>

Call a form and fill it based on $struct, then push on $button

=cut
sub formreq_remote {
    my ($url, $structure, $button, @args) = @_;
    
	my $ua = LWP::UserAgent->new;
	my $req = http_request_prepare($url, @args);
    my $res = http_request_execute($req, @args);
    
    my $tree = HTML::TreeBuilder->new;
    $tree->parse($res->content);
    $tree->eof();
    
    my @Forms = $tree->find_by_tag_name('FORM');
    die "No forms in page" unless @Forms;
    my $f = HTTP::Request::Form->new($Forms[0], $url);
    foreach my $part (keys(%$structure)){
    	$f->field($part, $structure->{$part});
    }
    my $response = http_request_execute($f->press($button), @args);
    return $response;
}