Version 5 of Googling with SOAP

Updated 2003-02-05 21:07:48

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

Try google spell "Larry Vriden" ;)


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://mini.net/tcl/"
 #  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.6 2003-02-06 09:01:04 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:

[ Category Internet | Category Application ]