1#!/usr/bin/perl 2# Example of Document SOAP. 3# Thanks to Thomas Bayer, for providing this service 4# See http://www.thomas-bayer.com/names-service/ 5 6# Author: Mark Overmeer, 6 Nov 2007 7# Using: XML::Compile 0.60 8# XML::Compile::SOAP 0.63 9# Copyright by the Author, under the terms of Perl itself. 10# Feel invited to contribute your examples! 11 12# Of course, all Perl programs start like this! 13use warnings; 14use strict; 15 16# All the other XML modules should be automatically included. 17use XML::Compile::WSDL11; 18use XML::Compile::SOAP11; 19use XML::Compile::Transport::SOAPHTTP; 20 21# Other useful modules 22use Data::Dumper; # Data::Dumper is your friend. 23$Data::Dumper::Indent = 1; 24 25use List::Util qw/first/; 26 27my $format_list; 28format = 29 ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ 30 $format_list 31. 32 33# Forward declarations 34sub get_countries($); 35sub get_name_info(); 36sub get_names_in_country(); 37 38#### MAIN 39 40use Term::ReadLine; 41my $term = Term::ReadLine->new('namesservice'); 42 43# 44# Get the WSDL and Schema definitions 45# 46 47my $wsdl = XML::Compile::WSDL11->new('namesservice.wsdl'); 48$wsdl->importDefinitions('namesservice.xsd'); 49 50# 51# Pick one of these tests 52# 53 54my $answer = ''; 55while(lc $answer ne 'q') 56{ 57 print <<__SELECTOR; 58 59 Which call do you like to see: 60 1) getCountries 61 2) getCountries with trace output 62 3) getNameInfo 63 4) getNamesInCountry 64 Q) quit demo 65 66__SELECTOR 67 68 $answer = $term->readline("Pick one of above [1/2/3/4/Q] "); 69 chomp $answer; 70 71 if($answer eq '1') { get_countries(0) } 72 elsif($answer eq '2') { get_countries(1) } 73 elsif($answer eq '3') { get_name_info() } 74 elsif($answer eq '4') { get_names_in_country() } 75 elsif(lc $answer ne 'q' && length $answer) 76 { print "Illegal choice\n"; 77 } 78} 79 80exit 0; 81 82# 83# First example 84# This one is explained in most detail 85# 86 87sub get_countries($) 88{ my $show_trace = shift; 89 90 # first compile a handler which you can call as often as you want. 91 # If you do not know the name of the portType, then just put anything 92 # here: the error message will list your options. 93 94 my $getCountries 95 = $wsdl->compileClient 96 ( 'getCountries' 97# , validate => 0 # unsafe but faster 98# , sloppy_integers => 1 # usually ok, faster 99 ); 100 101 # Actually, above is an abbreviation of 102 # = $wsdl->compileClient(operation => 'getCountries'); 103 # = $wsdl->find(operation => 'getCountries')->compileClient; 104 # You may need to go into more the extended syntaxes if you have multiple 105 # services, ports, bindings, or such in you WSDL file. Is so, the run-time 106 # will ask you to do so, offering alternatives. 107 108 # 109 # Call the produced method to list the supported countries 110 # 111 112 # According to the WSDL, the message has one body part, named 'parameters' 113 # When there can be confusion, you have to be more specific at the call 114 # of the method. When multiple header+body parts exist, use should group 115 # your data on part name. 116 117 my ($answer, $trace) 118 # = $getCountries->(Body => {parameters => {}}); 119 # = $getCountries->(parameters => {}); 120 = $getCountries->(); # is code-ref, so still needs ->() 121 122 # In above examples, the first explicitly addresses the 'parameters' 123 # message part in the Body of the SOAP message. There is also a Header. 124 # The second version can be used when all header and body parts have 125 # difference names. The last version can be used if there is only one 126 # body part defined. 127 128 # If you do not need the trace, simply say: 129 # my $answer = $getCountries->(); 130 131 # 132 # Some ways of debugging 133 # 134 135 if($show_trace) 136 { $trace->printTimings; 137 $trace->printErrors; 138 $trace->printRequest; 139 $trace->printResponse; 140 } 141 142 # And now? What do I get back? I love Data::Dumper. 143 # warn Dumper $answer; 144 145 # 146 # Handling faults 147 # 148 149 if(my $fault_raw = $answer->{Fault}) 150 { my $fault_nice = $answer->{$fault_raw->{_NAME}}; 151 152 # fault_raw points to the fault structure, which contains fields 153 # faultcode, faultstring, and unprocessed "detail" information. 154 # fault_nice points to the same information, but translated to 155 # something what is equivalent in SOAP1.1 and SOAP1.2. 156 157 die "Cannot get list of countries: $fault_nice->{reason}\n"; 158 159 # Have a look at Log::Report for cleaner (translatable) die: 160 # error __x"Cannot get list of countries: {reason}", 161 # reason => $fault_nice->{reason}; 162 } 163 164 # 165 # Collecting the country names 166 # 167 168 # According to the WSDL, the returned getCountriesResponse message 169 # has one part, named 'parameters'. The contents returned is a 170 # getCountriesResponse element of type complexType getCountriesResponse, 171 # both defined in the xsd file. 172 # The only data field is named 'country', and has a maxCount > 1 so 173 # will be translated by XML::Compile into an ARRAY. 174 # The received message is validated, so we do not need to check the 175 # structure ourselves again. 176 177 my $countries = $answer->{parameters}{country}; 178 179 print "getCountries() lists ".scalar(@$countries)." countries:\n"; 180 foreach my $country (sort @$countries) 181 { print " $country\n"; 182 } 183} 184 185# 186# Second example 187# 188 189sub get_name_info() 190{ 191 # ask the user for a name 192 my $name = $term->readline("Personal name for info: "); 193 chomp $name; 194 195 length $name or return; 196 197 # 198 # Ask information about the specified name 199 # (we are not using the country list, received before) 200 # 201 202 my $getNameInfo = $wsdl->compileClient('getNameInfo'); 203 204 my ($answer, $trace2) = $getNameInfo->(name => $name); 205 #print Dumper $answer, $trace2; 206 207 die "Lookup for '$name' failed: $answer->{Fault}{faultstring}\n" 208 if $answer->{Fault}; 209 210 my $nameinfo = $answer->{parameters}{nameinfo}; 211 print "The name '$nameinfo->{name}' is\n"; 212 print " male: ", ($nameinfo->{male} ? 'yes' : 'no'), "\n"; 213 print " female: ", ($nameinfo->{female} ? 'yes' : 'no'), "\n"; 214 print " gender: $nameinfo->{gender}\n"; 215 print "and used in countries:\n"; 216 217 $format_list = join ', ', @{$nameinfo->{countries}{country}}; 218 write; 219} 220 221# 222# Third example 223# 224 225sub get_names_in_country() 226{ # usually in the top of your script: reusable 227 my $getCountries = $wsdl->compileClient('getCountries'); 228 my $getNamesInCountry = $wsdl->compileClient('getNamesInCountry'); 229 230 my $answer1 = $getCountries->(); 231 die "Cannot get countries: $answer1->{Fault}{faultstring}\n" 232 if $answer1->{Fault}; 233 234 my $countries = $answer1->{parameters}{country}; 235 236 my $country; 237 while(1) 238 { $country = $term->readline("Most common names in which country? "); 239 chomp $country; 240 $country eq '' or last; 241 print " please specify a country name.\n"; 242 } 243 244 # find the name case-insensitive in the list of available countries 245 my $name = first { /^\Q$country\E$/i } @$countries; 246 247 unless($name) 248 { $name = 'other countries'; 249 print "Cannot find name '$country', defaulting to '$name'\n"; 250 print "Available countries are:\n"; 251 $format_list = join ', ', @$countries; 252 write; 253 } 254 255 print "Most common names in $name:\n"; 256 my $answer2 = $getNamesInCountry->(country => $name); 257 die "Cannot get names in country: $answer2->{Fault}{faultstring}\n" 258 if $answer2->{Fault}; 259 260 my $names = $answer2->{parameters}{name}; 261 $names 262 or die "No data available for country `$name'\n"; 263 264 $format_list = join ', ', @$names; 265 write; 266} 267 268