Updated 2012-09-16 14:44:45 by RLE

This demonstrates a simple accessor for the Google API using the TclSOAP package.

Try google spell "Larry Vriden" ;)

Is SOAP::WSDL a part of TclSOAP?

lexfiend 13 Feb 2006: It's in CVS on the dev branch, and is definitely not able to properly digest the more complex WSDL files at this time (for instance, it's unable to handle nested types that are prevalent in WSDL files from eBay and other major Web service providers). For a hack that does work, see my note in WSDL.

There is currently a bug in the TclDOM package. You might want to try
  package require dom::tclgeneric
  package require dom::tcl
  package provide dom 2.5

before you source this code.
 # Google.tcl - Copyright (C) 2003 Pat Thoyts <[email protected]>
 #
 # Provide a simple(ish) Tcl interface to the Google SOAP API.
 #
 # Try: google spell "Larry Vriden"
 #  or  google cache "http://wiki.tcl.tk/"
 #  or  google search "TclSOAP"
 #
 # -------------------------------------------------------------------------
 # This software is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 # or FITNESS FOR A PARTICULAR PURPOSE.  See the accompanying file `LICENSE'
 # for more details.
 # -------------------------------------------------------------------------
 #
 # @(#)$Id: 8322,v 1.8 2005/02/01 07:00:34 jcw Exp $
 
 package require SOAP
 package require uri
 package require base64
 
 # You need to register to use the Google SOAP API. You should put your key
 # into $HOME/.googlekey using the line:
 # set Key {0000000000000000}
 source [file join $env(HOME) .googlekey]
 
 # -------------------------------------------------------------------------
 
 proc google {cmd args} {
     global Key Toplevels
     switch -glob -- $cmd {
         se* {
             set r [eval [list googleQuery] $args]
         }
 
         sp* {
             set r [GoogleSearchService::doSpellingSuggestion \
                        $Key [lindex $args 0]]
         }
         
         c* {
             set url [lindex $args 0]
             set d [GoogleSearchService::doGetCachedPage $Key $url]
             set r [base64::decode $d]
         }
         default {
             usage
         }
     }
     return $r
 }
 
 proc googleQuery {args} {
     global Key
     array set opts {start 0 max 10 filter false restrict "" safe false lang ""}
     while {[string match -* [set option [lindex $args 0]]]} {
         switch -glob -- $option {
             -start {set opts(start) [Pop args 1]}
             -max   {set opts(max) [Pop args 1]}
             -filter {set opts(filter) [Pop args 1]}
             -restrict {set opts(filter) [Pop args 1]}
             -safe {set opts(safe) [Pop args 1]}
             -lang* {set opts(lang) [Pop args 1]}
             --     { Pop args; break }
             default {
                 set options [join [array names opts] ", -"]
                 return -code error "invalid option \"$option\":\
                     should be one of -$options"
             }
         }
         Pop args
     }
 
     set r [GoogleSearchService::doGoogleSearch $Key $args \
                $opts(start) $opts(max) $opts(filter) \
                $opts(restrict) $opts(safe) $opts(lang) utf-8 utf-8]
     return $r
 }
 
 proc Pop {varname {nth 0}} {
     upvar $varname args
     set r [lindex $args $nth]
     set args [lreplace $args $nth $nth]
     return $r
 }
 
 proc usage {} {
     puts stderr "usage: google search query"
     puts stderr "       google spell text"
     puts stderr "       google cache url"
     exit 1
 }
 
 proc set_useragent {{app {}}} {
     set ua "Mozilla/4.0 ([string totitle $::tcl_platform(platform)];\
         $::tcl_platform(os)) http/[package provide http]"
     if {[string length $app] > 0} {
         append ua " " $app
     } else {
         append ua " Tcl/[package provide Tcl]"
     }
     http::config -useragent $ua
 }
 set_useragent "Google/1.0"
 
 
 # -------------------------------------------------------------------------
 # Setup the SOAP accessor methods
 # -------------------------------------------------------------------------
 if {[catch {package require SOAP::WSDL}]} {
 
     # User doesn't have the WSDL package,  do it manually
     # The following code was generated by parsing the WSDL document
     namespace eval GoogleSearchService {
         set endpoint http://api.google.com/search/beta2
         set schema http://www.w3.org/2001/XMLSchema
         SOAP::create doGetCachedPage \
             -proxy $endpoint -params {key string url string} \
             -action urn:GoogleSearchAction \
             -encoding http://schemas.xmlsoap.org/soap/encoding/ \
             -schemas [list xsd $schema] \
             -uri urn:GoogleSearch
         SOAP::create doSpellingSuggestion \
             -proxy $endpoint -params {key string phrase string} \
             -action urn:GoogleSearchAction \
             -encoding http://schemas.xmlsoap.org/soap/encoding/ \
             -schemas [list xsd $schema] \
             -uri urn:GoogleSearch
         SOAP::create doGoogleSearch -proxy $endpoint \
             -params {key string q string start int maxResults int \
                          filter boolean restrict string safeSearch boolean \
                          lr string ie string oe string} \
             -action urn:GoogleSearchAction \
             -encoding http://schemas.xmlsoap.org/soap/encoding/ \
             -schemas [list xsd $schema] \
             -uri urn:GoogleSearch
     }; # end of GoogleSearchService
 
 } else {
 
     # Get the WSDL document (local copy)
     # Also at 
     set wsdl_url http://api.google.com/GoogleSearch.wsdl
     set wsdl_name [file tail $wsdl_url]
     if {[file exists [set fname [file join $::env(TEMP) $wsdl_name]]]} {
         set f [open $fname r]
         set wsdl [read $f]
         close $f
     } else {
         set tok [http::geturl $wsdl_url]
         if {[http::status $tok] eq "ok"} {
             set wsdl [http::data $tok]
             set f [open $fname w]
             puts $f $wsdl
             close $f
         }
         http::cleanup $tok
     }
     
     # Process the WSDL and generate Tcl script defining the SOAP accessors.
     # This is going to change in the near future.
     set doc  [dom::DOMImplementation parse $wsdl]
     set impl [SOAP::WSDL::parse $doc]
     eval [set $impl]
     
     # Fixup the parameters (the rpcvar package needs to be enhanced for this
     # but this hasn't been done yet)
     set schema {http://www.w3.org/2001/XMLSchema}
     foreach cmd [info commands ::GoogleSearchService::*] {
         set fixed {}
         foreach {param type} [SOAP::cget $cmd -params] {
             set type [regsub "${schema}:" $type {}]
             lappend fixed $param $type
         }
         SOAP::configure $cmd -params $fixed -schemas [list xsd $schema]
     }
 
 }
 
 # -------------------------------------------------------------------------
 
 # Make available as a command line script.
 if {!$::tcl_interactive} {
     if {[info command GoogleSearchService::doGoogleSearch] != {}} {
         if {[llength $argv] < 2} {
             usage
         }
         set r [eval [list google] $argv]
         puts $r
     }
 }
 
 # -------------------------------------------------------------------------
 # Local variables:
 #   mode: tcl
 #   indent-tabs-mode: nil
 # End:

Bryan Oakley 12-Nov-2006 for another way to solve the same problem see "Web Services and the Google API" [1].

MJ - Unfortunately, as of December 5, 2006, it seems Google is ditching its SOAP API [2].

escargo 20 Dec 2006 - This made me think of this blog entry: http://www.manageability.org/blog/stuff/soap-is-dead

LV 2009-Sep-11 http://blogoscoped.com/archive/2009-09-11-n13.html