home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / demos / TclSOAP / Async.tcl next >
Encoding:
Text File  |  2001-10-22  |  3.1 KB  |  99 lines
  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.1 2001/06/21 23:02:23 patthoyts Exp $
  18.  
  19. package require XMLRPC
  20. package require Tkhtml
  21.  
  22. # -------------------------------------------------------------------------
  23. # Meerkat service
  24. # -------------------------------------------------------------------------
  25. namespace eval Meerkat {
  26.     variable proxy {http://www.oreillynet.com/meerkat/xml-rpc/server.php}
  27.  
  28.     # ---------------------------------------------------------------------
  29.     # Construct a user interface.
  30.     # ---------------------------------------------------------------------
  31.     set dlg [toplevel .t]
  32.     wm title $dlg {Asynchronous Test}
  33.     set mainFrame [frame ${dlg}.f1]
  34.     set viewer [html ${mainFrame}.h -bg white \
  35.         -yscrollcommand "${mainFrame}.s set"]
  36.     set scroll [scrollbar ${mainFrame}.s -command "$viewer yview"]
  37.     pack $scroll -side right -fill y
  38.     pack $viewer -side left -fill both -expand 1
  39.     pack $mainFrame -side top -fill both -expand 1
  40.  
  41.     # ---------------------------------------------------------------------
  42.     # The Asynchronous handlers
  43.     # ---------------------------------------------------------------------
  44.     proc gotCategories {w data} {
  45.     set html "<ul>\n"
  46.     foreach struct $data {
  47.         array set item $struct
  48.         append html "<li>$item(id) $item(title)</li>\n"
  49.     }
  50.     append html "</ul>\n"
  51.     $w clear
  52.     $w parse $html
  53.     }
  54.     
  55.     proc gotItems {w data} {
  56.     set html {}
  57.     foreach entry $data {
  58.         array set item $entry
  59.         append html "<h2><a href=\"$item(link)\">$item(title)</a></h2>\n"
  60.         append html "<p>$item(description)\n"
  61.         append html "<br><a href=\"$item(link)\">$item(link)</a>\n"
  62.         append html "<br><font size=\"-1\">[array names item]</font></p>\n"
  63.     }
  64.     $w clear
  65.     $w parse $html
  66.     }
  67.  
  68.     # ---------------------------------------------------------------------
  69.     # Configure RPC commands
  70.     # ---------------------------------------------------------------------
  71.  
  72.     # returns an array of category structs: {int id; string title;}
  73.     XMLRPC::create getCategories \
  74.     -name "meerkat.getCategories" \
  75.     -proxy $proxy \
  76.     -command "[namespace current]::gotCategories $viewer" \
  77.     -params {}
  78.     
  79.     XMLRPC::create getItems \
  80.     -name "meerkat.getItems" \
  81.     -proxy $proxy \
  82.     -command "[namespace current]::gotItems $viewer" \
  83.     -params { item struct }
  84.     
  85. }
  86.  
  87. # -------------------------------------------------------------------------
  88.  
  89. # Configure for our proxy
  90. #XMLRPC::proxyconfig
  91.  
  92. # Set this running
  93. #Meerkat::getItems {search /[Tt]cl/}
  94.  
  95. #
  96. # Local variables:
  97. # mode: tcl
  98. # End:
  99.