Last change
on this file since 158 was
158,
checked in by nanardon, 13 years ago
|
- factorize xml::rpc test code
- add functions to test xml::rpc results (ie xml::rpc error code)
|
File size:
788 bytes
|
Rev | Line | |
---|
[158] | 1 | use strict; |
---|
| 2 | use warnings; |
---|
| 3 | use RPC::XML::Parser; |
---|
| 4 | use HTTP::Request; |
---|
| 5 | |
---|
| 6 | sub xmlrpcreq { |
---|
| 7 | my (@xmlargs) = @_; |
---|
| 8 | my $str = RPC::XML::request->new( @xmlargs )->as_string; |
---|
| 9 | |
---|
| 10 | my $req = HTTP::Request->new( POST => 'http://localhost/rpc' ); |
---|
| 11 | $req->header( 'Content-Length' => length($str) ); |
---|
| 12 | $req->header( 'Content-Type' => 'text/xml' ); |
---|
| 13 | $req->content( $str ); |
---|
| 14 | return $req; |
---|
| 15 | } |
---|
| 16 | |
---|
| 17 | sub xmlrequest { |
---|
| 18 | my @args = @_; |
---|
| 19 | |
---|
| 20 | my $res = request(xmlrpcreq(@args)); |
---|
| 21 | $res->is_success or return; |
---|
| 22 | |
---|
| 23 | my $data = RPC::XML::Parser->new->parse( $res->content )->value->value; |
---|
| 24 | |
---|
| 25 | return $data; |
---|
| 26 | } |
---|
| 27 | |
---|
| 28 | sub xmlrequest_ok { |
---|
| 29 | my (@args) = @_; |
---|
| 30 | my $data = xmlrequest(@args) or return; |
---|
| 31 | |
---|
| 32 | if (ref $data eq 'HASH') { |
---|
| 33 | exists($data->{faultString}) and return; |
---|
| 34 | } |
---|
| 35 | |
---|
| 36 | 1; |
---|
| 37 | } |
---|
| 38 | |
---|
| 39 | 1; |
---|
Note: See
TracBrowser
for help on using the repository browser.