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