# 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 "https://wiki.tcl-lang.org/"
 #  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: