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