[eggheads-patches] PATCH: scriptupd.patch

Peter 'Rattacresh' Backes rtc at rhrk.uni-kl.de
Mon Oct 4 15:42:29 CST 1999


This patch updates quesedilla to v5 final and alltools.tcl to the 
newest version, now with two space identing (:1,$s/\t/  /g).


-- Peter 'Rattacresh' Backes, rtc at rhrk.uni-kl.de

-------------- next part --------------
diff -urN eggdrop1.3.29/doc/UPDATES1.3 eggdrop1.3.29+scriptupd/doc/UPDATES1.3
--- eggdrop1.3.29/doc/UPDATES1.3	Mon Oct  4 21:23:32 1999
+++ eggdrop1.3.29+scriptupd/doc/UPDATES1.3	Mon Oct  4 21:26:21 1999
@@ -4,6 +4,8 @@
 
 1.3.29
 Foundby   Fixedby   What....
+          rtc       quesedilla updated to v5
+          rtc       alltools updated
           dw        it said 'JOIN flood from @%s!  Banning.'
                     for nick floods.
 reddawg   rtc       md5 make could fail on some OS
diff -urN eggdrop1.3.29/scripts/alltools.tcl eggdrop1.3.29+scriptupd/scripts/alltools.tcl
--- eggdrop1.3.29/scripts/alltools.tcl	Mon Oct  4 21:23:32 1999
+++ eggdrop1.3.29+scriptupd/scripts/alltools.tcl	Mon Oct  4 21:27:17 1999
@@ -7,21 +7,27 @@
 # updated even more by guppy 02May1999
 # fixed what guppy broke and updated again by Tothwolf 02May1999
 # more changes from Tothwolf 24/25May1999
+# reversed some of these weird changes and more fixes by rtc 20Sep1999
+# version for 1.3 bots only by rtc 24Sep1999
 
 ########################################
 # Descriptions of avaliable commands:
+## (removed from toolkit):
+# newflag <flag> - REMOVED numeric flags are no longer supported in this way
+#
 ## (toolkit):
-# putmsg <nick/chan> <text>
-#   send a message to a nick/chan
+# putmsg <nick> <text>
+#   send a message to someone on irc
 #
-# putchan <nick/chan> <text>
-#   identical to putmsg
+# putchan <channel> <text>
+#   send a public message to a channel
+#   technically identical to putmsg
 #
-# putnotc <nick/chan> <text>
-#   send a notice to a nick/chan
+# putnotc <nick/channel> <text>
+#   send a notice to a nick/channel
 #
-# putact <nick/chan> <text>
-#   send an action to a nick/chan
+# putact <nick/channel> <text>
+#   send an action to a nick/channel
 #
 ## (toolbox):
 # strlwr <string>
@@ -85,7 +91,7 @@
 # realtime [format]
 #   'time' returns the current time in 24 hour format '14:15'
 #   'date' returns the current date in the format '21 Dec 1994'
-#   not specifying any format will return the current time with
+#   not specifying any format will return the current time
 #   in 12 hour format '1:15 am'
 #
 # testip <ip>
@@ -94,32 +100,94 @@
 #
 # number_to_number <number>
 #   if the given number is between 1 and 15, return its analog representation
+#   else it returns what it gets.
+# 
+## other 
+# isnumber <string>
+#   returns 1 if 'string' is a number, 0 if not
 #
 ########################################
 
 # So scripts can see if allt is loaded.
 set alltools_loaded 1
-set allt_version 203
+set allt_version 205
 
 # For backward comptibility.
 set toolbox_revision 1007
 set toolbox_loaded 1
 set toolkit_loaded 1
 
