Posted to tcl by dkf at Thu May 06 12:37:06 GMT 2010view raw

  1. package require http
  2. package require tdom
  3.  
  4. bind PUB - !start startFetchAndPrint
  5. bind PUB - !stop stopFetchAndPrint
  6.  
  7. proc getCurrentMessage {url} {
  8. set t [http::geturl $url]
  9. set doc [dom parse [http::data $t]]
  10. http::cleanup $t
  11.  
  12. set titles {}
  13. foreach node [$doc selectNodes /channel/item/title] {
  14. lappend titles [$node text]
  15. }
  16.  
  17. $doc delete
  18. return [join $titles \n]
  19. }
  20.  
  21. # The work to do each iteration
  22. proc fetchAndPrint {} {
  23. global currentMessage currentSchedule targetChannel
  24.  
  25. # Reschedule the call to this in 60 seconds, saving the token so we
  26. # can cancel it later. (That enables !stop)
  27. set currentSchedule [after 60000 fetchAndPrint]
  28.  
  29. # Fetch the current message
  30. set msg [getCurrentMessage "http://rit.me.uk/livescore/cricrss.php"]
  31.  
  32. # Print it (line at a time) if there's been a change
  33. if {$msg ne $currentMessage} {
  34. set currentMessage $msg
  35. foreach line [split $msg \n] {
  36. puthelp "PRIVMSG $targetChannel :\00310$line\003"
  37. }
  38. }
  39. }
  40.  
  41. # How to start things
  42. proc startFetchAndPrint {nick uhost hand chan arg} {
  43. global currentMessage targetChannel
  44.  
  45. set currentMessage {}
  46. set targetChannel $chan
  47. # This will install the next scheduled callback immediately
  48. fetchAndPrint
  49. }
  50.  
  51. # How to stop things
  52. proc stopFetchAndPrint {nick uhost hand chan arg} {
  53. global currentSchedule
  54. if {[info exists currentSchedule]} {
  55. after cancel $currentSchedule
  56. }
  57. }
  58.