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 | } |
---|