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.5before 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