Soap test in Outblaze


/ Published in: Perl
Save to your folder(s)



Copy this code and paste it in your HTML
  1. #!/usr/bin/perl -w
  2. use SOAP::Lite;
  3. use CGI;
  4. use SoapAccess;
  5. use strict;
  6. use Data::Dumper;
  7. main();
  8. exit 0;
  9.  
  10. sub main {
  11.  
  12. my ($soap_res, $res);
  13. my ($element, $key, $count);
  14. my ($reqrv, $reqres, $rv, $result, $function, %resultH, @params);
  15. my $type = 1;
  16.  
  17. # **********************************
  18. # URI = "urn:adminTool"
  19. # *********************************
  20. # my $SOAP_SERVER = "partnertest.hk1.outblaze.com";
  21. my $SOAP_SERVER = "stagerm.outblaze.com";
  22. # my $SOAP_SERVER = "resellertool1.hk1.outblaze.com";
  23. # my $SOAP_SERVER = "rm.cl.outblaze.com";
  24. # my $SOAP_SERVER = "devrm.outblaze.com";
  25. # my $SOAP_SERVER = "reseller3.us4.outblaze.com";
  26. # my $SOAP_SERVER = "rm.hk2.outblaze.com";
  27. # my $SOAP_SERVER = "rm.us4.outblaze.com";
  28. my $SOAP_PROXY = "http://$SOAP_SERVER/ob/servlet/rpcrouter";
  29. my $URI = "urn:adminTool";
  30.  
  31. $function = "getCobrandServerInterface";
  32. push @params, "namespace";
  33. push @params, "gusv5test14.outblaze.com";
  34. push @params, "5";
  35. unless ($function) {
  36. print "No function given";
  37. exit 0;
  38. }
  39.  
  40. my $soap = new SoapAccess($URI, $SOAP_PROXY);
  41. ($type == 1)
  42. and ($reqrv, $reqres, $rv, $res, $result) = $soap->request($function, \@params);
  43. ($type == 2)
  44. and ($reqrv, $reqres, $rv, $res, %resultH) = $soap->request($function, \@params);
  45.  
  46. print "SOAP_SERVER = $SOAP_SERVER\n";
  47. print "function = $function\n";
  48. print Dumper(\@params);
  49.  
  50. print "========Result============\n";
  51. print "reqrv: $reqrv\n";
  52. print "reqres: $reqres\n";
  53. print "rv: $rv\n";
  54.  
  55.  
  56. #use MIME::Base64 qw(encode_base64 decode_base64);
  57. #my $a = $$rv{3711637}->{comment};
  58. #print decode_base64($a);
  59. #print $a;
  60. print "rv(Dumper): ".Dumper($rv);
  61. print "res: ".Dumper($res)."\n";
  62. ($type == 1)
  63. and print "result: ".Dumper($result)."\n";
  64. if ($type == 2) {
  65. print "result: ".Dumper(\%resultH)."\n";
  66. foreach my $key (keys %resultH) {
  67. print "$key -- " . CGI::unescape($resultH{$key}) . "\n";
  68. }
  69. }
  70. return 1;
  71. }
  72.  
  73.  
  74.  
  75. ##
  76. ###
  77. ### the definition of the package
  78. ####
  79. ###
  80. ###
  81.  
  82. #
  83. # Class stored function simplifing access to SOAP
  84. #
  85. package SoapAccess;
  86. use strict;
  87. use SOAP::Lite;
  88. use HTTP::Cookies;
  89. use Data::Dumper;
  90.  
  91. #
  92. # Constructor
  93. #
  94. # **********************
  95. # Parameters : $uri, string, soap uri to the remote machine
  96. # $proxy, string, url to call the soap request
  97. # $timeout, integer, number of second for the soap transport timeout (Default : 30)
  98. # $retry, integer, number of of times to retries for soap call failure (Default : 3)
  99. # Return : the object
  100. #
  101. sub new {
  102. my ($class, $uri, $proxy,$proxy_second, $timeout, $retry) = @_;
  103. print "uri = $uri \n";
  104. print "proxy = $proxy \n";
  105. print "$SOAP::soapretry\n";
  106. my $self = {
  107. "uri" => $uri,
  108. "proxy" => $proxy,
  109. "timeout" => $timeout || 40, # default timout 30 seconds
  110. "retry" => $retry || 1 , # default retry 3 times
  111. "proxy_second" => $proxy_second ,
  112. };
  113.  
  114. # Init the soap object
  115. eval {
  116. $self->{soapobj} = SOAP::Lite
  117. ->uri($self->{uri})
  118. ->proxy($self->{proxy}, cookie_jar => HTTP::Cookies->new(), timeout=>($self->{timeout}))
  119. };
  120. if ($@) {
  121. warn "Error initializing $proxy object: $@\n";
  122. }
  123. unless ($self->{soapobj}) {
  124. warn "Error initalizing soap object\n";
  125. return undef; #If soap obj creation failed, return error
  126. }
  127. bless $self, $class;
  128. }
  129.  
  130. #
  131. # submite the request
  132. #
  133. # *********************
  134. # Parameters : $function, string, name of the function you would call
  135. # @params, array, list of data you would pass to the function
  136. # Return : boolean, indicate if the call completed ok
  137. # string, description of what happened
  138. # array, list of data returned from the call
  139. #
  140. sub request {
  141. my ($self, $function, $params) = @_;
  142. my ($result);
  143.  
  144. # setup init values
  145. my $soapobj = $self->{soapobj};
  146. my $retry = $self->{retry};
  147. while ($retry) {
  148. eval {
  149. $result = $soapobj->$function(@$params);
  150. };
  151. # If result is good, terminate the call, otherwise, do another try
  152. $retry = ((defined $result) && (!$result->fault))?0:$retry-1;
  153. };
  154. if ($@ || (!defined $result) || $result->fault) {
  155. eval {
  156. $self->{soapobj_second} = SOAP::Lite
  157. ->uri($self->{uri})
  158. ->proxy($self->{proxy_second}, cookie_jar => HTTP::Cookies->new(), timeout=>($self->{timeout}))
  159. };
  160. if ($@) {
  161. warn "Error initalizing proxy_second object: $@\n";
  162. }
  163. $soapobj = $self->{soapobj_second} ;
  164. $retry = $self->{retry};
  165. while ($retry) {
  166. eval {
  167. $result = $soapobj->$function(@$params);
  168. };
  169. $retry = ((defined $result) && (!$result->fault))?0:$retry-1;
  170. } ;
  171.  
  172. if ($@ || (!defined $result) || $result->fault) {
  173.  
  174. if ($@) {
  175. return (0, "failed: $@\n");
  176. } elsif (defined $result && $result->fault) {
  177. return (0, "request failed : " . $result->faultcode . "." . $result->faultstring);
  178. } else {
  179. return (0, "unknown error, no result returned");
  180. } else {
  181. return (0, "unknown error, no result returned");
  182. }
  183. }
  184. }
  185. if (defined $result->fault) {
  186. return (0, "SOAP exception found: " . $result->faultcode . "." . $result->faultstring);
  187. }
  188. return (1, "ok", $result->result, $result->paramsout);
  189. }
  190.  
  191.  
  192. 1;
  193. ~

Report this snippet


Comments

RSS Icon Subscribe to comments

You need to login to post a comment.