1# Google.tcl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sf.net> 2# 3# Provide a simple(ish) Tcl interface to the Google SOAP API. 4# 5# Try: google spell "Larry Vriden" 6# or google cache "http://mini.net/tcl/" 7# or google search "TclSOAP" 8# 9# ------------------------------------------------------------------------- 10# This software is distributed in the hope that it will be useful, but 11# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 12# or FITNESS FOR A PARTICULAR PURPOSE. See the accompanying file `LICENSE' 13# for more details. 14# ------------------------------------------------------------------------- 15# 16# @(#)$Id: Google.tcl,v 1.2 2003/09/06 17:08:46 patthoyts Exp $ 17 18package require SOAP 19package require uri 20package require base64 21 22# You need to register to use the Google SOAP API. You should put your key 23# into $HOME/.googlekey using the line: 24# set Key {0000000000000000} 25source [file join $env(HOME) .googlekey] 26 27# ------------------------------------------------------------------------- 28 29proc google {cmd args} { 30 global Key Toplevels 31 switch -glob -- $cmd { 32 se* { 33 set r [eval [list googleQuery] $args] 34 } 35 36 sp* { 37 set r [GoogleSearchService::doSpellingSuggestion \ 38 $Key [lindex $args 0]] 39 } 40 41 c* { 42 set url [lindex $args 0] 43 set d [GoogleSearchService::doGetCachedPage $Key $url] 44 set r [base64::decode $d] 45 } 46 default { 47 usage 48 } 49 } 50 return $r 51} 52 53proc googleQuery {args} { 54 global Key 55 array set opts {start 0 max 10 filter false restrict "" safe false lang ""} 56 while {[string match -* [set option [lindex $args 0]]]} { 57 switch -glob -- $option { 58 -start {set opts(start) [Pop args 1]} 59 -max {set opts(max) [Pop args 1]} 60 -filter {set opts(filter) [Pop args 1]} 61 -restrict {set opts(filter) [Pop args 1]} 62 -safe {set opts(safe) [Pop args 1]} 63 -lang* {set opts(lang) [Pop args 1]} 64 -- { Pop args; break } 65 default { 66 set options [join [array names opts] ", -"] 67 return -code error "invalid option \"$option\":\ 68 should be one of -$options" 69 } 70 } 71 Pop args 72 } 73 74 set r [GoogleSearchService::doGoogleSearch $Key $args \ 75 $opts(start) $opts(max) $opts(filter) \ 76 $opts(restrict) $opts(safe) $opts(lang) utf-8 utf-8] 77 return $r 78} 79 80proc Pop {varname {nth 0}} { 81 upvar $varname args 82 set r [lindex $args $nth] 83 set args [lreplace $args $nth $nth] 84 return $r 85} 86 87proc usage {} { 88 puts "usage: google search query" 89 puts " google spell text" 90 puts " google cache url" 91 exit 1 92} 93 94proc set_useragent {{app {}}} { 95 global tcl_platform 96 set ua "Mozilla/4.0 ([string totitle $tcl_platform(platform)];\ 97 $tcl_platform(os)) http/[package provide http]" 98 if {[string length $app] > 0} { 99 append ua " " $app 100 } else { 101 append ua " Tcl/[package provide Tcl]" 102 } 103 http::config -useragent $ua 104} 105set_useragent "Google/1.0" 106 107 108# ------------------------------------------------------------------------- 109# Setup the SOAP accessor methods 110# ------------------------------------------------------------------------- 111 112proc setup_from_wsdl {} { 113 # Get the WSDL document (local copy) 114 # Also at 115 set wsdl_url http://api.google.com/GoogleSearch.wsdl 116 set wsdl_name [file tail $wsdl_url] 117 if {[file exists [set fname [file join $::env(TEMP) $wsdl_name]]]} { 118 set f [open $fname r] 119 set wsdl [read $f] 120 close $f 121 } else { 122 set tok [http::geturl $wsdl_url] 123 if {[http::status $tok] eq "ok"} { 124 set wsdl [http::data $tok] 125 set f [open $fname w] 126 puts $f $wsdl 127 close $f 128 } 129 http::cleanup $tok 130 } 131 132 # Process the WSDL and generate Tcl script defining the SOAP accessors. 133 # This is going to change in the near future. 134 set doc [dom::DOMImplementation parse $wsdl] 135 set impl [SOAP::WSDL::parse $doc] 136 uplevel #0 [set $impl] 137 138 # Fixup the parameters (the rpcvar package needs to be enhanced for this 139 # but this hasn't been done yet) 140 set schema {http://www.w3.org/2001/XMLSchema} 141 foreach cmd [info commands ::GoogleSearchService::*] { 142 set fixed {} 143 foreach {param type} [SOAP::cget $cmd -params] { 144 set type [regsub "${schema}:" $type {}] 145 lappend fixed $param $type 146 } 147 SOAP::configure $cmd -params $fixed -schemas [list xsd $schema] 148 } 149} 150 151proc setup_manually {} { 152 # User doesn't have the WSDL package, do it manually 153 # The following code was generated by parsing the WSDL document 154 namespace eval ::GoogleSearchService { 155 set endpoint http://api.google.com/search/beta2 156 set schema http://www.w3.org/2001/XMLSchema 157 SOAP::create doGetCachedPage \ 158 -proxy $endpoint -params {key string url string} \ 159 -action urn:GoogleSearchAction \ 160 -encoding http://schemas.xmlsoap.org/soap/encoding/ \ 161 -schema [list xsd $schema] \ 162 -uri urn:GoogleSearch 163 SOAP::create doSpellingSuggestion \ 164 -proxy $endpoint -params {key string phrase string} \ 165 -action urn:GoogleSearchAction \ 166 -encoding http://schemas.xmlsoap.org/soap/encoding/ \ 167 -schema [list xsd $schema] \ 168 -uri urn:GoogleSearch 169 SOAP::create doGoogleSearch -proxy $endpoint \ 170 -params {key string q string start int maxResults int \ 171 filter boolean restrict string safeSearch boolean \ 172 lr string ie string oe string} \ 173 -action urn:GoogleSearchAction \ 174 -encoding http://schemas.xmlsoap.org/soap/encoding/ \ 175 -schema [list xsd $schema] \ 176 -uri urn:GoogleSearch 177 }; # end of GoogleSearchService 178} 179 180# ------------------------------------------------------------------------- 181# 182# Try to setup the Google API from the WSDL document. If this fails, or 183# was have a version < 1.6.7 then use the manual setup. 184# 185 186proc setup {} { 187 set need_setup 1 188 189 catch {package require SOAP::WSDL} 190 if {[package provide SOAP::WSDL] != {}} { 191 if {[set need_setup [catch {setup_from_wsdl} msg]]} { 192 puts stderr "failed to parse wsdl: $msg" 193 } 194 } 195 196 if {$need_setup} { 197 setup_manually 198 } 199} 200 201# ------------------------------------------------------------------------- 202 203# Make available as a command line script. 204if {!$::tcl_interactive} { 205 if {[llength $argv] < 2} { 206 usage 207 } 208 setup 209 if {[info command GoogleSearchService::doGoogleSearch] != {}} { 210 set r [eval [list google] $argv] 211 puts $r 212 } 213} 214 215# ------------------------------------------------------------------------- 216# Local variables: 217# mode: tcl 218# indent-tabs-mode: nil 219# End: 220