| 1 | # fortunebot.tcl -- |
|---|
| 2 | # |
|---|
| 3 | # Demo bot using the irc TCL client library. This is a VERY simple bot that |
|---|
| 4 | # demonstrates some simple uses of the irc TCL library. |
|---|
| 5 | # |
|---|
| 6 | # The bot sits on any number of channels and networks. It periodically grabs |
|---|
| 7 | # a fortune from a web site and sends the fortune with appropriate delays |
|---|
| 8 | # between each line to all channels on all networks it is on. |
|---|
| 9 | |
|---|
| 10 | # Example use in Tcl: |
|---|
| 11 | # |
|---|
| 12 | # % source fortunebot.tcl |
|---|
| 13 | # % set token [irc::connect ....] |
|---|
| 14 | # % fortune::join $token #mychannel |
|---|
| 15 | # % fortune::start 120 |
|---|
| 16 | # |
|---|
| 17 | # What this does: |
|---|
| 18 | # * Loads the bot, which in turn will load the IRC library and HTTP. |
|---|
| 19 | # * Connect to IRC |
|---|
| 20 | # * Send the bot to join #mychannel |
|---|
| 21 | # * Start the bot, with 120 seconds delay. Now it'll do its actions every |
|---|
| 22 | # 120 seconds. |
|---|
| 23 | # |
|---|
| 24 | # To stop the bot: |
|---|
| 25 | # |
|---|
| 26 | # % fortune::stop |
|---|
| 27 | # |
|---|
| 28 | # Make him leave a channel: |
|---|
| 29 | # |
|---|
| 30 | # % fortune::leave $token #mychannel |
|---|
| 31 | |
|---|
| 32 | package require irk |
|---|
| 33 | package require http |
|---|
| 34 | |
|---|
| 35 | namespace eval fortune { |
|---|
| 36 | variable state |
|---|
| 37 | |
|---|
| 38 | array set state { |
|---|
| 39 | linedelay 2000 |
|---|
| 40 | fortuneurl http://www.earth.com/fortune |
|---|
| 41 | } |
|---|
| 42 | } |
|---|
| 43 | |
|---|
| 44 | # Bot control: |
|---|
| 45 | |
|---|
| 46 | proc ::fortune::start {{delay 60}} { |
|---|
| 47 | variable state |
|---|
| 48 | |
|---|
| 49 | # Compute the delay in milliseconds: |
|---|
| 50 | |
|---|
| 51 | set state(delay) [expr $delay * 1000] |
|---|
| 52 | |
|---|
| 53 | # Schedule the bot to run each $delay milliseconds: |
|---|
| 54 | |
|---|
| 55 | set state(after) [after $state(delay) [list ::fortune::doquote]] |
|---|
| 56 | } |
|---|
| 57 | |
|---|
| 58 | proc ::fortune::stop {} { |
|---|
| 59 | variable state |
|---|
| 60 | |
|---|
| 61 | # Stop the bot if its running: |
|---|
| 62 | |
|---|
| 63 | if {[info exists state(after)]} { |
|---|
| 64 | after cancel $state(after) |
|---|
| 65 | unset state(after) |
|---|
| 66 | } |
|---|
| 67 | } |
|---|
| 68 | |
|---|
| 69 | |
|---|
| 70 | # This is the actual body of the bot: |
|---|
| 71 | # |
|---|
| 72 | # Grab a quote from a web page and post it to all channels we're on: |
|---|
| 73 | |
|---|
| 74 | proc ::fortune::doquote {} { |
|---|
| 75 | variable state |
|---|
| 76 | |
|---|
| 77 | # Grab the quote. The command callback does all the work: |
|---|
| 78 | |
|---|
| 79 | http::geturl $state(fortuneurl) -command ::fortune::httpdone |
|---|
| 80 | |
|---|
| 81 | # Finally reschedule ourselves, after events are one-shots |
|---|
| 82 | |
|---|
| 83 | set state(after) [after $state(delay) [list ::fortune::doquote]] |
|---|
| 84 | } |
|---|
| 85 | |
|---|
| 86 | proc ::fortune::httpdone {http} { |
|---|
| 87 | variable state |
|---|
| 88 | upvar #0 $http response |
|---|
| 89 | |
|---|
| 90 | # Scrape the fortune off of the page: |
|---|
| 91 | |
|---|
| 92 | set fortune [grabfortune $response(body)] |
|---|
| 93 | |
|---|
| 94 | # Discard the HTTP array: |
|---|
| 95 | |
|---|
| 96 | unset response |
|---|
| 97 | |
|---|
| 98 | # Check if the quote is too long. If it is then punt. |
|---|
| 99 | |
|---|
| 100 | if {[llength $fortune] > 3} { |
|---|
| 101 | return |
|---|
| 102 | } |
|---|
| 103 | |
|---|
| 104 | # Say this quote on all channels on all connections we're on: |
|---|
| 105 | |
|---|
| 106 | foreach conn [irk::connections] { |
|---|
| 107 | tell $fortune $conn |
|---|
| 108 | } |
|---|
| 109 | } |
|---|
| 110 | |
|---|
| 111 | # This procedure scrapes the quote off of an HTML page: |
|---|
| 112 | |
|---|
| 113 | proc ::fortune::grabfortune {body} { |
|---|
| 114 | set body [split $body "\n"] |
|---|
| 115 | set beg [lsearch $body <PRE>] |
|---|
| 116 | set end [lsearch $body </PRE>] |
|---|
| 117 | return [lrange $body [expr $beg+1] [expr $end-1]] |
|---|
| 118 | } |
|---|
| 119 | |
|---|
| 120 | # This procedure sends the quote to all channels we want the bot to be on: |
|---|
| 121 | |
|---|
| 122 | proc ::fortune::tell {fort conn} { |
|---|
| 123 | variable state |
|---|
| 124 | |
|---|
| 125 | # Send the fortune to each channel we're on: |
|---|
| 126 | |
|---|
| 127 | foreach chan [irk::onchannels $conn] { |
|---|
| 128 | tellchan $fort $conn $chan |
|---|
| 129 | } |
|---|
| 130 | } |
|---|
| 131 | |
|---|
| 132 | # Asynchronously send lines to the channel: |
|---|
| 133 | |
|---|
| 134 | proc ::fortune::tellchan {fort conn channel} { |
|---|
| 135 | variable state |
|---|
| 136 | |
|---|
| 137 | # Check if we are still on the channel: |
|---|
| 138 | |
|---|
| 139 | if {![irk::onchannel $conn $channel]} { |
|---|
| 140 | return |
|---|
| 141 | } |
|---|
| 142 | |
|---|
| 143 | # OK we're still on this channel, so say the current line and schedule |
|---|
| 144 | # the next line for later: |
|---|
| 145 | |
|---|
| 146 | if {[llength $fort] > 0} { |
|---|
| 147 | irk::say $conn $channel [lindex $fort 0] |
|---|
| 148 | after $state(linedelay) \ |
|---|
| 149 | [list ::fortune::tellchan [lrange $fort 1 end] $conn $channel] |
|---|
| 150 | } |
|---|
| 151 | } |
|---|
