1#!/usr/bin/perl 2# Example of Document SOAP. 3# Same code as has_wsdl.t, but now without comments and in short notation. 4 5# Thanks to Thomas Bayer, for providing this service 6# See http://www.thomas-bayer.com/names-service/ 7 8# Author: Mark Overmeer, 27 Nov 2007 9# Using: XML::Compile 0.60 10# XML::Compile::SOAP 0.63 11# Copyright by the Author, under the terms of Perl itself. 12# Feel invited to contribute your examples! 13 14use warnings; 15use strict; 16 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) getNameInfo 62 3) getNamesInCountry 63 Q) quit demo 64 65__SELECTOR 66 67 $answer = $term->readline("Pick one of above [1/2/3/Q] "); 68 chomp $answer; 69 70 if($answer eq '1') { get_countries() } 71 elsif($answer eq '2') { get_name_info() } 72 elsif($answer eq '3') { get_names_in_country() } 73 elsif(lc $answer ne 'q' && length $answer) 74 { print "Illegal choice\n"; 75 } 76} 77 78exit 0; 79 80# 81# Get Countries 82# 83 84sub get_countries() 85{ 86 my $getCountries = $wsdl->compileClient('getCountries'); 87 my $answer = $getCountries->(); 88 89 if(my $fault_raw = $answer->{Fault}) 90 { my $fault_nice = $answer->{$fault_raw->{_NAME}}; 91 die "Cannot get list of countries: $fault_nice->{reason}\n"; 92 } 93 94 my $countries = $answer->{parameters}{country}; 95 96 print "getCountries() lists ".scalar(@$countries)." countries:\n"; 97 foreach my $country (sort @$countries) 98 { print " $country\n"; 99 } 100} 101 102# 103# Get Name Info 104# 105 106sub get_name_info() 107{ 108 my $name = $term->readline("Personal name for info: "); 109 chomp $name; 110 length $name or return; 111 112 my $getNameInfo = $wsdl->compileClient('getNameInfo'); 113 my $answer = $getNameInfo->(name => $name); 114 115 die "Lookup for '$name' failed: $answer->{Fault}{faultstring}\n" 116 if $answer->{Fault}; 117 118 my $nameinfo = $answer->{parameters}{nameinfo}; 119 print "The name '$nameinfo->{name}' is\n"; 120 print " male: ", ($nameinfo->{male} ? 'yes' : 'no'), "\n"; 121 print " female: ", ($nameinfo->{female} ? 'yes' : 'no'), "\n"; 122 print " gender: $nameinfo->{gender}\n"; 123 print "and used in countries:\n"; 124 125 $format_list = join ', ', @{$nameinfo->{countries}{country}}; 126 write; 127} 128 129# 130# Get Names In Country 131# 132 133sub get_names_in_country() 134{ my $getCountries = $wsdl->compileClient('getCountries'); 135 my $getNamesInCountry = $wsdl->compileClient('getNamesInCountry'); 136 137 my $answer1 = $getCountries->(); 138 die "Cannot get countries: $answer1->{Fault}{faultstring}\n" 139 if $answer1->{Fault}; 140 141 my $countries = $answer1->{parameters}{country}; 142 143 my $country; 144 while(1) 145 { $country = $term->readline("Most common names in which country? "); 146 chomp $country; 147 $country eq '' or last; 148 print " please specify a country name.\n"; 149 } 150 151 # find the name case-insensitive in the list of available countries 152 my $name = first { /^\Q$country\E$/i } @$countries; 153 154 unless($name) 155 { $name = 'other countries'; 156 print "Cannot find name '$country', defaulting to '$name'\n"; 157 print "Available countries are:\n"; 158 $format_list = join ', ', @$countries; 159 write; 160 } 161 162 print "Most common names in $name:\n"; 163 my $answer2 = $getNamesInCountry->(country => $name); 164 die "Cannot get names in country: $answer2->{Fault}{faultstring}\n" 165 if $answer2->{Fault}; 166 167 my $names = $answer2->{parameters}{name}; 168 $names 169 or die "No data available for country `$name'\n"; 170 171 $format_list = join ', ', @$names; 172 write; 173} 174 175