1# Async.tcl - Copyright (C) 2001 Pat Thoyts <Pat.Thoyts@bigfoot.com>
2#
3# Example of a method using asynchronous HTTP tranfers for SOAP/XMLRPC
4#
5# Usage:
6#   1:  source this file
7#   2:  optionally configure for your http proxy
8#   3:  call Meerkat::getItems {search {/[Tt]cl/}
9#
10# -------------------------------------------------------------------------
11# This software is distributed in the hope that it will be useful, but
12# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
13# or FITNESS FOR A PARTICULAR PURPOSE.  See the accompanying file `LICENSE'
14# for more details.
15# -------------------------------------------------------------------------
16#
17# $Id: Async.tcl,v 1.2 2001/12/08 01:19:02 patthoyts Exp $
18
19package require XMLRPC
20package require Tkhtml
21package require SOAP::http
22
23# -------------------------------------------------------------------------
24# Meerkat service
25# -------------------------------------------------------------------------
26namespace eval Meerkat {
27    variable proxy {http://www.oreillynet.com/meerkat/xml-rpc/server.php}
28
29    # ---------------------------------------------------------------------
30    # Construct a user interface.
31    # ---------------------------------------------------------------------
32    set dlg [toplevel .t]
33    wm title $dlg {Asynchronous Test}
34    set mainFrame [frame ${dlg}.f1]
35    set viewer [html ${mainFrame}.h -bg white \
36	    -yscrollcommand "${mainFrame}.s set"]
37    set scroll [scrollbar ${mainFrame}.s -command "$viewer yview"]
38    pack $scroll -side right -fill y
39    pack $viewer -side left -fill both -expand 1
40    pack $mainFrame -side top -fill both -expand 1
41
42    # ---------------------------------------------------------------------
43    # The Asynchronous handlers
44    # ---------------------------------------------------------------------
45    proc gotCategories {w data} {
46	set html "<ul>\n"
47	foreach struct $data {
48	    array set item $struct
49	    append html "<li>$item(id) $item(title)</li>\n"
50	}
51	append html "</ul>\n"
52	$w clear
53	$w parse $html
54    }
55
56    proc gotItems {w data} {
57	set html {}
58	foreach entry $data {
59	    array set item $entry
60	    append html "<h2><a href=\"$item(link)\">$item(title)</a></h2>\n"
61	    append html "<p>$item(description)\n"
62	    append html "<br><a href=\"$item(link)\">$item(link)</a>\n"
63	    append html "<br><font size=\"-1\">[array names item]</font></p>\n"
64	}
65	$w clear
66	$w parse $html
67    }
68
69    # ---------------------------------------------------------------------
70    # Configure RPC commands
71    # ---------------------------------------------------------------------
72
73    # returns an array of category structs: {int id; string title;}
74    XMLRPC::create getCategories \
75	-name "meerkat.getCategories" \
76	-proxy $proxy \
77	-command "[namespace current]::gotCategories $viewer" \
78	-params {}
79
80    XMLRPC::create getItems \
81	-name "meerkat.getItems" \
82	-proxy $proxy \
83	-command "[namespace current]::gotItems $viewer" \
84	-params { item struct }
85
86}
87
88# -------------------------------------------------------------------------
89
90# Configure for our proxy
91#XMLRPC::proxyconfig
92
93# Set this running
94#Meerkat::getItems {search /[Tt]cl/}
95
96#
97# Local variables:
98# mode: tcl
99# End:
100