-proc putmsg {who text} {
-  puthelp "PRIVMSG $who :$text"
+# Procs.............
+proc number_to_number {number} {
+  switch -- $number {
+    "0" {return "Zero"}
+    "1" {return "One"}
+    "2" {return "Two"}
+    "3" {return "Three"}
+    "4" {return "Four"}
+    "5" {return "Five"}
+    "6" {return "Six"}
+    "7" {return "Seven"}
+    "8" {return "Eight"}
+    "9" {return "Nine"}
+    "10" {return "Ten"}
+    "11" {return "Eleven"}
+    "12" {return "Twelve"}
+    "13" {return "Thirteen"}
+    "14" {return "Fourteen"}
+    "15" {return "Fifteen"}
+    default {return $number}
+  }
+}
+
+proc isnumber {string} {
+  return [expr {![regexp \[^0-9\] $string] && $string != ""}]
+}
+
+proc testip {address} {
+  set testhost [split $address "."]
+  if {[llength $testhost] != 4} {return 0}
+  foreach part $testhost {
+    # >= 0 is just for undertandability, not really needed.
+    if {[string length $part] > 3 || ![isnumber $part] || !($part >= 0 && $part <= 255)} {
+      return 0
+    }
+  }
+  return 1
 }
 
-proc putchan {who text} {
-  puthelp "PRIVMSG $who :$text"
+proc realtime {{type ""}} {
+  switch -- $type {
+    time {
+      return [clock format [clock seconds] -format "%H:%M"]
+    }
+    date {
+      return [clock format [clock seconds] -format "%d %b %Y"]
+    }
+    "" {
+      return [clock format [clock seconds] -format "%I:%M %P"]
+    }
+  }
 }
 
-proc putnotc {who text} {
-  puthelp "NOTICE $who :$text"
+proc iso {nick chan} {
+  return [matchattr [nick2hand $nick $chan] o|o $chan]
 }
 
-proc putact {who text} {
-  puthelp "PRIVMSG $who :\001ACTION $text\001"
+proc putmsg {target text} {
+  putserv "PRIVMSG $target :$text"
+}
+
+proc putnotc {target text} {
+  putserv "NOTICE $target :$text"
+}
+
+proc putchan {target text} {
+  putserv "PRIVMSG $target :$text"
+}
+
+proc putact {target text} {
+  putserv "PRIVMSG $target :\001ACTION $text\001"
 }
 
 proc strlwr {string} {
@@ -147,7 +215,7 @@
 }
 
 proc iscommand {command} {
-  if {![string match "" [info commands $command]]} then {
+  if {[info commands $command] == $command} {
     return 1
   }
   return 0
@@ -155,20 +223,20 @@
 
 proc timerexists {command} {
   foreach i [timers] {
-    if {[string match [lindex $i 1] $command]} then {
+    if {[lindex $i 1] == $command} {
       return [lindex $i 2]
     }
   }
-  return
+  return ""
 }
 
 proc utimerexists {command} {
   foreach i [utimers] {
-    if {[string match [lindex $i 1] $command]} then {
+    if {[lindex $i 1] == $command} {
       return [lindex $i 2]
     }
   }
-  return
+  return ""
 }
 
 proc inchain {bot} {
@@ -176,145 +244,43 @@
 }
 
 proc randstring {length} {
-  set string ""
+  # [rtc] not for tcllib as rand is an eggdrop extension
+  set result ""
   set chars abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
   set count [string length $chars]
-  for {set i 0} {[expr $i < $length]} {incr i} {
-    append string [string index $chars [rand $count]]
+  for {set i 0} {$i < $length} {incr i} {
+    append result [string index $chars [rand $count]]
   }
-  return $string
+  return $result
 }
 
 proc putdccall {text} {
-  foreach i [dcclist] {
-    set j [lindex $i 0]
-    if {[valididx $j]} then {
-      putdcc $j $text
-    }
+  foreach i [dcclist CHAT] {
+    putdcc [lindex $i 0] $text
   }
-  return
 }
 
 proc putdccbut {idx text} {
-  foreach i [dcclist] {
+  foreach i [dcclist CHAT] {
     set j [lindex $i 0]
-    if {([valididx $j]) && (![string match $j $idx])} then {
+    if {$j != $idx} {
       putdcc $j $text
     }
   }
-  return
 }
 
 proc killdccall {} {
-  foreach i [dcclist] {
-    set j [lindex $i 0]
-    if {[valididx $j]} then {
-      killdcc $j
-    }
+  foreach i [dcclist CHAT] {
+    killdcc [lindex $i 0]
   }
-  return
 }
 
 proc killdccbut {idx} {
-  foreach i [dcclist] {
+  foreach i [dcclist CHAT] {
     set j [lindex $i 0]
-    if {([valididx $j]) && (![string match $j $idx])} then {
+    if {$j != $idx} {
       killdcc $j
     }
   }
-  return
-}
-
-proc iso {nick chan} {
-  return [matchattr [nick2hand $nick $chan] o|o $chan]
-}
-
-proc realtime {args} {
-  switch -exact [lindex $args 0] {
-    time {
-      return [strftime "%H:%M"]
-    }
-    date {
-      return [strftime "%d %b %Y"]
-    }
-    default {
-      return [strftime "%l:%M %P"]
-    }
-  }
-}
-
-proc testip {ip} {
-  set tmp [split $ip .]
-  if {[expr [llength $tmp] != 4]} then {
-    return 0
-  }
-  foreach i [split [join $tmp ""] ""] {
-    if {![string match \[0-9\] $i]} then {
-      return 0
-    }
-  }
-  set index 0
-  foreach i $tmp {
-    if {(([expr [string length $i] > 3]) || \
-        (([expr $index == 3]) && (([expr $i > 254]) || ([expr $i < 1]))) || \
-        (([expr $index <= 2]) && (([expr $i > 255]) || ([expr $i < 0]))))} then {
-      return 0
-    }
-    incr index 1
-  }
-  return 1
 }
 
-proc number_to_number {number} {
-  switch -exact $number {
-    0 {
-      return Zero
-    }
-    1 {
-      return One
-    }
-    2 {
-      return Two
-    }
-    3 {
-      return Three
-    }
-    4 {
-      return Four
-    }
-    5 {
-      return Five
-    }
-    6 {
-      return Six
-    }
-    7 {
-      return Seven
-    }
-    8 {
-      return Eight
-    }
-    9 {
-      return Nine
-    }
-    10 {
-      return Ten
-    }
-    11 {
-      return Eleven
-    }
-    12 {
-      return Twelve
-    }
-    13 {
-      return Thirteen
-    }
-    14 {
-      return Fourteen
-    }
-    15 {
-      return Fifteen
-    }
-  }
-  return
-}
diff -urN eggdrop1.3.29/scripts/ques4.tcl eggdrop1.3.29+scriptupd/scripts/ques4.tcl
--- eggdrop1.3.29/scripts/ques4.tcl	Mon Oct  4 21:23:32 1999
+++ eggdrop1.3.29+scriptupd/scripts/ques4.tcl	Thu Jan  1 01:00:00 1970
@@ -1,179 +0,0 @@
-#
-# quesedilla, by robey
-# v1 -- 20aug95
-# v2 -- 2oct95   [improved it]
-# v3 -- 17mar96  [fixed it up for 1.0 multi-channel]
-# v4 __ 3nov97  [Fixed it up for 1.3.0 version bots] by TG
-# v4.00001 nov97 [blurgh]
-# 
-# this will create an html file every so often (the default is once every
-# 5 minutes).  the html file will have a table showing the people currently
-# on the channel, their user at hosts, who's an op, and who's idle.  it
-# uses a table which some browsers (and pseudo-browsers like lynx) can't
-# see, but it can optionally make a second page which will support these
-# archaic browsers.  browsers supporting push-pull will receive the updated
-# page automatically periodically.
-#
-# if you have a "url" field defined for a user, their nickname in the
-# table will be a link pointing there.  otherwise it checks the info
-# line and comment field to see if they start with "http://" -- if so,
-# that link will be used.  as a last resort, it will make a "mailto:"
-# link if an email address is recorded for the user.
-#
-# feel free to modify and play with this.  the original was written in
-# 15 minutes, then at various times i fixed bugs and added features.
-# softlord helped me make the design look a little nicer. :)  if you make
-# any nifty improvements, please let me know.
-#                                       robey at netcom.com
-
-
-## this line makes sure other scripts won't interfere
-catch {unset webfile}
-
-## for each channel you want a webfile for, do this:
-set webfile(#turtle) "/home/robey/public_html/turtle.html"
-set webfile(#gloom) "/home/robey/public_html/gloom.html"
-
-## define these for channels you want alternate (lynx-friendly) web pages
-## for:  (the 'lynxfilerf' needs to be relative to your html directory)
-set lynxfile(#turtle) "/home/robey/public_html/turtle-lynx.html"
-set lynxfilerf(#turtle) "turtle-lynx.html"
-
-## how often should these html files get updated?
-## (1 means once every minute, 5 means once every 5 minutes, etc)
-set web_update 5
-
-## this will help people figure out what timezone you're in :)
-set webtz [clock format 0 -format %Z]
-## if that line breaks, you're using an older Tcl library and will have to
-## set it manually like so:
-#set webtz "PST"
-
-proc do_ques {} {
-  global webfile lynxfile web_update botnick webtz lynxfilerf
-  foreach chan [array names webfile] {
-    if {[lsearch -exact [string tolower [channels]] [string tolower $chan]] == -1} {continue}
-    set fd [open $webfile($chan) w]
-    if {[info exists lynxfile($chan)]} {
-      set fdl [open $lynxfile($chan) w]
-    } else {
-      set fdl [open "/dev/null" w]
-    }
-    puts $fd "<meta http-equiv=\"Refresh\" content=[expr $web_update *60]>"
-    if {![onchan $botnick $chan]} {
-      puts $fd "<html><head><title>People on $chan right now</title></head>"
-      puts $fd "<body><h1>Oops!</h1><p>"
-      puts $fd "I'm not on $chan right now for some reason.<br>"
-      puts $fd "IRC isn't a very stable place these days... Please try again"
-      puts $fd "later!<p></body></html>"
-      puts $fdl "<html><head><title>People on $chan right now</title></head>"
-      puts $fdl "<body><h1>Oops!</h1><p>"
-      puts $fdl "I'm not on $chan right now for some reason.<br>"
-      puts $fdl "IRC isn't a very stable place these days... Please try again"
-      puts $fdl "later!<p></body></html>"
-      close $fd
-      close $fdl
-    } {
-      puts $fd "<html><head><title>People on $chan right now</title></head>"
-      puts $fd "<body><center><h1>$chan</h1>"
-      puts $fdl "<html><head><title>People on $chan right now</title></head>"
-      puts $fdl "<body><h1>$chan</h1>"
-      if {[info exists lynxfile($chan)]} {
-        puts $fd "<p>If this page looks screwy on your browser, try"
-        puts $fd "<a href=\"$lynxfilerf($chan)\">this page</a>.<p>"
-      }
-      puts $fd "<table border=1 cellpadding=4>"
-      puts $fd "<caption>People on $chan as of [date] [time] $webtz</caption>"
-      puts $fd "<th align=left>Nickname<th align=left>Status"
-      puts $fd "<th align=left>User at Host"
-      puts $fdl "<em>People on $chan as of [date] [time] $webtz</em><pre>"
-      puts $fdl "Nickname  Status           User at Host"
-      foreach i [chanlist $chan] {
-        puts $fd "<tr>"
-        if {[isop $i $chan]} { set chop "op"} { set chop "" }
-        if {[getchanidle $i $chan] > 10} {
-          if {$chop == ""} { set chop "idle" } { set chop "${chop}, idle" }
-        }
-        set handle [finduser $i![getchanhost $i $chan]]
-        if {[onchansplit $i $chan]} {
-          if {$chop == ""} { 
-            set chop "<strong>(split)</strong>"
-          } {
-            set chop "${chop} <strong>(split)</strong>"
-          }
-        }
-        set url [getuser $handle xtra url]
-        set info [getuser $handle info]
-        set comment [getuser $handle comment]
-        if {"" == $chop} { set chop "-" }
-        set link ""
-        if {"" != $url} {
-          set link "<a href=\"$url\">"
-        }
-        if {("" == $link) && 
-            ([string compare [string range $comment 0 6] "http://"] == 0)} {
-          set link "<a href=\"[lindex [split $comment] 0]\">"
-        }
-        if {("" == $link) &&
-            ([string compare [string range $info 0 6] "http://"] == 0)} {
-          set link "<a href=\"[lindex [split $info] 0]\">"
-        }
-        if {"" == $link} {
-          set email [getuser $handle xtra email]
-          if {("" != $email) && ([string first @ $email] > 0)} {
-            set link "<a href=\"mailto:$email\">"
-          }
-        }
-        if {"" != $link} { set elink "</a>" } { set elink "" }
-        puts $fd "<td align=left>${link}${i}${elink}</td>"
-        puts $fd "<td align=left>${chop}</td>"
-        set chost [getchanhost $i $chan]
-        if {[string compare [string tolower $i] [string tolower $botnick]] == 0} {
-          set chost "<em>This is me, the channel bot.</em>"
-          set info ""
-        } {
-          if {[matchattr $handle b]} {
-            set chost "<em>This is another channel bot.</em>"
-            set info ""
-          }
-        }
-        puts $fd "<td align=left>${chost}</td>"
-        puts $fdl "${link}[format %-9s $i]${elink} [format %-16s $chop] $chost"
-        if {"X" != "X$info"} {
-          puts $fd "<tr><td></td><td colspan=2><strong>Info:</strong> $info</td>"
-          puts $fdl "   <strong>Info:</strong> $info"
-        }
-      }
-      puts $fd "</table></center>"
-      puts $fdl "</pre>"
-      puts $fd "<p><hr><address>Created by quesedilla v3 via"
-      puts $fd "<a href=\"http://www.calweb.com/~xerxes/eggdrop/\">"
-      puts $fd "eggdrop</a></address>"
-      puts $fdl "<p><hr><address>Created by quesedilla v3 via"
-      puts $fdl "<a href=\"http://www.calweb.com/~xerxes/eggdrop/\">"
-      puts $fdl "eggdrop</a></address>"
-      puts $fd "<address>This page is automatically refreshed.</address>"
-      puts $fd "</body></html>"
-      puts $fdl "</body></html>"
-      close $fd
-      close $fdl
-    }
-  }
-  timer $web_update do_ques
-}
-
-if {![info exists ques_going]} {
-  timer $web_update do_ques
-  set ques_going 1
-}
-set xxchans ""
-foreach i [array names webfile] {
-  set xxchans "$xxchans $i"
-  if {![info exists lynxfile($i)]} {
-    set xxchans "$xxchans (no lynx)"
-  }
-  set xxchans "${xxchans},"
-}
-set xxchans [string trimright $xxchans ","]
-putlog "Quesedilla v3:$xxchans"
-unset xxchans
diff -urN eggdrop1.3.29/scripts/ques5.tcl eggdrop1.3.29+scriptupd/scripts/ques5.tcl
--- eggdrop1.3.29/scripts/ques5.tcl	Thu Jan  1 01:00:00 1970
+++ eggdrop1.3.29+scriptupd/scripts/ques5.tcl	Mon Oct  4 21:24:53 1999
@@ -0,0 +1,363 @@
+# quesedilla, (c) 1995 Robey Pointer (c) 1999 Eggheads
+# v1 -- 20aug95
+# v2 -- 2oct95   [improved it]
+# v3 -- 17mar96  [fixed it up for 1.0 multi-channel]
+# v4 -- 3nov97  [Fixed it up for 1.3.0 version bots] by TG
+# v4.00001 nov97 [blurgh]
+# v5-BETA1 -- 26sep99 by rtc
+# o clean webfile var removal
+# o using timezone variable from config file
+# o unified options and removed unneccessary ones.
+# o convert urls, nicks etc. to HTML before we put them into the page.
+# o nice html source indenting
+# o replace the old file after the new one has completely written to
+#   disk
+# o the description still contained robey's address, replaced
+#   by the eggheads email.
+# o don't link any spaces in the HTML2.0 file
+# v5-RC1 -- 29sep99 by rtc
+# o info line wasn't converted to HTML.
+# o now supports bold, italic and underline text style and colors.
+# v5-FINAL -- 04oct99 by rtc
+# o style converter now strictly follows HTML standard.
+# o Fake color attributes with number > 2^32 don't cause TCL
+#   error anymore.
+# o now uses strftime as time and date functions have both been removed
+#   in 1.3.29
+
+# this will create an html file every so often (the default is once every
+# 5 minutes).  the html file will have a table showing the people currently
+# on the channel, their user at hosts, who's an op, and who's idle.  it
+# uses a table which some browsers (and pseudo-browsers like lynx) can't
+# see, but it can optionally make a second page which will support these
+# archaic browsers.  browsers supporting push-pull will receive the updated
+# page automatically periodically.
+#
+# if you have a "url" field defined for a user, their nickname in the
+# table will be a link pointing there.  otherwise it checks the info
+# line and comment field to see if they start with "http://" -- if so,
+# that link will be used.  as a last resort, it will make a "mailto:"
+# link if an email address is recorded for the user.
+#
+# feel free to modify and play with this.  the original was written in
+# 15 minutes, then at various times i fixed bugs and added features.
+# softlord helped me make the design look a little nicer. :)  if you make
+# any nifty improvements, please let us know.
+#                                       eggheads at eggheads.org
+
+# this line makes sure other scripts won't interfere
+if {[info exists web_file] || [array exists web_file]} {unset web_file}
+
+# You must define each channel you want a webfile for .
+# If you want a HTML2.0 file, too, put it's filename separated by
+# a colon to the same option, it goes to the same directory.
+#set web_file(#turtle) "/home/lamest/public_html/turtle.html:turtle-lynx.html"
+
+# This example demonstrates how to put lynx files into another dir.
+#set web_file(#gloom) "/home/lamest/public_html/gloom.html:lynx/gloom.html"
+
+# You can also prevent the HTML2.0 file from being written.
+#set web_file(#channel) "/home/lamest/public_html/channel.html"
+
+# You can even let the bot write only a HTML2.0.
+#set web_file(#blah) "/home/lamest/public_html/:blah.html"
+
+# how often should these html files get updated?
+# (1 means once every minute, 5 means once every 5 minutes, etc)
+set web_update 5
+
+# 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>"
+
+proc getnumber {string} {
+  set result ""
+  foreach char [split $string ""] {
+    if {[string first $char "0123456789"] == -1} {
+      return $result
+    } else {
+      append result $char
+    }
+  }
+  return $result
+}
+
+proc webify {string} {
+  # TCL8.1 only:
+  #return [string map {\" &quot; & &amp; < &lt; > &gt;} $string]
+
+  # Otherwise use this:
+  regsub -all "\\&" $string "\\&amp;" string
+  regsub -all "\"" $string "\\&quot;" string
+  regsub -all "<" $string "&lt;" string
+  regsub -all ">" $string "&gt;" 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 [string length $c]
+          append result "<FONT COLOR=\"$web_color($c)\">"
+          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 urlstrip {string} {
+  global web_urlchars
+  set result ""
+  foreach char [split $string ""] {
+    if {[string first $char $web_urlchars] != -1} {
+      append result $char
+    }
+  }
+  return $result
+}
+
+proc do_ques {} {
+  global web_file web_update web_timerid
+  global botnick timezone
+
+  if {[info exists web_timerid]} {unset web_timerid}
+
+  foreach chan [array names web_file] {
+    if {[lsearch -exact [string tolower [channels]] [string tolower $chan]] == -1} {continue}
+    set i [split $web_file($chan) ":"]
+    set dir ""
+    set file1 [lindex $i 0]
+    set file2 [lindex $i 1]
+    set j [string last "/" $file1]
+    if {$j != -1} {
+      set dir [string range $file1 0 $j]
+      set file1 [string range $file1 [expr $j + 1] end]
+    }
+    unset i j
+    if {$file1 != ""} {
+      set fd1 [open $dir$file1~new w]
+    } else {
+      set fd1 [open "/dev/null" w]
+    }
+    if {$file2 != ""} {
+      set fd2 [open $dir$file2~new w]
+    } else {
+      set fd2 [open "/dev/null" w]
+    }
+
+    puts $fd1 "<HTML>"
+    puts $fd1 "  <HEAD>"
+    puts $fd1 "    <TITLE>People on [webify $chan] right now</TITLE>"
+    puts $fd1 "    <META HTTP-EQUIV=\"Refresh\" CONTENT=\"[webify [expr $web_update * 60]]\">"
+    puts $fd1 "    <META NAME=\"GENERATOR\" VALUE=\"ques5.tcl\">"
+    puts $fd1 "  </HEAD>"
+    puts $fd1 "  <BODY>"
+
+    puts $fd2 "<HTML>"
+    puts $fd2 "  <HEAD>"
+    puts $fd2 "    <TITLE>People on [webify $chan] right now</TITLE>"
+    puts $fd2 "    <META HTTP-EQUIV=\"Refresh\" CONTENT=\"[webify [expr $web_update * 60]]\">"
+    puts $fd2 "    <META NAME=\"GENERATOR\" VALUE=\"ques5.tcl\">"
+    puts $fd2 "  </HEAD>"
+    puts $fd2 "  <BODY>"
+    if {![onchan $botnick $chan]} {
+      puts $fd1 "    <H1>Oops!</H1>"
+      puts $fd1 "    I'm not on [webify $chan] right now for some reason<BR>"
+      puts $fd1 "    IRC isn't a very stable place these days..."
+      puts $fd1 "    Please try again later!<BR>"
+
+      puts $fd2 "    <H1>Oops!</H1>"
+      puts $fd2 "    I'm not on [webify $chan] right now for some reason<BR>"
+      puts $fd2 "    IRC isn't a very stable place these days..."
+      puts $fd2 "    Please try again later!<BR>"
+    } else {
+      puts $fd1 "    <H1>[webify $chan]</H1>"
+      puts $fd2 "    <H1>[webify $chan]</H1>"
+      if {$file2 != ""} {
+        puts $fd1 "    If this page looks screwy on your browser, "
+        puts $fd1 "    try the <A HREF=\"$file2\">HTML 2.0 "
+        puts $fd1 "    version</A>.<BR>"
+      }
+      puts $fd1 "    <TABLE BORDER=\"1\" CELLPADDING=\"4\">"
+      puts $fd1 "      <CAPTION>People on [webify $chan] as of [webify [strftime %a,\ %d\ %b\ %Y\ %H:%M\ %Z]]</CAPTION>"
+      puts $fd1 "      <TR>"
+      puts $fd1 "        <TH ALIGN=\"LEFT\">Nickname</TH>"
+      puts $fd1 "        <TH ALIGN=\"LEFT\">Status</TH>"
+      puts $fd1 "        <TH ALIGN=\"LEFT\">User at Host</TH>"
+      puts $fd1 "      </TR>"
+      puts $fd2 "    <EM>People on [webify $chan] as of [webify [strftime %a,\ %d\ %b\ %Y\ %H:%M\ %Z]]</EM>"
+      puts $fd2 "    <PRE>"
+      puts $fd2 "      Nickname  Status           User at Host"
+      foreach nick [chanlist $chan] {
+        set len1 9
+        set len2 16
+        puts $fd1 "      <TR ALIGN=\"LEFT\" VALIGN=\"TOP\">"
+        if {[isop $nick $chan]} {lappend status "op"}
+        if {[getchanidle $nick $chan] > 10} {lappend status "idle"}
+        set host [getchanhost $nick $chan]
+        set handle [finduser $nick!$host]
+        set host [webify $host]
+        if {[onchansplit $nick $chan]} {
+          lappend status "<STRONG>split</STRONG>"
+          #incr len2 [string length "<STRONG></STRONG>"]
+          incr len2 17
+        }
+        if {![info exists status]} {
+          set status "-"
+        } else {
+          set status [join $status ", "]
+        }
+        set url [urlstrip [getuser $handle XTRA url]]
+        set info [getuser $handle INFO]
+        set comment [getuser $handle COMMENT]
+        set email [getuser $handle XTRA email]
+        if {$url == "" && [string range $comment 0 6] == "http://"} {
+          set url [urlstrip $comment]
+        }
+        if {$url == "" && [string range $info 0 6] == "http://"} {
+          set url [urlstrip $info]
+        }
+        if {$url == "" && $email != "" && [string match *@*.* $email]} {
+          set url [urlstrip mailto:$email]
+        }
+        incr len1 [string length [webify $nick]]
+        incr len1 -[string length $nick]
+        if {[string tolower $nick] == [string tolower $botnick]} {
+          set host "<EM>&lt;- it's me, the channel bot!</EM>"
+          set info ""
+        } elseif {[matchattr $handle b]} {
+          set host "<EM>&lt;- it's another channel bot</EM>"
+          set info ""
+        }
+        if {$url != ""} {
+          incr len1 [string length "<A HREF=\"$url\"></A>"]
+          puts $fd1 "        <TD><A HREF=\"$url\">[webify $nick]</A></TD>"
+          puts $fd2 "      [format %-${len1}s <A\ HREF=\"$url\">[webify $nick]</A>] [format %-${len2}s $status] $host"
+        } else {
+          puts $fd1 "        <TD>[webify $nick]</TD>"
+          puts $fd2 "      [format %-${len1}s [webify $nick]] [format %-${len2}s $status] $host"
+        }
+        puts $fd1 "        <TD>$status</TD>"
+        puts $fd1 "        <TD>$host</TD>"
+        puts $fd1 "      </TR>"
+        if {$info != ""} {
+          puts $fd1 "      <TR ALIGN=\"LEFT\" VALIGN=\"TOP\">"
+          puts $fd1 "        <TD></TD><TD COLSPAN=\"2\"><STRONG>Info</STRONG>: [convstyle [webify $info]]</TD>"
+          puts $fd1 "      </TR>"
+          puts $fd2 "                <STRONG>Info:</STRONG> [convstyle [webify $info]]"
+        }
+        unset len1 len2 status info url host comment email
+      }
+      puts $fd1 "    </TABLE>"
+      puts $fd2 "    </PRE>"
+    }
+    puts $fd1 "    <HR>"
+    puts $fd1 "    This page is automatically refreshed every [webify $web_update] minute(s).<BR>"
+    puts $fd1 "    <ADDRESS>Created by quesedilla v5 via <A HREF=\"http://www.eggheads.org/\">eggdrop</A>.</ADDRESS>"
+    puts $fd1 "  </BODY>"
+    puts $fd1 "</HTML>"
+    puts $fd1 ""
+    puts $fd2 "    <HR>"
+    puts $fd2 "    This page is automatically refreshed every [webify $web_update] minute(s).<BR>"
+    puts $fd2 "    <ADDRESS>Created by quesedilla v5 via <A HREF=\"http://www.eggheads.org/\">eggdrop</A>.</ADDRESS>"
+    puts $fd2 "  </BODY>"
+    puts $fd2 "</HTML>"
+    puts $fd2 ""
+    close $fd1
+    close $fd2
+    if {$file1 != ""} {exec /bin/mv $dir$file1~new $dir$file1}
+    if {$file2 != ""} {exec /bin/mv $dir$file2~new $dir$file2}
+    unset nick file1 file2 dir fd1 fd2
+  }
+
+  set web_timerid [timer $web_update do_ques]
+}
+
+#if {[info exists web_timerid]} {
+#  killtimer $web_timerid
+#  unset web_timerid
+#}
+if {![info exists web_timerid] && $web_update > 0} {
+  set web_timerid [timer $web_update do_ques]
+}
+#do_ques
+
+foreach chan [array names web_file] {
+  if {[string first ":" $web_file($chan)] != -1} {
+    lappend channels "$chan"
+  } else {
+    lappend channels "$chan (no lynx)"
+  }
+}
+
+if {![info exists channels]} {
+  putlog "Quesedilla v5 BETA loaded (no channels)"
+} else {
+  putlog "Quesedilla v5 BETA loaded: [join $channels ,\ ]"
+  unset channels
+}
+
+if {![info exists timezone]} {
+  set timezone [clock format 0 -format %Z]
+}
+


More information about the Patches mailing list