Code: Select all
[10:40] Start of channel list.
[10:40] Tcl error [raw_322]: unmatched open quote in list
[10:40] Tcl error [raw_322]: can't read "web_color(00)": no such element in array
[10:40] Tcl error [raw_322]: list element in quotes followed by "!" instead of space
[10:40] End of channel list.Code: Select all
#Chanlist 1.00 Aug 2001
#Creates a channel list and stores in an HTML file
#The color codes conversion is based on ques5.tcl by Robert Pointer and
#the eggheads Developement Team, modifyed to read the background codes.
#Any questions? mailto:merlin@ebs.cl
#Where id the channel file located?
set listfile "../../httpd/buscando/canales.html"
#How many seconds will the bot wait to write a new list?
#be careful, in large networks this can take a while
set refresh 60
#What is the title of the page?
set pagetitle "MyNetwork Channel List"
###### the code starts here ########
utimer $refresh get_channels
# Which characters should be allowed in URLs?
# DO NOT MODIFY unless you really know what you are doing.
# Expecially never add '<', '"' and '>'
set web_urlchars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 :+-/!\$%&()=[]{}#^~*.:,;\\|?_@"
# IRC -> HTML color translation table
set web_color(0) "#FFFFFF"
set web_color(1) "#000000"
set web_color(2) "#00007F"
set web_color(3) "#008F00"
set web_color(4) "#FF0000"
set web_color(5) "#7F0000"
set web_color(6) "#9F009F"
set web_color(7) "#FF7F00"
set web_color(8) "#F0FF00"
set web_color(9) "#00F700"
set web_color(10) "#008F8F"
set web_color(11) "#00F7FF"
set web_color(12) "#0000FF"
set web_color(13) "#FF00FF"
set web_color(14) "#7F7F7F"
set web_color(15) "#CFCFCF"
# IRC -> HTML style translation table
set web_style(\002) "<B> </B>"
set web_style(\003) "<FONT> </FONT>"
set web_style(\026) "<I> </I>"
set web_style(\037) "<U> </U>"
set web_style(,) ","
proc webify {string} {
# TCL8.1 only:
#return [string map {\" " & & < < > >} $string]
# Otherwise use this:
regsub -all "\\&" $string "\\&" string
regsub -all "\"" $string "\\"" string
regsub -all "<" $string "<" string
return $string
}
proc convstyle {string} {
global web_color web_style
set result ""
set stack ""
for {set i 0} "\$i < [string length $string]" {incr i} {
set char [string index $string $i]
switch -- $char {
"\002" - "\026" - "\037" {
if {[string first $char $stack] != -1} {
# NOT &&
if {[string index $stack 0] == $char} {
append result [lindex $web_style($char) 1]
set stack [string range $stack 1 end]
}
} else {
append result [lindex $web_style($char) 0]
set stack $char$stack
}
}
"\003" {
if {[string first $char $stack] != -1} {
if {[string index $stack 0] == $char} {
append result [lindex $web_style($char) 1]
set stack [string range $stack 1 end]
}
}
set c [getnumber [string range $string [expr $i + 1] [expr $i + 2]]]
if {$c != "" && $c >= 0 && $c <= 15} {
incr i [expr [string length $c] + 0 ]
append result "<FONT COLOR=\"$web_color($c)\">"
set stack $char$stack
}
}
"," {
if {[string first $char $stack] != -1} {
if {[string index $stack 0] == $char} {
append result [lindex $web_style($char) 1]
set stack [string range $stack 1 end]
}
}
set d [getnumber [string range $string [expr $i + 1] [expr $i + 2]]]
if {$d != "" && $d >= 0 && $d <= 15 && $d != ","} {
append result "<span style=\"background-color : $web_color($d);\">"
incr i [expr [string length $d] + 0]
set stack $char$stack
}
}
default {append result $char}
}
}
foreach char [split $stack ""] {
if {$char == "\002" || $char == "\003" ||
$char == "\026" || $char == "\037"} {
append result [lindex $web_style($char) 1]
}
}
return $result
}
proc getnumber {string} {
set result ""
foreach char [split $string ""] {
if {[string first $char "0123456789"] == -1} {
return $result
} else {
for {set i 0} "\$i < [string length $string]" {incr i} {
if { [string first [string range $string $i $i] "0123456789"] == -1} {
} else {
append result $char
set i [string length $string]
}
}
}
}
return $result
}
# set variables to defaults
set list_active 0
if {![info exists list_data]} then {set list_data ""}
# get a new channel list
proc get_channels {} {
global list_active listfile pagetitle
set fh1 [open $listfile w]
puts $fh1 "<html>"
puts $fh1 "<head>"
puts $fh1 "<title>"
puts $fh1 $pagetitle
puts $fh1 "</title>"
puts $fh1 "<style>"
puts $fh1 "TR,TD,BODY { font-family: arial,helvetica;}"
puts $fh1 "</style>"
puts $fh1 "</head>"
puts $fh1 "<body bgcolor=#FFFFFF>"
puts $fh1 "<table border=1 cellspacing=0 cellpadding=5 bordercolor=black>"
puts $fh1 "<tr><td>Canal</td><td>Usuarios</td><td>Tуpico</td></tr>"
close $fh1
set list_active 1
putlog "Listing channels..."
putserv "LIST"
return 0
}
# begin of channel list
proc raw_321 {from key arg} {
global list_active list_data
if {$list_active} then {
putlog "Start of channel list."
set list_data ""
}
return 0
}
# channel list
proc raw_322 {from key arg} {
global list_active list_data listfile
set fh [open $listfile a]
if {$list_active} then {
puts $fh "<tr><td>"
puts $fh "[lindex [split $arg] 1]"
puts $fh "</td align=\"center\">"
puts $fh "<td>[lindex [split $arg] 2]</td>"
set thestring [string trimright [lrange $arg 3 [llength $arg] ] ]
if {[string length $thestring] > 0} {
set thestring2 [string range $thestring 1 [ string length $thestring]]
}
puts $fh "<td>"
puts $fh "[convstyle [ webify $thestring2 ] ] "
puts $fh "</td></tr>"
lappend list_data [lindex [split $arg] 1]
}
close $fh
return 0
}
# end of channel list
proc raw_323 {from key arg} {
global list_active listfile refresh
set fh2 [open $listfile a]
puts $fh2 "</table></body></html>"
close $fh2
if {$list_active} then {
putlog "End of channel list."
set list_active 0
}
utimer $refresh get_channels
return 0
}
bind raw -|- 321 raw_321
bind raw -|- 322 raw_322
bind raw -|- 323 raw_323
#####
putlog "Chanlist 1.00 by Merlin <merlin@ebs.cl>"
