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 <patthoyts@users.sf.net>
#
# 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