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