Mercurial > hg > egg-tcls

changeset 0:1c4e2814cd41

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Initial import.
author Matti Hamalainen <ccr@tnsp.org>
date Tue, 21 Sep 2010 13:12:49 +0300
parents
children bdb2b1fd6601
files feeds.tcl hae_feedit.tcl hae_ruoka.tcl hae_saatiedot.tcl help.tcl index.desc index.php laske.tcl mndb.tcl ruoka.tcl spededb.tcl tj.tcl urllog.php.txt urllog.tcl urllog_upgrade wordkick.tcl
diffstat 16 files changed, 2790 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/feeds.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,190 @@
+############################################################################
+#
+# FeedCheck v0.7 by ccr/TNSP <ccr@tnsp.org>
+# (C) Copyright 2008-2010 Tecnic Software productions (TNSP) 
+#
+# Requires get_feeds.tcl to be run as a cronjob, for example
+# 15 * * * *     /absolute/path/to/get_feeds.tcl
+#
+# This script is freely distributable under GNU GPL (version 2) license.
+#
+############################################################################
+
+# Datafile, MUST be set to same as in get_feeds.tcl
+set feeds_datafile "/home/niinuska/bot/data.feeds"
+
+# Set channels and feed filters here:
+# "channel" "feedname|feedname2"
+# feednames can use matching, e.g. "mtv3*" would match all beginning with "mtv3"
+array set feeds_channels {
+  "mazmlame" "the adventurers|oots|mestari|blastwave"
+  "fireball" "mestari"
+  "tnsp" "the adventurers|oots|mestari"
+}
+
+
+set feeds_preferredmsg "PRIVMSG"
+
+
+############################################################################
+# No need to look below this line
+############################################################################
+set feeds_name "FeedCheck"
+set feeds_message "$feeds_name v0.7 by ccr/TNSP"
+
+putlog "$feeds_message"
+bind pub - !feeds feeds_pubfetch
+bind pub - !last feeds_publast
+
+
+# -------------------------------------------------------------------------
+proc feeds_smsg {uchan umsg} {
+  global feeds_preferredmsg
+  putserv "$feeds_preferredmsg $uchan :$umsg"
+}
+
+proc feeds_log {umsg} {
+  global feeds_name
+  putlog "$feeds_name: $umsg"
+}
+
+proc feeds_msg {urec} {
+  global feeds_channels
+  set uname [string tolower [lindex $urec 1]]
+  foreach {uchan ufilter} [array get feeds_channels] {
+    foreach umatch [split [string tolower $ufilter] "|"] {
+      if {[string match $umatch $uname]} {
+        feeds_smsg "#$uchan" "[lindex $urec 1]: \002[lindex $urec 3]\002 -- [lindex $urec 2]"
+      }
+    }
+  }
+}
+
+proc feeds_ctime {utime} {
+  if {$utime == "" || $utime == "*"} {
+    set utime 0
+  }
+  return [clock format $utime -format "%d.%m.%Y %H:%M"]
+}
+
+
+# -------------------------------------------------------------------------  
+proc feeds_check {} {
+  global feeds_datafile
+  
+  set results {}
+  
+  # Otetaan aika
+  set newtime [clock seconds]
+  
+  # Haetaan edellinen
+  set oldtime 0
+  if {![catch {set ufile [open "$feeds_datafile.time" r 0600]} uerrmsg]} {
+    gets $ufile oldtime
+    close $ufile
+  } else {
+    feeds_log "Could not open timefile: $uerrmsg"
+  }
+  
+  # Tarkistetaan
+  if {![catch {set ufile [open "$feeds_datafile" r 0600]} uerrmsg]} {
+    while {![eof $ufile]} {
+      gets $ufile uline
+      set urec [split $uline "½"]
+      if {[llength $urec] == 4 && [lindex $urec 0] > $oldtime} {
+        lappend results $urec
+      }
+    }
+    close $ufile
+  } else {
+    feeds_log "Could not open datafile: $uerrmsg"
+  }
+  
+  # Talletetaan
+  if {[llength $results] > 0} {
+    if {![catch {set ufile [open "$feeds_datafile.time" w 0600]} uerrmsg]} {
+      puts $ufile $newtime
+      close $ufile
+    }
+  }
+  
+  return $results
+}
+
+# -------------------------------------------------------------------------  
+proc feeds_exec {} {
+  feeds_log "Checking for new entries."
+  set uresult [feeds_check]
+  set nresult [llength $uresult]
+  if {$nresult >= 20} {
+    feeds_log "$nresult entries, probably broken datafile. Ignoring."
+  } else {
+    foreach urec $uresult { feeds_msg $urec }
+  }
+  timer 5 feeds_exec
+}
+
+if {![info exists feeds_running]} {
+  feeds_log "Starting timed feed check."
+  timer 5 feeds_exec
+  set feeds_running 1
+}
+
+# -------------------------------------------------------------------------
+proc feeds_pubfetch {unick uhost uhand uchan utext} {
+  feeds_log "Manual check invoked on $uchan."
+  set uresult [feeds_check]
+  set nresult [llength $uresult]
+  if {$nresult > 0} {
+    if {$nresult >= 20} {
+      feeds_smsg $uchan "$nresult uutta, tod. näk. epäsynkissä. Ignoorataan."
+    } else {
+      foreach urec $uresult { feeds_msg $urec }
+      feeds_smsg $uchan "$nresult uutta."
+    }
+  } else {
+    feeds_smsg $uchan "Ei uusia."
+  }
+  
+}
+
+
+# -------------------------------------------------------------------------  
+proc feeds_checklast {ufeed} {
+  global feeds_datafile
+  
+  set result ""
+  set oldtime 0
+  set matsi [string tolower "*$ufeed*"]
+  
+  # Tarkistetaan
+  if {![catch {set ufile [open "$feeds_datafile" r 0600]} uerrmsg]} {
+    while {![eof $ufile]} {
+      gets $ufile uline
+      set urec [split $uline "½"]
+      if {[llength $urec] == 4 && [lindex $urec 0] >= $oldtime} {
+        if {[string match $matsi [string tolower [lindex $urec 1]]]} {
+          set result $urec
+          set oldtime [lindex $urec 0]
+        }
+      }
+    }
+    close $ufile
+  } else {
+    feeds_log "Could not open datafile: $uerrmsg"
+  }
+  
+  return $result
+}
+
+
+proc feeds_publast {unick uhost uhand uchan utext} {
+  set uresult [feeds_checklast $utext]
+  if {$uresult != ""} {
+    feeds_smsg $uchan "Uusin '[lindex $uresult 1]' / [feeds_ctime [lindex $uresult 0]]: [lindex $uresult 3] -- [lindex $uresult 2]"
+  } else {
+    feeds_smsg $uchan "Ei osumia haulla '$utext'."
+  }
+  
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/hae_feedit.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,191 @@
+#!/usr/bin/tclsh
+############################################################################
+#
+# FeedCheck fetcher v0.7 by ccr/TNSP <ccr@tnsp.org>
+# (C) Copyright 2008-2010 Tecnic Software productions (TNSP) 
+#
+# This script is freely distributable under GNU GPL (version 2) license.
+#
+############################################################################
+
+# Datafile, MUST be set to same as in feeds.tcl
+set datafile "/home/niinuska/bot/data.feeds"
+
+# Use a HTTP proxy? 1 = yes, 0 = no
+set http_proxy 0
+
+# HTTP proxy address and port
+set http_proxy_host "cache.inet.fi"
+set http_proxy_port 800
+
+
+##############################################################################
+set html_ent [split "&#160;| |&raquo;|>>|&quot;|\"|&auml;|ä|&ouml;|ö|&Auml;|Ä|&Ouml;|Ö|&amp;|&|&lt;|<|&gt;|>|ä|ä|ö|ö|Ä|Ä" "|"]
+
+package require http
+::http::config -urlencoding iso8859-1 -useragent "Mozilla/4.0 (compatible; MSIE 6.0; MSIE 5.5; Windows NT 5.0) Opera 9.5"
+if {$http_proxy != 0} {
+	::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port
+}
+
+
+proc convert_ent {udata} {
+	global html_ent
+	return [string map $html_ent $udata]
+}
+
+
+proc add_entry {uname uprefix uurl udesc} {
+	global entries isentries newurls currclock
+	set utest "$uprefix[convert_ent $uurl]"
+	set isentries($utest) 1
+	if {[catch {set utmp $entries($utest)}]} {
+		set entries($utest) [list $currclock $uname $utest [convert_ent $udesc]]
+		incr newurls
+	}
+}
+
+
+proc add_rss_feed {datauri dataname dataprefix} {
+	if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} {
+		puts "Error getting $datauri: $uerrmsg"
+		return 1
+	}
+	set upage [::http::data $utoken]
+	::http::cleanup $utoken
+	
+	set umatches [regexp -all -nocase -inline -- "<item>.\*\?<title><..CDATA.(.\*\?)\\\]\\\]></title>.\*\?<link>(http.\*\?)</link>.\*\?</item>" $upage]
+	set nmatches [llength $umatches]
+	for {set n 0} {$n < $nmatches} {incr n 3} {
+		add_entry $dataname $dataprefix [lindex $umatches [expr $n+2]] [lindex $umatches [expr $n+1]]
+	}
+	
+	if {$nmatches == 0} {
+	set umatches [regexp -all -nocase -inline -- "<item>.\*\?<title>(.\*\?)</title>.\*\?<link>(http.\*\?)</link>.\*\?</item>" $upage]
+	set nmatches [llength $umatches]
+	for {set n 0} {$n < $nmatches} {incr n 3} {
+		add_entry $dataname $dataprefix [lindex $umatches [expr $n+2]] [lindex $umatches [expr $n+1]]
+	}
+	}
+
+	if {$nmatches == 0} {
+	set umatches [regexp -all -nocase -inline -- "<item \[^>\]*>.\*\?<title>(.\*\?)</title>.\*\?<link>(http.\*\?)</link>.\*\?</item>" $upage]
+	set nmatches [llength $umatches]
+	for {set n 0} {$n < $nmatches} {incr n 3} {
+		add_entry $dataname $dataprefix [lindex $umatches [expr $n+2]] [lindex $umatches [expr $n+1]]
+	}
+	}
+	return 0
+}
+
+
+##############################################################################
+### Luetaan vanhat paskat
+set oldurls 0
+set newurls 0
+if {![catch {set ufile [open $datafile r 0600]} uerrmsg]} {
+	while {![eof $ufile]} {
+		gets $ufile uline
+		set urec [split $uline "½"]
+		if {[llength $urec] == 4} {
+			set entries([lindex $urec 2]) $urec
+			set isentries([lindex $urec 2]) 0
+			incr oldurls
+		}
+	}
+	close $ufile
+}
+set currclock [clock seconds]
+
+
+##############################################################################
+### Haetaan ja parsitaan Halla-ahon jutut
+set datauri "http://www.halla-aho.com/scripta/";
+set dataname "Mestari"
+if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} {
+	puts "Error getting $datauri: $uerrmsg"
+} else {
+	set upage [::http::data $utoken]
+	::http::cleanup $utoken
+	
+	set umatches [regexp -all -nocase -inline -- "<a href=\"(\[^\"\]+\.html)\"><b>(\[^<\]+)</b>" $upage]
+	set nmatches [llength $umatches]
+	for {set n 0} {$n < $nmatches} {incr n 3} {
+		add_entry $dataname $datauri [lindex $umatches [expr $n+1]] [lindex $umatches [expr $n+2]]
+	}
+
+	set umatches [regexp -all -nocase -inline -- "<a href=\"(\[^\"\]+\.html)\">(\[^<\]\[^b\]\[^<\]+)</a>" $upage]
+	set nmatches [llength $umatches]
+	for {set n 0} {$n < $nmatches} {incr n 3} {
+		add_entry $dataname $datauri [lindex $umatches [expr $n+1]] [lindex $umatches [expr $n+2]]
+	}
+}
+
+
+### The Adventurers
+set datauri "http://www.peldor.com/chapters/index_sidebar.html";
+set dataname "The Adventurers"
+if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} {
+	puts "Error getting $datauri: $uerrmsg"
+} else {
+	set upage [::http::data $utoken]
+	::http::cleanup $utoken
+	
+	set umatches [regexp -all -nocase -inline -- "<a href=\"(\[^\"\]+)\">(\[^<\]+)</a>" $upage]
+	set nmatches [llength $umatches]
+	for {set n 0} {$n < $nmatches} {incr n 3} {
+		add_entry $dataname "http://www.peldor.com/" [lindex $umatches [expr $n+1]] [lindex $umatches [expr $n+2]]
+	}
+}
+
+
+### Order of the Stick
+set datauri "http://www.giantitp.com/comics/oots.html";
+set dataname "OOTS"
+if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} {
+	puts "Error getting $datauri: $uerrmsg"
+} else {
+	set upage [::http::data $utoken]
+	::http::cleanup $utoken
+	
+	set umatches [regexp -all -nocase -inline -- "<a href=\"(/comics/oots\[0-9\]+\.html)\">(\[^<\]+)</a>" $upage]
+	set nmatches [llength $umatches]
+	for {set n 0} {$n < $nmatches} {incr n 3} {
+		add_entry $dataname "http://www.giantitp.com" [lindex $umatches [expr $n+1]] [lindex $umatches [expr $n+2]]
+	}
+}
+
+
+### Hae RSS-feedit
+add_rss_feed "http://www.kaleva.fi/rss/145.xml" "Kaleva/Tiede" ""
+
+#add_rss_feed "http://sektori.com/?tpl=rssNewsFeed" "Sektori" ""
+
+add_rss_feed "http://www.effi.org/xml/uutiset.rss" "EFFI" ""
+
+add_rss_feed "http://www.mtv3.fi/rss/uutiset_rikos.rss" "MTV3/Rikos" ""
+
+add_rss_feed "http://www.blastwave-comic.com/rss/blastwave.xml" "Blastwave" ""
+
+#add_rss_feed "http://lehti.samizdat.info/feed/" "Lehti" ""
+
+##############################################################################
+### Avataan tulostiedosto
+set tmpfname "$datafile.tmp"
+if {[catch {set outfile [open $tmpfname w 0600]} uerrmsg]} {
+	puts "Error opening $tmpfname for writing: $uerrmsg"
+	return 1
+}
+
+set uexpire [expr [clock seconds] - (7*24*60*60)]
+foreach {ukey udata} [array get entries] {
+#	if {$isentries($ukey) != 0 || [lindex $udata 0] >= $uexpire} {
+		puts $outfile [join $udata "½"]
+#	}
+}
+
+close $outfile
+if {[catch {file rename -force -- $tmpfname $datafile} uerrmsg]} {
+	puts "Error renaming $tmpfname to $datafile: $uerrmsg"
+}
+#puts "$newurls new entries."
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/hae_ruoka.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,138 @@
+#!/usr/bin/tclsh
+##########################################################################
+#
+# RuokaLista fetcher v1.0 by ccr/TNSP <ccr@tnsp.org>
+# (C) Copyright 2010 Tecnic Software productions (TNSP)
+#
+##########################################################################
+
+# Datatiedosto, oltava sama kuin ruoka.tcl:n vastaava asetus
+set datafile "/home/niinuska/bot/data.ruoka"
+
+# Käytä HTTP proxya? 1 = kyllä, 0 = ei
+set http_proxy 0
+
+# HTTP proxyn osoite ja portti
+set http_proxy_host "cache.inet.fi"
+set http_proxy_port 800
+
+
+##############################################################################
+set html_ent [split "\n| |\r| |<br />| |&nbsp;| |&#160;| |&raquo;|>>|&quot;|\"|&auml;|ä|&ouml;|ö|&Auml;|Ä|&Ouml;|Ö|&amp;|&|&lt;|<|&gt;|>|ä|ä|ö|ö|Ä|Ä" "|"]
+
+package require http
+::http::config -urlencoding iso8859-1 -useragent "Mozilla/4.0 (compatible; MSIE 6.0; MSIE 5.5; Windows NT 5.0) Opera 9.5"
+if {$http_proxy != 0} {
+  ::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port
+}
+
+
+proc convert_ent {udata} {
+  global html_ent
+  return [string map $html_ent $udata]
+}
+
+
+proc add_entry {uname uday udate udesc} {
+  global entries
+  set utest "$uname:$udate"
+  if {[catch {set utmp $entries($utest)}]} {
+    set entries($utest) [list $uname $uday $udate $udesc]
+  }
+}
+
+
+proc add_amica {datauri dataname} {
+  if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} {
+    puts "Error getting $datauri: $uerrmsg"
+    return 1
+  }
+
+  set upage [::http::data $utoken]
+  ::http::cleanup $utoken
+  
+  set nmatches 1
+  while {$nmatches > 0} {
+    set umatches [regexp -nocase -inline -- "<strong>(Maanantai|Tiistai|Keskiviikko|Torstai|Perjantai|Lauantai|Sunnuntai)</strong></td>.?.?<td colspan=\"2\"><strong>(\[^<\]+)</strong></td>(.*)\$" $upage]
+    set nmatches [llength $umatches]
+    if {$nmatches > 3} {
+      set umat [regexp -nocase -inline -- "^(.+?)(<td colspan=\"3\">|</tbody>)" [lindex $umatches 3]]
+      set umat [regexp -all -nocase -inline -- "<td colspan=\"\[78\]\">(.\*\?)</td>" [lindex $umat 1]]
+      set tmp ""
+      foreach {ukey udata} $umat {
+        set item [string trim [convert_ent $udata]]
+        if {[string length $item] > 0} {
+      	  lappend tmp $item
+      	}
+      }
+      add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "]
+    }
+    set upage [lindex $umatches 3]
+  }
+  
+  return 0
+}
+
+proc add_uniresta {datauri dataname} {
+  if {[catch {set utoken [::http::geturl $datauri -binary true -timeout 5000]} uerrmsg]} {
+    puts "Error getting $datauri: $uerrmsg"
+    return 1
+  }
+
+  set upage [::http::data $utoken]
+  ::http::cleanup $utoken
+  
+  set nmatches 1
+  while {$nmatches > 0} {
+    set umatches [regexp -nocase -inline -- "<span class='otsikko'>(Maanantai|Tiistai|Keskiviikko|Torstai|Perjantai|Lauantai|Sunnuntai) +(\[^<\]+)</span>(.*)\$" $upage]
+    set nmatches [llength $umatches]
+    if {$nmatches > 3} {
+      set umat [regexp -nocase -inline -- "^(.+?)<br /><br /><br />" [lindex $umatches 3]]
+      set umat [regexp -all -nocase -inline -- "(.\*\?)<br>" [lindex $umat 1]]
+      set tmp ""
+      foreach {ukey udata} $umat {
+        set item [string trim [convert_ent $udata]]
+        if {[string length $item] > 0} {
+      	  lappend tmp $item
+      	}
+      }
+      add_entry $dataname [lindex $umatches 1] [lindex $umatches 2] [join $tmp "; "]
+    }
+    set upage [lindex $umatches 3]
+  }
+  
+  return 0
+}
+
+
+##############################################################################
+# Amica/OAMK tekniikan yksikkö
+add_amica "http://www.amica.fi/kotkanpoika" "OAMK"
+
+# Oulun yliopiston Unirestat
+add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=2"  "Aularavintola"
+add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=3"  "Discus"
+add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=4"  "Julinia"
+add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=5"  "Kastari"
+add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=6"  "Snellmania"
+add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=7"  "Pruxis"
+add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=10" "Vanilla"
+add_uniresta "http://www.uniresta.fi/uniresta.php?ruokalista=11" "Minttu"
+
+
+##############################################################################
+### Open result datafile and save data
+set tmpfname "$datafile.tmp"
+if {[catch {set outfile [open $tmpfname w 0600]} uerrmsg]} {
+  puts "Error opening $tmpfname for writing: $uerrmsg"
+  return 1
+}
+
+foreach {ukey udata} [array get entries] {
+  puts $outfile [join $udata "½"]
+}
+
+close $outfile
+if {[catch {file rename -force -- $tmpfname $datafile} uerrmsg]} {
+  puts "Error renaming $tmpfname to $datafile: $uerrmsg"
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/hae_saatiedot.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,62 @@
+#!/usr/bin/tclsh
+
+# Polku ja tiedosto mihin tiedot talletetaan
+set datafile "/home/niinuska/bot/saa.data"
+
+# HTTP proxy
+# 1 = kyllä
+# 0 = ei
+set use_proxy 0
+
+# HTTP proxy osoite ja portti (jos ed. optio 1)
+set http_proxy_host "cache.inet.fi"
+set http_proxy_port 800
+
+
+##############################################################################
+package require http
+::http::config -urlencoding iso8859-1 -useragent "Mozilla/4.0 (compatible; MSIE 6.0; MSIE 5.5; Windows NT 5.0) Opera 9.5"
+if {$use_proxy != 0} {
+	::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port
+}
+
+
+##############################################################################
+proc fetch_uri {uurl} {
+	global ngot
+	if {[catch {set utoken [::http::geturl $uurl -binary true -timeout 5000]} uerrmsg]} {
+		puts "Error getting #$uurl: $uerrmsg"
+		return ""
+	} else {
+		incr ngot
+		set udata [::http::data $utoken]
+		::http::cleanup $utoken
+		return $udata
+	}
+}
+
+##############################################################################
+set tmpfname "$datafile.tmp"
+if {[catch {set savefile [open $tmpfname w 0600]} uerrmsg]} {
+	puts "Error opening $tmpfname: $uerrmsg"
+	return 1
+}
+
+# Haetaan 22 framea osoitteista 
+# http://www.tiehallinto.fi/alk/tiesaa/tiesaa_maak_1.html -
+# http://www.tiehallinto.fi/alk/tiesaa/tiesaa_maak_22.html
+# ja talletetaan kaikki samaan tiedostoon
+set ngot 0
+for { set i 1 } { $i < 23 } { incr i } {
+	puts $savefile [fetch_uri "http://alk.tiehallinto.fi/alk/tiesaa/tiesaa_maak_$i.html"]
+}
+
+#set paske [fetch_uri "http://www.wunderground.com/global/stations/56294.html"]
+
+close $savefile
+if {$ngot > 5} {
+	if {[catch {file rename -force -- $tmpfname $datafile} uerrmsg]} {
+		puts "Error renaming $tmpfname to $datafile: $uerrmsg"
+	}
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/help.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,30 @@
+############################################################################
+# Niinuska Help
+############################################################################
+set nn_message "Niinuska Help v0.1 by ccr/TNSP"
+set nn_preferredmsg "PRIVMSG"
+
+putlog "$nn_message"
+bind pub - !help nn_pubmsg
+bind pub - !apua nn_pubmsg
+
+# -------------------------------------------------------------------------
+proc nn_smsg {udest umsg} {
+  global nn_preferredmsg
+
+  putserv "$nn_preferredmsg $udest :$umsg"
+}
+
+
+# -------------------------------------------------------------------------  
+proc nn_pubmsg {nick uhost hand chan args} {
+  if {$args == "{}" || $args == ""} { set args $hand }
+
+  nn_smsg $chan "Lisätietoja: http://tnsp.org/irc/readme.php"
+  nn_smsg $chan "!sää \[paikka|minmax\] ; !urlfind <+sana|-sana|%käyttäjä> ; !tj \[käyttäjä\] ; !tjaamut \[-\]vuorokaudet \[\[-\]tunnit\]"
+  nn_smsg $chan "!laske <kaava> (\002HUOM! Pyöristää vakiona lähimpään kokonaislukuun, käytä yhtä desimaalikua vaihtaaksesi tarkkuuden\002)"
+  nn_smsg $chan "!spede \[nro\] ; !spedefind <+sana|-sana|%käyttäjä> ; !mn \[nro\] ; !mnfind <+sana|-sana|%käyttäjä>"
+  return 1
+}
+
+# -------------------------------------------------------------------------
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/index.desc	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,17 @@
+<p>
+This directory contains <b>development versions</b> of my TCL-scripts
+for Eggdrop bot. THERE IS ABSOLUTELY NO WARRANTY OR GUARANTEE THAT THESE
+SCRIPTS WORK AT ALL. <b>I am not interested about any problems with these
+scripts.</b>
+</p>
+
+<p>
+There is also no documentation about these except the texts
+found in scripts themselves. If you can't figure out them yourself...
+well, that's too bad.
+</p>
+
+<p>
+- ccr/TNSP, 2010
+</p>
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/index.php	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,5 @@
+<?
+$pageTitle = "Eggdrop IRC-bot TCL scripts";
+$pageFilename = "../mdirlist.inc.php";
+require "../mpage.inc.php";
+?>
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/laske.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,69 @@
+############################################################################
+#
+# Laske v0.2 by ccr/TNSP <ccr@tnsp.org>
+# (C) Copyright 2008 Tecnic Software productions (TNSP) 
+#
+# This script is freely distributable under GNU GPL (version 2) license.
+#
+############################################################################
+
+set laske_preferredmsg "PRIVMSG"
+
+
+############################################################################
+# No need to look below this line
+############################################################################
+set laske_message "Laske v0.2 by ccr/TNSP"
+set laske_reps [split "\$|| ||^|**|pi|3.14159265|e|2.71828183" "|"]
+
+putlog "$laske_message"
+bind pub - !laske laske_pubmsg
+bind msg - laske laske_msg
+
+
+# -------------------------------------------------------------------------
+proc laske_smsg {udest umsg} {
+  global laske_preferredmsg
+  putserv "$laske_preferredmsg $udest :$umsg"
+}
+
+# -------------------------------------------------------------------------  
+proc laske_do {args} {
+  global laske_reps
+
+# Tama on jotain ihan uskomattoman perverssia
+  set lasku [join [join [string map $laske_reps $args] ""] ""]
+
+#  putlog "Laske: $args :: $lasku"
+  if {[catch { set res [expr $lasku] } errmsg]} {
+  	return $errmsg
+  } else {
+  	return "$lasku = $res"
+  }
+}
+
+# -------------------------------------------------------------------------  
+proc laske_pubmsg {nick uhost hand chan args} {
+  if {$args == {} || $args == ""} {
+  	laske_smsg $chan "Laa laalis paski."
+  	return 1
+  }
+
+  set result [laske_do $args]
+  laske_smsg $chan "$nick, $result"
+  return 1
+}
+
+# -------------------------------------------------------------------------  
+proc laske_msg {nick uhost hand args} {
+  if {$args == {} || $args == ""} {
+  	laske_smsg $nick "Laa laalis paski."
+  	return 1
+  }
+  
+  set result [laske_do $args]
+  laske_smsg $nick "$result"
+  return 1
+}
+
+# -------------------------------------------------------------------------
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mndb.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,346 @@
+##########################################################################
+#
+# MattiNykanenDB v0.7 by ccr/TNSP <ccr@tnsp.org>
+#
+# Not for public use or distribution. If you happen to find this,
+# send your questions and/or problems to /dev/null, thank you.
+#
+##########################################################################
+
+###
+### General options
+###
+# Filename where the logged quote data goes
+set mndb_file "data.mndb"
+
+# 1 = Verbose: Say messages PUBLIC when quote is OK, bad, etc.
+# 0 = Quiet  : Say privately
+set mndb_verbose 0
+
+# 1 = Put some info to bot's Logfile when doing stuff...
+# 0 = Don't.
+set mndb_logmsg 1
+
+# What IRC "command" should we use to send messages:
+# (Valid alternatives are "PRIVMSG" and "NOTICE")
+set mndb_preferredmsg "PRIVMSG"
+
+
+###
+### Search related settings
+###
+
+# How many quote's should the !mnfind command show (maximum limit)
+set mndb_showmax_pub 3
+
+# For private-search, this is the default limit (user can change it)
+set mndb_showmax_priv 5
+
+
+##########################################################################
+# No need to look below this line
+##########################################################################
+#-------------------------------------------------------------------------
+set mndb_name "MattiNykanenDB"
+set mndb_version "0.7"
+
+
+#-------------------------------------------------------------------------
+### Binding initializations
+bind pub - !mnfind mndb_pub_find
+bind pub - !mnadd mndb_pub_add
+bind pub - !mn mndb_pub_mn
+bind msg - mnfind mndb_msg_find
+bind msg - mn mndb_msg_mn
+
+
+### Initialization messages
+set mndb_message "$mndb_name v$mndb_version by ccr/TNSP"
+putlog "$mndb_message"
+
+
+#-------------------------------------------------------------------------
+### Utility functions
+proc mndb_log { jarg } {
+  global mndb_logmsg mndb_name
+
+  if {$mndb_logmsg != 0} {
+	putlog "$mndb_name: $jarg"
+	}
+}
+
+
+proc mndb_ctime { utime } {
+
+  if {$utime == "" || $utime == "*"} {
+	set utime 0
+	}
+
+  return [clock format $utime -format "%d.%m.%Y %H:%M"]
+}
+
+
+proc mndb_isnumber { uarg } {
+  set ufoo 1
+
+  foreach i [split $uarg {}] {
+	if ![string match \[0-9\] $i] {set ufoo 0}
+	}
+
+  return $ufoo
+}
+
+
+proc mndb_msg {apublic anick achan amsg} {
+global mndb_preferredmsg
+
+if {$apublic == 0} {
+	putserv "$mndb_preferredmsg $anick :$amsg" 
+	} else {
+	putserv "$mndb_preferredmsg $achan :$anick, $amsg"
+	}
+}
+
+
+#-------------------------------------------------------------------------
+proc mndb_add {utext unick uhost uchan upublic} {
+global mndb_file
+
+	if {[string length $utext] < 10} {
+		mndb_msg $upublic $unick $uchan "pyh."
+		return 0
+	}
+
+### Create the database file if it does not exist yet
+	set fd [open $mndb_file a+]
+	close $fd
+
+### OK. The quote is valid, but let's check if we already know it.
+	set fd [open $mndb_file r]
+	set sindex 0
+	set smax -1
+
+	while {![eof $fd]} {
+		gets $fd foo
+		incr sindex
+
+		set foo [split $foo "|"]
+		set qindex [lindex $foo 0]
+		if {$qindex > $smax} { set smax $qindex }
+		}
+
+	close $fd
+
+### OK, the quote was not already known and IS valid. Add it.
+
+        incr smax
+
+	set fd [open $mndb_file a+]
+	puts $fd "$smax|$utext|[unixtime]|$unick|$uhost|$uchan"
+	close $fd
+
+### Log some data
+	mndb_log "Added quote #$smax ($unick @ $uchan): $utext"
+
+### Let's report success to user
+	mndb_msg $upublic $unick $uchan "tietokantaa sörkitty (#$smax / $sindex), kiitos."
+
+	return 1
+}
+
+
+#-------------------------------------------------------------------------
+proc mndb_find {ipatterns imax} {
+global mndb_file
+
+### Search the database for pattern
+### Clear the count, open the quote logfile
+set iresults {}
+set nresults 0
+set fd [open $mndb_file r]
+
+### Start searching...
+while {![eof $fd]} {
+
+# Get one quote for inspection
+	gets $fd foo
+	set irecord [split [string tolower $foo] "|"]
+	set itext [lindex $irecord 1]
+	set iname [lindex $irecord 3]
+
+# Match with all given patterns and rules
+	set imatched 1
+
+	foreach ipattern $ipatterns {
+
+		set foob [split [string tolower $ipattern] " "]
+		set ftoken [lindex $foob 0]
+		set fparam [lindex $foob 1]
+		set fmatch [string match $fparam $itext]
+
+		if {($ftoken == "+") && ($fmatch == 0)} { set imatched 0 }
+
+		if {($ftoken == "-") && ($fmatch == 1)} { set imatched 0 }
+
+		if {($ftoken == "%") && ([string match $fparam $iname] == 0)} { set imatched 0 }
+
+		}
+
+# If the all patterns matched, add to the list...
+	if {($imatched == 1) && ($foo != "")} {
+		incr nresults
+		lappend iresults $foo
+		}
+
+	}
+
+# Close file
+close $fd
+
+# Take only last imax results
+return [lrange $iresults [expr $nresults-$imax] $nresults]
+}
+
+
+
+#-------------------------------------------------------------------------
+proc mndb_get { unick uhand uindex } {
+global mndb_file
+
+set ifound 0
+set iindex 0
+set iresults {}
+set nresults 0
+
+### Create the database file if it does not exist yet
+set fd [open $mndb_file a+]
+close $fd
+
+### OK. The quote is valid, but let's check if we already know it.
+set fd [open $mndb_file r]
+
+if {$uindex == ""} {
+### Log search
+	mndb_log "$unick/$uhand get random quote"
+
+### Do search
+	while {![eof $fd]} {
+		gets $fd foo
+		incr nresults
+		lappend iresults $foo
+		}
+
+	set foo [split [lindex $iresults [rand $nresults]] "|"]
+	set ifound 1
+
+} else {
+### Log search
+	mndb_log "$unick/$uhand searched quote #$uindex"
+
+### Do search
+	while {![eof $fd] && !$ifound} {
+		gets $fd foo
+		set foo [split $foo "|"]
+
+		if {[lindex $foo 0] == $uindex} {
+			set ifound 1
+			}
+		}
+}
+
+### Close file
+close $fd
+
+### Return result
+if {$ifound} {
+	return "#[lindex $foo 0]: [lindex $foo 1]"
+	} else {
+	return "ei löydy."
+	}
+}
+
+
+#-------------------------------------------------------------------------
+proc mndb_search {unick uhand uchan utext upublic} {
+global mndb_showmax_pub spmsg_nomatch
+
+### Log search
+	mndb_log "$unick/$uhand searched quote: $utext"
+
+### Parse the given command
+	set footokens [split $utext " "]
+	foreach ftoken $footokens {
+		set foomark [string range $ftoken 0 0]
+		set foopat  [string range $ftoken 1 end]
+
+		if {$foomark == "-" || $foomark == "+" || $foomark == "%"} {
+			lappend ipatlist "$foomark *$foopat*"
+			} else {
+			lappend ipatlist "+ *$ftoken*"
+			}
+	}
+	
+
+### Get the matches
+
+	set iresults [mndb_find $ipatlist $mndb_showmax_pub]
+
+### Show the results
+	if {$iresults != ""} {
+	foreach i $iresults {
+		set foo [split $i "|"]
+		mndb_msg $upublic $unick $uchan "#[lindex $foo 0]: [lindex $foo 1]"
+		}
+
+# If no quotes were found
+	} else {
+		mndb_msg $upublic $unick $uchan "ei löydy."
+	}
+}
+
+
+#-------------------------------------------------------------------------
+proc mndb_pub_mn {unick uhost uhand uchan utext} {
+
+mndb_msg 0 $uchan "" [mndb_get $unick $uhand $utext]
+}
+
+
+#-------------------------------------------------------------------------
+proc mndb_msg_mn {unick uhost uhand utext} {
+
+mndb_msg 0 $unick "" [mndb_get $unick $uhand $utext]
+}
+
+
+#-------------------------------------------------------------------------
+proc mndb_pub_add {unick uhost uhand uchan utext} {
+
+ mndb_add $utext $unick $uhost $uchan 1
+}
+
+
+#-------------------------------------------------------------------------
+proc mndb_pub_rm {unick uhost uhand uchan utext} {
+
+ mndb_rm $utext $unick $uhost $uchan 1
+}
+
+
+#-------------------------------------------------------------------------
+proc mndb_pub_find {unick uhost uhand uchan utext} {
+
+ mndb_search $unick $uhand $uchan $utext 1
+}
+
+
+#-------------------------------------------------------------------------
+proc mndb_msg_find {unick uhost uhand utext} {
+
+ mndb_search $unick $uhand "" $utext 0
+}
+
+
+#-------------------------------------------------------------------------
+
+# end of script
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/ruoka.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,212 @@
+##########################################################################
+#
+# RuokaLista v1.1 by ccr/TNSP <ccr@tnsp.org>
+# (C) Copyright 2004-2010 Tecnic Software productions (TNSP)
+#
+# Requires hae_ruoka.tcl to be run as a cronjob, for example
+# 15 * * * *     /absolute/path/to/hae_ruoka.tcl
+#
+# This script is freely distributable under GNU GPL (version 2) license.
+#
+##########################################################################
+
+# Vakioravintola, jos muuta ei annettu/asetettu
+set ruoka_restaurant "OAMK"
+
+# Datatiedosto, oltava sama kuin hae_ruoka.tcl:n vastaava asetus
+set ruoka_datafile "/home/niinuska/bot/data.ruoka"
+
+# Kellonaika, jolloin default-päivä vaihtuu seuraavaksi vuorokaudeksi
+# -1 = Ei vaihdeta
+# esim. 15 = klo 15 jälkeen näytetään vakiona seuraavan päivän ruokalista
+set ruoka_threshold 15
+
+# Yleiset asetukset
+set ruoka_logmsg 1
+set ruoka_preferredmsg "PRIVMSG"
+
+
+##########################################################################
+# No need to look below this line
+##########################################################################
+set ruoka_name "RuokaLista"
+set ruoka_version "1.1"
+
+### Binding initializations
+bind pub - !ruoka ruoka_get_pub
+bind msg - ruoka ruoka_get_msg
+bind pub - !ruokaset ruoka_set_pub
+
+### Initialization messages
+set ruoka_message "$ruoka_name v$ruoka_version by ccr/TNSP"
+putlog "$ruoka_message"
+
+set ruoka_days {Sunnuntai Maanantai Tiistai Keskiviikko Torstai Perjantai Lauantai}
+
+#-------------------------------------------------------------------------
+proc ruoka_log {arg} {
+  global ruoka_logmsg ruoka_name
+  if {$ruoka_logmsg != 0} {
+    putlog "$ruoka_name: $arg"
+  }
+}
+
+
+proc ruoka_msg {apublic anick achan amsg} {
+  global ruoka_preferredmsg
+  if {$apublic == 1} {
+    putserv "$ruoka_preferredmsg $achan :$amsg"
+  } else {
+    putserv "$ruoka_preferredmsg $anick :$amsg" 
+  }
+}
+
+
+proc ruoka_get_restaurants {urestaurants} {
+  global ruoka_datafile
+  upvar $urestaurants restaurants
+
+  if {![catch {set ufile [open "$ruoka_datafile" r 0600]} uerrmsg]} {
+    while {![eof $ufile]} {
+      gets $ufile uline
+      set urec [split $uline "½"]
+      if {[llength $urec] == 4} {
+        set restaurants([lindex $urec 0]) 1
+      }
+    }
+  }
+}
+
+
+proc ruoka_match_day {umatch} {
+  global ruoka_days
+  if {$umatch == "" || $umatch == "{}"} { return "" }
+  set udate ""
+  foreach i $ruoka_days {
+    if {[string match "$umatch*" [string tolower $i]]} { set udate $i }
+  }
+  return $udate
+}
+
+
+proc ruoka_match_restaurant {urestaurants umatch} {
+  upvar $urestaurants restaurants
+  if {$umatch == "" || $umatch == "{}"} { return "" }
+  foreach {nimi arvo} [array get restaurants] {
+    if {[string match "$umatch*" [string tolower $nimi]]} {
+      return $nimi
+    }
+  }
+  return ""
+}
+
+
+#-------------------------------------------------------------------------
+proc ruoka_get {unick uhand uchan uargs upublic} {
+  global ruoka_restaurant ruoka_datafile ruoka_days ruoka_threshold
+
+  # Get list of restaurants
+  ruoka_get_restaurants restaurants
+  
+  # Check and handle arguments
+  set ulist [split [string tolower $uargs] " "]
+  set rarg1 [lindex $ulist 0]
+  set rarg2 [lindex $ulist 1]
+
+  if {$rarg1 == "?" || $rarg1 == "help"} {
+    set tmp [join [array names restaurants] ", "]
+    ruoka_msg $upublic $unick $uchan "Käyttö: <!>ruoka \[ravintola\] \[päivä\]"
+    ruoka_msg $upublic $unick $uchan "Huom! Jos päivää ei anneta, tiedot haetaan tältä päivältä."
+    ruoka_msg $upublic $unick $uchan "Käyttö: <!>ruokaset <ravintola>"
+    ruoka_msg $upublic $unick $uchan "Jossa ravintola on yksi seuraavista: $tmp"
+    return 0
+  }
+
+  # Try to parse arguments, if any
+  set urestaurant ""
+  set udate ""
+  if {$rarg1 != ""} {
+    set udate [ruoka_match_day $rarg1]
+    if {$udate == ""} {
+      set udate [ruoka_match_day $rarg2]
+      set urestaurant [ruoka_match_restaurant restaurants $rarg1]
+    } else {
+      set urestaurant [ruoka_match_restaurant restaurants $rarg2]
+    }
+  }
+
+  # Default date to today
+  if {$udate == ""} {
+    set sstamp [unixtime]
+
+    # Check if threshold setting is active and act accordingly
+    if {$ruoka_threshold > 0 && [clock format $sstamp -format "%H"] > $ruoka_threshold} {
+      set sstamp [expr $sstamp + 60*60*(24 - $ruoka_threshold)+30]
+    }
+
+    set udate [lindex $ruoka_days [clock format $sstamp -format "%w"]]
+  }
+
+  # If no restaurant given, try to get one from user settings
+  if {$urestaurant == ""} {
+    set urestaurant [getuser $uhand XTRA "restaurant"]
+    # If still no known/set restaurant, use global default
+    if {$urestaurant == ""} {
+      set urestaurant $ruoka_restaurant
+    }
+  }
+
+  # Read datafile
+  if {![catch {set ufile [open "$ruoka_datafile" r 0600]} uerrmsg]} {
+    set found 0
+    while {![eof $ufile]} {
+      gets $ufile uline
+      set urec [split $uline "½"]
+      if {[llength $urec] == 4 && [lindex $urec 1] == $udate && [lindex $urec 0] == $urestaurant} {
+        ruoka_msg $upublic $unick $uchan "\002[lindex $urec 0]\002, [lindex $urec 1] \002[lindex $urec 2]\002: [lindex $urec 3]"
+        set found 1
+        break
+      }
+    }
+    close $ufile
+    if {$found == 0} {
+      ruoka_msg $upublic $unick $uchan "Ei tietoja ($udate, $urestaurant)"
+    }
+  } else {
+    ruoka_log "Could not open datafile: $uerrmsg"
+  }
+}
+
+
+
+#-------------------------------------------------------------------------
+proc ruoka_get_pub {unick uhost uhand uchan uargs} {
+  ruoka_get $unick $uhand $uchan $uargs 1
+  return 0
+}
+
+#-------------------------------------------------------------------------
+proc ruoka_get_msg {unick uhost uhand uargs} {
+  ruoka_get $unick $uhand "PRIV" $uargs 0
+  return 0
+}
+
+#-------------------------------------------------------------------------
+proc ruoka_set_pub {unick uhost uhand uchan uargs} {
+  array unset restaurants
+  ruoka_get_restaurants restaurants
+  set rav ""
+  if {$uargs != "{}" && $uargs != ""} {
+    set rav [ruoka_match_restaurant restaurants $uargs]
+  }
+  if {$rav != ""} {
+    ruoka_msg 1 $unick $uchan "Vakioravintolaksi asetettu: $rav"
+    setuser $uhand XTRA "restaurant" "$rav"
+  } else {
+    set tmp [join [array names restaurants] ", "]
+    ruoka_msg 1 $unick $uchan "Ravintolan oltava yksi seuraavista: $tmp"
+  }
+  return 0
+}
+
+# end of script
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/spededb.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,347 @@
+##########################################################################
+#
+# SpedeDB v0.7 by ccr/TNSP <ccr@tnsp.org>
+#
+# Not for public use or distribution. If you happen to find this,
+# send your questions and/or problems to /dev/null, thank you.
+#
+##########################################################################
+
+###
+### General options
+###
+# Filename where the logged SPEDE data goes
+set spdb_file "data.spededb"
+
+# 1 = Verbose: Say messages PUBLIC when SPEDE is OK, bad, etc.
+# 0 = Quiet  : Say privately
+set spdb_verbose 0
+
+# 1 = Put some info to bot's Logfile when doing stuff...
+# 0 = Don't.
+set spdb_logmsg 1
+
+# What IRC "command" should we use to send messages:
+# (Valid alternatives are "PRIVMSG" and "NOTICE")
+set spdb_preferredmsg "PRIVMSG"
+
+
+###
+### Search related settings
+###
+
+# How many SPEDE's should the !spedefind command show (maximum limit)
+set spdb_showmax_pub 3
+
+# For private-search, this is the default limit (user can change it)
+set spdb_showmax_priv 5
+
+
+##########################################################################
+# No need to look below this line
+##########################################################################
+#-------------------------------------------------------------------------
+set spdb_name "SpedeDB"
+set spdb_version "0.7"
+
+
+#-------------------------------------------------------------------------
+### Binding initializations
+bind pub - !spedefind spdb_pub_find
+bind pub - !spedeadd spdb_pub_add
+bind pub - !spede spdb_pub_spede
+bind msg - spedefind spdb_msg_find
+bind msg - spede spdb_msg_spede
+
+
+### Initialization messages
+set spdb_message "$spdb_name v$spdb_version by ccr/TNSP"
+putlog "$spdb_message"
+
+
+#-------------------------------------------------------------------------
+### Utility functions
+proc spdb_log { jarg } {
+  global spdb_logmsg spdb_name
+
+  if {$spdb_logmsg != 0} {
+	putlog "$spdb_name: $jarg"
+	}
+}
+
+
+proc spdb_ctime { utime } {
+
+  if {$utime == "" || $utime == "*"} {
+	set utime 0
+	}
+
+  return [clock format $utime -format "%d.%m.%Y %H:%M"]
+}
+
+
+proc spdb_isnumber { uarg } {
+  set ufoo 1
+
+  foreach i [split $uarg {}] {
+	if ![string match \[0-9\] $i] {set ufoo 0}
+	}
+
+  return $ufoo
+}
+
+
+proc spdb_msg {apublic anick achan amsg} {
+global spdb_preferredmsg
+
+if {$apublic == 0} {
+	putserv "$spdb_preferredmsg $anick :$amsg" 
+	} else {
+	putserv "$spdb_preferredmsg $achan :$anick, $amsg"
+	}
+}
+
+
+#-------------------------------------------------------------------------
+proc spdb_add {utext unick uhost uchan upublic} {
+global spdb_file
+
+
+if {"x$utext" == "x"} {
+	spdb_msg $upublic $unick $uchan "pyh."
+	return 0
+	}
+
+### Create the database file if it does not exist yet
+	set fd [open $spdb_file a+]
+	close $fd
+
+### OK. The SPEDE is valid, but let's check if we already know it.
+	set fd [open $spdb_file r]
+	set sindex 0
+	set smax -1
+
+	while {![eof $fd]} {
+		gets $fd foo
+		incr sindex
+
+		set foo [split $foo "|"]
+		set qindex [lindex $foo 0]
+		if {$qindex > $smax} { set smax $qindex }
+		}
+
+	close $fd
+
+### OK, the SPEDE was not already known and IS valid. Add it.
+
+        incr smax
+
+	set fd [open $spdb_file a+]
+	puts $fd "$smax|$utext|[unixtime]|$unick|$uhost|$uchan"
+	close $fd
+
+### Log some data
+	spdb_log "Added SPEDE #$smax ($unick @ $uchan): $utext"
+
+### Let's report success to user
+	spdb_msg $upublic $unick $uchan "tietokantaa sörkitty (#$smax / $sindex), kiitos."
+
+	return 1
+}
+
+
+#-------------------------------------------------------------------------
+proc spdb_find {ipatterns imax} {
+global spdb_file
+
+### Search the database for pattern
+### Clear the count, open the SPEDE logfile
+set iresults {}
+set nresults 0
+set fd [open $spdb_file r]
+
+### Start searching...
+while {![eof $fd]} {
+
+# Get one SPEDE for inspection
+	gets $fd foo
+	set irecord [split [string tolower $foo] "|"]
+	set itext [lindex $irecord 1]
+	set iname [lindex $irecord 3]
+
+# Match with all given patterns and rules
+	set imatched 1
+
+	foreach ipattern $ipatterns {
+
+		set foob [split [string tolower $ipattern] " "]
+		set ftoken [lindex $foob 0]
+		set fparam [lindex $foob 1]
+		set fmatch [string match $fparam $itext]
+
+		if {($ftoken == "+") && ($fmatch == 0)} { set imatched 0 }
+
+		if {($ftoken == "-") && ($fmatch == 1)} { set imatched 0 }
+
+		if {($ftoken == "%") && ([string match $fparam $iname] == 0)} { set imatched 0 }
+
+		}
+
+# If the all patterns matched, add to the list...
+	if {($imatched == 1) && ($foo != "")} {
+		incr nresults
+		lappend iresults $foo
+		}
+
+	}
+
+# Close file
+close $fd
+
+# Take only last imax results
+return [lrange $iresults [expr $nresults-$imax] $nresults]
+}
+
+
+
+#-------------------------------------------------------------------------
+proc spdb_get { unick uhand uindex } {
+global spdb_file
+
+set ifound 0
+set iindex 0
+set iresults {}
+set nresults 0
+
+### Create the database file if it does not exist yet
+set fd [open $spdb_file a+]
+close $fd
+
+### OK. The SPEDE is valid, but let's check if we already know it.
+set fd [open $spdb_file r]
+
+if {$uindex == ""} {
+### Log search
+	spdb_log "$unick/$uhand get random SPEDE"
+
+### Do search
+	while {![eof $fd]} {
+		gets $fd foo
+		incr nresults
+		lappend iresults $foo
+		}
+
+	set foo [split [lindex $iresults [rand $nresults]] "|"]
+	set ifound 1
+
+} else {
+### Log search
+	spdb_log "$unick/$uhand searched SPEDE #$uindex"
+
+### Do search
+	while {![eof $fd] && !$ifound} {
+		gets $fd foo
+		set foo [split $foo "|"]
+
+		if {[lindex $foo 0] == $uindex} {
+			set ifound 1
+			}
+		}
+}
+
+### Close file
+close $fd
+
+### Return result
+if {$ifound} {
+	return "#[lindex $foo 0]: [lindex $foo 1] ([lindex $foo 3])"
+	} else {
+	return "ei löydy."
+	}
+}
+
+
+#-------------------------------------------------------------------------
+proc spdb_search {unick uhand uchan utext upublic} {
+global spdb_showmax_pub spmsg_nomatch
+
+### Log search
+	spdb_log "$unick/$uhand searched SPEDE: $utext"
+
+### Parse the given command
+	set footokens [split $utext " "]
+	foreach ftoken $footokens {
+		set foomark [string range $ftoken 0 0]
+		set foopat  [string range $ftoken 1 end]
+
+		if {$foomark == "-" || $foomark == "+" || $foomark == "%"} {
+			lappend ipatlist "$foomark *$foopat*"
+			} else {
+			lappend ipatlist "+ *$ftoken*"
+			}
+	}
+	
+
+### Get the matches
+
+	set iresults [spdb_find $ipatlist $spdb_showmax_pub]
+
+### Show the results
+	if {$iresults != ""} {
+	foreach i $iresults {
+		set foo [split $i "|"]
+		spdb_msg $upublic $unick $uchan "#[lindex $foo 0]: [lindex $foo 1] ([lindex $foo 3] @ [spdb_ctime [lindex $foo 2]])"
+		}
+
+# If no SPEDEs were found
+	} else {
+		spdb_msg $upublic $unick $uchan "ei löydy."
+	}
+}
+
+
+#-------------------------------------------------------------------------
+proc spdb_pub_spede {unick uhost uhand uchan utext} {
+
+spdb_msg 0 $uchan "" [spdb_get $unick $uhand $utext]
+}
+
+
+#-------------------------------------------------------------------------
+proc spdb_msg_spede {unick uhost uhand utext} {
+
+spdb_msg 0 $unick "" [spdb_get $unick $uhand $utext]
+}
+
+
+#-------------------------------------------------------------------------
+proc spdb_pub_add {unick uhost uhand uchan utext} {
+
+ spdb_add $utext $unick $uhost $uchan 1
+}
+
+
+#-------------------------------------------------------------------------
+proc spdb_pub_rm {unick uhost uhand uchan utext} {
+
+ spdb_rm $utext $unick $uhost $uchan 1
+}
+
+
+#-------------------------------------------------------------------------
+proc spdb_pub_find {unick uhost uhand uchan utext} {
+
+ spdb_search $unick $uhand $uchan $utext 1
+}
+
+
+#-------------------------------------------------------------------------
+proc spdb_msg_find {unick uhost uhand utext} {
+
+ spdb_search $unick $uhand "" $utext 0
+}
+
+
+#-------------------------------------------------------------------------
+
+# end of script
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tj.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,194 @@
+############################################################################
+#
+# TJ (Army Mornings Left-counter) v0.60 by ccr/TNSP
+# (C) Copyright 2000,2009 Tecnic Software productions (TNSP)
+# Send comments and shit via e-mail: <ccr@tnsp.org>
+#
+# This script is freely distributable under GNU GPL (version 2) license.
+#
+# Laskee aamuja tiettyyn paivamaaraan. TJ-paivamaara annettava
+# tietenkin etta toimii, oletuksena skripti asettaa (uudelle kayttajalle)
+# sen hetkisen ajan + 180 aamua. Esimerkkeja kaytosta:
+# !tj [nick]
+# /msg TheBot tj [nick]
+#
+# Ja TJ:n asetus toimii nain:
+# !tjaamut <[-]aamujen lkm tasta hetkesta laskien> [+/- tunnit]
+# !tjset dd.mm.yyyy hh:mm
+#
+############################################################################
+
+# Default starting TJ
+set tj_defstarttj 180
+
+
+
+############################################################################
+# No need to look below this line
+############################################################################
+set tj_message "TJ (SA-INT model) v0.60 by ccr/TNSP"
+set tj_dateident "tjdate"
+set tj_preferredmsg "PRIVMSG"
+
+putlog "$tj_message"
+bind pub - !tj tj_pubmsg
+bind pub - !tjaamut tj_pubaamut
+bind pub - !tjset tj_pubset
+
+# -------------------------------------------------------------------------
+proc tj_correctnickcase { jnick } {
+
+  if {![validuser $jnick]} { return "" }
+  set nicklwr [string tolower $jnick]
+  foreach juser [userlist] {
+    if {[string tolower $juser] == $nicklwr} {
+      unset nicklwr
+      return "$juser"
+    }
+  }
+
+  return ""
+}
+
+
+# -------------------------------------------------------------------------
+proc tj_smsg {udest umsg} {
+  global tj_preferredmsg
+
+  putserv "$tj_preferredmsg $udest :$umsg"
+}
+
+
+# -------------------------------------------------------------------------  
+proc tj_pubmsg {nick uhost hand chan args} {
+  if {$args == "{}" || $args == ""} { set args $hand }
+  set args [lindex [split $args " "] 0]
+
+  tj_smsg $chan [tj_gettj $args $chan]
+  return 1
+}
+
+
+# -------------------------------------------------------------------------  
+proc tj_ctime { utime } {
+  return [clock format $utime -format "%d.%m.%Y %H:%M"]
+}
+
+
+# -------------------------------------------------------------------------  
+proc tj_pubaamut {unick uhost uhand uchan uargs} {
+  set foo [split $uargs " "]
+  set tjdays [lindex $foo 0]
+  set tjhours [lindex $foo 1]
+  if {$tjdays == ""} {
+    tj_smsg $uchan "Hälärm."
+    return 1  
+  }
+
+  if {$tjhours == ""} { set tjhours 0 }
+
+  set udate [expr [unixtime] + ($tjdays * 86400) + ($tjhours * 3600)]
+  tj_smsg $uchan [tj_settj $uhand $unick $udate]
+  return 1
+}
+
+
+# -------------------------------------------------------------------------  
+proc tj_pubset {unick uhost uhand uchan uargs} {
+
+  set udate [clock scan $uargs -format "%d.%N.%Y %H:%M"]
+  tj_smsg $uchan [tj_settj $uhand $unick $udate]
+  return 1
+}
+
+
+# -------------------------------------------------------------------------  
+proc tj_settj { uuser unick udate } {
+  global tj_dateident
+
+  if {![validuser $uuser]} {
+    return "Tuntematon käyttäjä $uuser."
+  }
+
+  setuser $uuser XTRA $tj_dateident $udate
+  return "$unick:n ($uuser) TJ asetettu. ([tj_ctime $udate])"
+}
+
+
+# -------------------------------------------------------------------------  
+proc tj_gettj {ihandle ichan} {
+  global tj_defstarttj
+  global tj_dateident
+
+  # Tarkistetaan onko kayttaja OK
+  if {![validuser $ihandle]} {
+    if {$ichan == ""} {
+      return "$ihandle, Mene pois."
+    } else {
+      if {$ihandle == "*"} {
+        return "En tiedä kuka olet, mene pois."
+      } else {
+        return "En tiedä kuka $ihandle on."
+      }
+    }
+  }
+
+  set chandle [tj_correctnickcase $ihandle]
+
+  # Haetaan TJ aloitus paivamaara
+  set tjpaiva [getuser $chandle XTRA $tj_dateident]
+  
+  if {$tjpaiva == ""} {
+    return "$chandle ei ole asettanut itselleen TJ päivämäärää."
+  }
+
+  # Lasketaan tamanhetkinen TJ aika
+  set deltatj [expr $tjpaiva - [unixtime]]
+
+  if {$deltatj < 0} { 
+    set tmp [expr [unixtime] - $tjpaiva]
+  } else {
+    set tmp $deltatj
+  }
+
+  # Lasketaan TJ aamut, tunnit jne
+  set aamut [expr ($tmp / 86400)]
+  set tunnit [expr (($tmp % 86400) / 3600)]
+
+  # Maaritetaan sanalause
+  if {$ichan != ""} {
+    set tjmt "$chandle:lla on"
+    set tjmi "$chandle on"
+  } else {
+    set tjmt "Sinulla on"
+    set tjmi "Sinä olet"
+  }
+
+  if {$aamut > 0} {
+    set lause "$aamut aamua"
+  } else {
+    set lause ""
+  }
+
+  if {$tunnit > 0} {
+    if {$aamut > 0} { set lause "$lause ja" }
+    set lause "$lause $tunnit tuntia"
+  }
+
+  if {$aamut == 0 && $deltatj > 0} {
+    if {$tunnit == 0} {  
+      return "$tjmt TOSI WÄINÖ! TJ 0!!"
+    } else {
+      return "$tjmt AIKA WÄBÄ -- TJ $tunnit tuntia!"
+    }
+  } else {
+    if {$deltatj > 0} {
+      return "$tjmt $lause jäljellä... ([tj_ctime $tjpaiva])"
+    } else {
+      return "$tjmi ollut reservissä jo $lause! ([tj_ctime $tjpaiva])"
+    }
+  }
+
+}
+
+# -------------------------------------------------------------------------
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/urllog.php.txt	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,57 @@
+<?
+// =====================================================
+// URLLog PHP-script for redirecting ShortURLs
+// (C) Copyright 2006 Tecnic Software productions (TNSP)
+// =====================================================
+
+// URLLog datafile
+$urlFilename = "data.urllog";
+
+// =====================================================
+// Helper functions
+$idStr = "ABCDEFGHIJKLNMOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789";
+
+function myerr() {
+	header("Status: 404 Not Found");
+	echo "404 Not Found";
+	exit;
+}
+
+// Check arguments
+if (!isset($argv[0])) myerr();
+
+// Calculate urlID
+$urlStr = $argv[0];
+$urlLen = strlen($urlStr);
+if ($urlLen < 1) myerr();
+
+for ($urlID = 0, $i = 0; $i < $urlLen; $i++) {
+	$urlID *= strlen($idStr);
+
+	$n = strpos($idStr, $urlStr[$i]);
+	if ($n !== FALSE) {
+		$urlID += $n;
+	} else
+		myerr();
+}
+
+// Find the URL
+$urlFile = fopen($urlFilename, "r");
+if (!$urlFile) myerr();
+
+$urlFound = 0;
+while (!feof($urlFile) && !$urlFound) {
+	$urlItems = split(" ", fgets($urlFile, 4096), 5);
+	if ($urlItems[4] == $urlID) $urlFound = 1;
+}
+
+fclose($urlFile);
+
+// Output result
+if ($urlFound) {
+	header("Location: ".$urlItems[0]);
+} else
+	myerr();
+
+exit;
+?>
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/urllog.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,711 @@
+##########################################################################
+#
+# URLLog v1.99.12 by ccr/TNSP <ccr@tnsp.org>
+# (C) Copyright 2000-2010 Tecnic Software productions (TNSP)
+#
+##########################################################################
+#
+# NOTICE! If you are upgrading to v1.90+ from any older version, you
+# might want to run a conversion script against your URL-database file.
+#
+# It is NOT strictly necessary, but recommended especially if you
+# utilize the "shorturl" functionality. The conversion script is
+# available at < http://tnsp.org/egg-tcls/ >
+#
+##########################################################################
+###
+### HTTP options
+###
+# Set to 1 if you want to use proxy
+set http_proxy 0
+
+# Proxy host and port number (only used if enabled above)
+set http_proxy_host ""
+set http_proxy_port 8080
+
+
+###
+### General options
+###
+
+# Filename where the logged URL data goes
+set urllog_file "data.urllog"
+
+
+# 1 = Verbose: Say messages when URL is OK, bad, etc.
+# 0 = Quiet  : Be quiet (only speak if asked with !urlfind, etc)
+set urllog_verbose 1
+
+
+# 1 = Put some info to bot's Logfile during operation
+# 0 = Don't.
+set urllog_logmsg 1
+
+
+# 1 = Check URLs for validity and existence before adding.
+# 0 = No checks. Add _anything_ that looks like an URL to the database.
+set urllog_check 1
+
+
+###
+### WWW page creation options
+###
+# 1 = Create the www pages, 0 = Don't.
+set urllog_makewww 0
+
+# TIP: If you don't want the bot to create the HTML-file, you can
+# use a simple Perl/Ruby/Python/PHP/whatnot-scripted page to do that.
+
+# Filename AND FULL PATH of the html-file where the www-format log goes
+# (Remember to set the permissions right after the file has been created)
+set urllog_webfile "/home/niinuska/public_html/urllog.html"
+
+
+###
+### Search related settings
+###
+
+# 0 = No search-commands available
+# 1 = Search enabled
+set urllog_search 1
+
+
+# How many URL's should the !urlfind command show (maximum limit)
+set urllog_showmax_pub 3
+
+
+# For private-search, this is the default limit (user can change it)
+set urllog_showmax_priv 6
+
+
+###
+### ShortURL-settings
+###
+
+# 1 = Use ShortURLs
+# 0 = Don't.
+set urllog_shorturl 1
+
+# Max length of original URL to be shown
+set urllog_shorturl_orig 30
+
+# Path to PHP/CGI-script that redirects ShortURLs
+set urllog_shorturl_prefix "http://tnsp.org/u/"
+
+
+###
+### Message-texts
+###
+
+# No such host was found
+set urlmsg_nosuchhost "ei tommosta oo!"
+
+# Could not connect host (I/O errors etc)
+set urlmsg_ioerror "kraak, virhe yhdynnässä."
+
+# HTTP timeout
+set urlmsg_timeout "ei jaksa ootella"
+
+# No such document was found
+set urlmsg_errorgettingdoc "siitosvirhe"
+
+# URL was already known (was in database)
+set urlmsg_alreadyknown "wanha!"
+#set urlmsg_alreadyknown "Empiiristen havaintojen perusteella ja tällä sovellutusalueella esiintyneisiin aikaisempiin kontekstuaalisiin ilmaisuihin viitaten uskallan todeta, että sovellukseen ilmoittamasi tietoverkko-osoite oli kronologisti ajatellen varsin postpresentuaalisesti sopimaton ja ennestään hyvin tunnettu."
+
+# No match was found when searched with !urlfind or other command
+set urlmsg_nomatch "Ei osumia."
+
+
+###
+### Things that you usually don't need to touch ...
+###
+
+# What IRC "command" should we use to send messages:
+# (Valid alternatives are "PRIVMSG" and "NOTICE")
+set urllog_preferredmsg "PRIVMSG"
+
+# The valid known Top Level Domains (TLDs), but not the country code TLDs
+# (Now includes the new IANA published TLDs)
+set urllog_tlds "org,com,net,mil,gov,biz,edu,coop,aero,info,museum,name,pro,int"
+
+
+##########################################################################
+# No need to look below this line
+##########################################################################
+#-------------------------------------------------------------------------
+set urllog_name "URLLog"
+set urllog_version "1.99.12"
+
+set urllog_tlds [split $urllog_tlds ","]
+set urllog_httprep [split "\@|%40|{|%7B|}|%7D|\[|%5B|\]|%5D" "|"] 
+
+set urllog_html_ent [split "&#x202a;||&#x202c;||&lrm;||&aring;|å|&Aring;|Å|&eacute;|é|&#58;|:|&#xe4;|ä|&#xf6;|ö|&#228;|ä|&#246;|ö|&nbsp;| |&#45;|-|&#8221;|\"|&#8220;|\"|&raquo;|>>|&quot;|\"|&auml;|ä|&ouml;|ö|&Auml;|Ä|&Ouml;|Ö|&amp;|&|&lt;|<|&gt;|>|ä|ä|ö|ö|Ä|Ä" "|"]
+
+
+### HTTP module initialization
+package require http
+::http::config -useragent "$urllog_name/$urllog_version"
+if {$http_proxy != 0} {
+	::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port
+}
+
+
+### Binding initializations
+if {$urllog_search != 0} {
+	bind pub - !urlfind urllog_pub_urlfind
+	bind msg - urlfind urllog_msg_urlfind
+}
+
+bind pubm - *.* urllog_checkmsg
+bind topc - *.* urllog_checkmsg
+bind msg - paska urllog_checkmsg2
+
+if {$urllog_makewww != 0} {
+	bind dcc m dowebfile urllog_dowebfile
+	bind time - "*0 % % % %" urllog_timer
+}
+
+
+### Initialization messages
+set urllog_message "$urllog_name v$urllog_version (C) 2000-2010 ccr/TNSP"
+putlog "$urllog_message"
+
+if {$http_proxy != 0} {
+	putlog " (Using proxy $http_proxy_host:$http_proxy_port)"
+}
+
+if {$urllog_check != 0} {
+	putlog " (Additional URL validity checks enabled)"
+}
+
+if {$urllog_verbose != 0} {
+	putlog " (Verbose mode enabled)"
+}
+
+if {$urllog_makewww != 0} {
+	putlog " (Creating WWW page to $urllog_webfile)"
+}
+
+if {$urllog_search != 0} {
+	putlog " (Search commands enabled)"
+}
+
+
+#-------------------------------------------------------------------------
+### Utility functions
+proc urllog_log {arg} {
+	global urllog_logmsg urllog_name
+
+	if {$urllog_logmsg != 0} {
+		putlog "$urllog_name: $arg"
+	}
+}
+
+
+proc urllog_ctime { utime } {
+
+	if {$utime == "" || $utime == "*"} {
+		set utime 0
+	}
+
+	return [clock format $utime -format "%d.%m.%Y %H:%M"]
+}
+
+
+proc urllog_dowebfile {hand idx text} {
+global urllog_name urllog_makewww
+
+if {$urllog_makewww == 1} {
+	urllog_log "Making webfiles..."
+	urllog_make_web_file
+} else {
+	urllog_log "Webfile disabled."
+}
+}
+
+
+proc urllog_isnumber {uarg} {
+	set ufoo 1
+
+	foreach i [split $uarg {}] {
+		if {![string match \[0-9\] $i]} {set ufoo 0}
+	}
+
+	return $ufoo
+}
+
+
+proc urllog_msg {apublic anick achan amsg} {
+	global urllog_preferredmsg
+
+	if {$apublic == 1} {
+		putserv "$urllog_preferredmsg $achan :$amsg"
+	} else {
+		putserv "$urllog_preferredmsg $anick :$amsg" 
+	}
+}
+
+
+proc urllog_verb_msg {anick achan amsg} {
+	global urllog_verbose
+
+	if {$urllog_verbose != 0} {
+		urllog_msg 1 $anick $achan $amsg
+	}
+}
+
+
+proc urllog_convert_ent {udata} {
+	global urllog_html_ent
+	regsub -all "	" $udata " " utmp
+	regsub -all "\r" $udata " " utmp
+	regsub -all "\n" $utmp " " utmp
+	regsub -all "  *" $utmp " " utmp
+	regsub -all "\t" $utmp "" utmp
+	return [string map -nocase $urllog_html_ent $utmp]
+}
+
+
+#-------------------------------------------------------------------------
+proc urllog_make_web_file {} {
+global urllog_file urllog_webfile urllog_message botnick
+
+# Starting message
+urllog_log "Creating HTML-file for WWW..."
+
+# Open files
+set fd [open $urllog_webfile w]
+set fd2 [open $urllog_file r]
+
+# HTML headers
+puts $fd "<html><head><title>Caught URLs</title></head>"
+puts $fd "<body bgcolor=\"#FFFFFF\" text=\"#0020a0\" link=\"#0020a0\" vlink=\"#0020a0\" alink=\"#0020a0\">"
+puts $fd "<font face=\"Helvetica, Arial\">"
+puts $fd "<center><font size=\"6\">URLs caught by $botnick</center><hr>"
+puts $fd "<font size=\"3\">"
+
+# Process database, convert to links & info
+while {![eof $fd2]} {
+	gets $fd2 foo
+	if {$foo != ""} {
+	regsub -all "<|>|\"" $foo "" foo
+	set foo [split $foo " "]
+	puts $fd "<a href=\"[lindex $foo 0]\">[lindex $foo 0]</a><br>Added on <B>[urllog_ctime [lindex $foo 1]]</B> by <B>[lindex $foo 2]</B><br><hr>"
+	}
+	}
+
+# HTML footers
+puts $fd "<center>Generated by $urllog_message<BR>"
+puts $fd "(Last updated <B>[urllog_ctime [unixtime]]</B>)</center>"
+puts $fd "</body></html>"
+
+# Close files
+close $fd
+close $fd2
+
+# OK-message
+urllog_log "HTML-file generated OK."
+}
+
+
+#-------------------------------------------------------------------------
+proc urllog_timer {umin uhour uday umonth uyear} {
+	urllog_make_web_file
+}
+
+
+#-------------------------------------------------------------------------
+proc urllog_get_short {utime} {
+	global urllog_shorturl urllog_shorturl_prefix
+	set ustr "ABCDEFGHIJKLNMOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
+	set ulen [string length $ustr]
+
+	set u1 [expr $utime / ($ulen * $ulen)]
+	set utmp [expr $utime % ($ulen * $ulen)]
+	set u2 [expr $utmp / $ulen]
+	set u3 [expr $utmp % $ulen]
+
+	return "\[ $urllog_shorturl_prefix[string index $ustr $u1][string index $ustr $u2][string index $ustr $u3] \]"
+}
+
+
+#-------------------------------------------------------------------------
+proc urllog_chop_url {url} {
+	global urllog_shorturl_orig
+	if {[string length $url] > $urllog_shorturl_orig} {
+		return "[string range $url 0 $urllog_shorturl_orig]..."
+	} else {
+		return $url
+	}
+}
+
+#-------------------------------------------------------------------------
+proc urllog_addurl {urlStr urlNick urlHost urlChan urlTitle} {
+global urlmsg_alreadyknown urllog_file urllog_shorturl
+
+### Let's check if we already know the URL
+set fd [open $urllog_file a+]
+close $fd
+
+set fd [open $urllog_file r]
+set urlID -1
+while {![eof $fd]} {
+	set qitems [split [gets $fd] " "]
+	set qindex [lindex $qitems 4]
+	if {$qindex != "" && $qindex > $urlID} {
+		set urlID $qindex
+	}
+	if {[lindex $qitems 0] == $urlStr} {
+		urllog_log "URL said by $urlNick ($urlStr) already known"
+		if {$urllog_shorturl != 0} {
+			set qstr "[urllog_get_short $urlID] "
+		} else {
+			set qstr ""
+		}
+		append qstr "([lindex $qitems 2]@[urllog_ctime [lindex $qitems 1]])"
+		if {[string length $urlTitle] > 0} {
+			set qstr "$urlmsg_alreadyknown - '$urlTitle' $qstr"
+		} else {
+			set qstr "$urlmsg_alreadyknown $qstr"
+		}
+		urllog_verb_msg $urlNick $urlChan $qstr
+		return 0
+	}
+}
+close $fd
+
+
+### OK, the URL was not already known - thus we add it
+incr urlID
+set urlTime [unixtime]
+set fd [open $urllog_file a+]
+puts $fd "$urlStr $urlTime $urlNick ($urlHost) $urlID"
+close $fd
+urllog_log "Added URL ($urlNick@$urlChan): $urlStr"
+
+
+### Let's say something, to confirm that everything went well.
+if {$urllog_shorturl != 0} {
+	set qstr "[urllog_get_short $urlID] "
+} else {
+	set qstr ""
+}
+if {[string length $urlTitle] > 0} {
+	urllog_verb_msg $urlNick $urlChan "'$urlTitle' ([urllog_chop_url $urlStr]) $qstr"
+} else {
+	urllog_verb_msg $urlNick $urlChan "[urllog_chop_url $urlStr] $qstr"
+}
+
+return 1
+}
+
+
+#-------------------------------------------------------------------------
+proc urllog_http_handler {utoken utotal ucurrent} {
+	upvar #0 $utoken state
+
+	# Stop after around 3000 received bytes, typically we would assume
+	# that <head> section is contained in this amount of data.
+	if {$state(currentsize) >= 3000} {
+		set state(status) "ok"
+	}
+}
+
+#-------------------------------------------------------------------------
+proc urllog_checkurl {urlStr urlNick urlHost urlChan} {
+global botnick urllog_html urllog_tlds urllog_check urllog_file
+global urlmsg_nosuchhost urlmsg_ioerror urlmsg_timeout urlmsg_errorgettingdoc
+global urllog_httprep urllog_shorturl_prefix urllog_shorturl urllog_encoding
+
+### Some status
+urllog_log "$urlStr ($urlNick@$urlChan)"
+
+### Try to determine the URL protocol component (if it is missing)
+set u_checktld 1
+
+if {[string match "*www.*" $urlStr] && ![string match "http://*" $urlStr] && ![string match "https://*" $urlStr]} {
+	set urlStr "http://$urlStr"
+	}
+
+if {[string match "*ftp.*" $urlStr] && ![string match "ftp://*" $urlStr]} {
+	set urlStr "ftp://$urlStr"
+	}
+
+if {[regexp "(ftp|http|https)://(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})" $urlStr u_match u_prefix ni1 ni2 ni3 ni4]} {
+	# Check if the IP is on local network
+	if {($ni1 == 127) || ($ni1 == 10) || ($ni1 == 192 && $ni2 == 168) || ($ni1 == 0)} {
+		urllog_log "URL pointing to local or invalid network, ignored ($urlStr)."
+		return 0
+		}
+
+	# Skip TLD check for URLs with IP address
+	set u_checktld 0
+	}
+
+if {$urllog_shorturl != 0 && [string match "*$urllog_shorturl_prefix*" $urlStr]} {
+	urllog_log "Ignoring ShortURL."
+	return 0
+}
+
+### Check the PORT (if the ":" is there)
+set u_record [split $urlStr "/"]
+set u_hostname [lindex $u_record 2]
+set u_port [lindex [split $u_hostname ":"] end]
+
+if {![urllog_isnumber $u_port] && $u_port != "" && $u_port != $u_hostname} {
+	urllog_log "Broken URL from $urlNick: ($urlStr) illegal port $u_port"
+	return 0
+	}
+
+# Default to port 80 (HTTP)
+if {![urllog_isnumber $u_port]} {
+	set u_port 80
+	}
+
+### Is it a http or ftp url? (FIX ME!)
+if {[string range $urlStr 0 3] != "http" && [string range $urlStr 0 2] != "ftp"} {
+	urllog_log "Broken URL from $urlNick: ($urlStr) UNSUPPORTED TYPE (not HTTP or FTP)"
+	return 0
+	}
+
+### Check the Top Level Domain (TLD) validity
+if {$u_checktld != 0} {
+	set u_sane [lindex [split $u_hostname "."] end]
+	set u_tld [lindex [split $u_sane ":"] 0]
+	set u_found 0
+
+	if {[string length $u_tld] == 2} {
+		# Assume all 2-letter domains to be valid :)
+		set u_found 1
+	} else {
+		# Check our list of known TLDs
+		foreach itld $urllog_tlds {
+			if {[string match $itld $u_tld]} {
+				set u_found 1
+			}
+		}
+		}
+
+	if {$u_found == 0} {
+		urllog_log "Broken URL from $urlNick: ($urlStr) illegal TLD: $u_tld."
+		return 0
+		}
+	}
+
+set urlStr [string map $urllog_httprep $urlStr]
+
+### Do we perform additional optional checks?
+if {$urllog_check != 0 && [string range $urlStr 0 6] == "http://"} {
+	# Does the document pointed by the URL exist?
+	if {[catch {set utoken [::http::geturl $urlStr -progress urllog_http_handler -blocksize 1024 -timeout 4000]} uerrmsg]} {
+		urllog_verb_msg $urlNick $urlChan "$urlmsg_ioerror ($uerrmsg)"
+		urllog_log "HTTP request failed: $uerrmsg"
+		return 0
+		}
+
+	upvar #0 $utoken ustate
+	
+	if {$ustate(status) == "timeout"} {
+		urllog_verb_msg $urlNick $urlChan "$urlmsg_timeout"
+		urllog_log "HTTP request timed out ($urlStr)"
+		}
+
+	if {$ustate(status) == "error"} {
+		urllog_verb_msg $urlNick $urlChan "$urlmsg_errorgettingdoc ([::http::error $utoken])"
+		urllog_log "Error in HTTP transaction: [::http::error $utoken] ($urlStr)"
+		}
+
+	# FIXME! Handle redirects!
+	if {$ustate(status) == "ok"} {
+		if {[::http::ncode $utoken] >= 200 && [::http::ncode $utoken] <= 309} {
+			set udata $ustate(body)
+			set umatches [regexp -nocase -inline -- "<meta.\*\?content=\".\*\?charset=(\[^\"\]*)\"/>" $udata]
+			set uconvert 0
+			if {[llength $umatches] > 0} {
+				set uencoding [lindex $umatches 1]
+				if {[string length $uencoding] > 3} {
+					set uconvert 1
+				}
+			}
+			
+			set umatches [regexp -nocase -inline -- "<title>(.\*\?)</title>" $udata]
+			if {[llength $umatches] > 0} {
+				set urlTitle [lindex $umatches 1]
+				if {$uconvert != 0} {
+					set urlTitle [encoding convertfrom $uencoding $urlTitle]
+				}
+				set urlTitle [urllog_convert_ent $urlTitle]
+				regsub -all "(^ *| *$)" $urlTitle "" urlTitle
+			} else {
+				set urlTitle ""
+			}
+			urllog_addurl $urlStr $urlNick $urlHost $urlChan $urlTitle
+		} else {
+			urllog_verb_msg $urlNick $urlChan "$urlmsg_errorgettingdoc ([::http::code $utoken])"
+			urllog_log "[::http::code $utoken] - $urlStr"
+		}
+	}
+
+	::http::cleanup $utoken
+	} else {
+		# No optional checks, just add the URL
+		urllog_addurl $urlStr $urlNick $urlHost $urlChan ""
+	}
+}
+
+
+#-------------------------------------------------------------------------
+proc urllog_checkmsg {nick uhost hand chan text} {
+### Check the nick
+if {$nick == "*"} {
+	urllog_log "urllog_checkmsg: nick was wc, this should not happen."
+	return 0
+	}
+
+### Do the URL checking
+foreach istr [split $text " "] {
+	if {[string match "*http://*" $istr] || [string match "*ftp://*" $istr] ||
+	[string match "*www.*" $istr] || [string match "*ftp.*" $istr] ||
+	[regexp "(ftp|http|https)://\[0-9\]\{1,3\}\\.\[0-9\]\{1,3\}\\.\[0-9\]\{1,3\}\\.\[0-9\]\{1,3\}" $istr imatch]} {
+		urllog_checkurl $istr $nick $uhost $chan
+		}
+	}
+
+return 0
+}
+
+
+#-------------------------------------------------------------------------
+### Find from database according to patterns, up to imax results.
+
+proc urllog_urlfind {ipatterns imax} {
+global urllog_file
+
+### Search the database for pattern
+### Clear the count, open the URL logfile
+set iresults {}
+set nresults 0
+set fd [open $urllog_file r]
+
+### Start searching...
+while {![eof $fd]} {
+
+	# Get one URL for inspection
+	gets $fd foo
+	set irecord [split [string tolower $foo] " "]
+	set iurl [lindex $irecord 0]
+	set iname [lindex $irecord 2]
+
+	# Match with all given patterns and rules
+	set imatched 1
+	foreach ipattern $ipatterns {
+		set foob [split [string tolower $ipattern] " "]
+		set ftoken [lindex $foob 0]
+		set fparam [lindex $foob 1]
+		set fmatch [string match $fparam $iurl]
+
+		if {$ftoken == "+" && $fmatch == 0} { set imatched 0 }
+
+		if {$ftoken == "-" && $fmatch == 1} { set imatched 0 }
+
+		if {$ftoken == "%" && [string match $fparam $iname] == 0} { set imatched 0 }
+	}
+
+	# If the all patterns matched, add to the list...
+	if {$imatched == 1 && $foo != ""} {
+		incr nresults
+		lappend iresults $foo
+	}
+}
+
+# Close file
+close $fd
+
+# Take only last imax results
+return [lrange $iresults [expr $nresults-$imax] $nresults]
+}
+
+
+#-------------------------------------------------------------------------
+### Parse arguments, find and show the results
+proc urllog_find {unick uhand uchan utext upublic} {
+global botnick urllog_name urllog_version urllog_shorturl
+global urllog_showmax_pub urllog_showmax_priv urlmsg_nomatch
+
+### Parse the given command
+	urllog_log "$unick/$uhand searched URL: $utext"
+
+	set footokens [split $utext " "]
+	foreach ftoken $footokens {
+		set foomark [string range $ftoken 0 0]
+		set foopat  [string range $ftoken 1 end]
+
+		if {$foomark == "-" || $foomark == "+" || $foomark == "%" || $foomark == "@"} {
+			lappend ipatlist "$foomark *$foopat*"
+		} else {
+			lappend ipatlist "+ *$ftoken*"
+		}
+	}
+	
+### Get the matches from database
+
+	if {$upublic == 0} {
+		set iresults [urllog_urlfind $ipatlist $urllog_showmax_priv]
+	} else {
+		set iresults [urllog_urlfind $ipatlist $urllog_showmax_pub]
+	}
+
+### Show the results
+	if {$iresults != ""} {
+		set j 0
+		foreach i $iresults {
+			incr j
+			set foo [split $i " "]
+			set shortURL [lindex $foo 0]
+			set shortID [lindex $foo 4]
+
+			if {$urllog_shorturl != 0 && $shortID != ""} {
+				set shortURL "$shortURL [urllog_get_short $shortID]"
+			}
+
+			urllog_msg $upublic $unick $uchan "#$j: $shortURL ([lindex $foo 2]@[urllog_ctime [lindex $foo 1]])"
+		}
+
+	} else {
+		# If no URLs were found
+		urllog_msg $upublic $unick $uchan $urlmsg_nomatch
+	}
+
+return 0
+}
+
+
+#-------------------------------------------------------------------------
+### Finding binded functions
+proc urllog_pub_urlfind {unick uhost uhand uchan utext} {
+
+urllog_find $unick $uhand $uchan $utext 1
+
+return 0
+}
+
+
+proc urllog_msg_urlfind {unick uhost uhand utext} {
+
+urllog_find $unick $uhand "" $utext 0
+
+return 0
+}
+
+#-------------------------------------------------------------------------
+proc urllog_checkmsg2 {unick uhost uhand utext} {
+
+urllog_checkurl $utext $unick $uhost "#CHANNEL"
+
+return 0
+}
+
+
+
+# end of script
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/urllog_upgrade	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+# Extremely simple script for converting old format
+# URLLog databases into new format. Usage:
+#
+# perl urllog_upgrade.pl < old_database_file > new_database_file
+#
+
+$i = 0;
+while (<STDIN>) {
+  chomp;
+  ($murl, $mtime, $mnick, $mhost, $mfoo) = split(/ /);
+  print "$murl $mtime $mnick $mhost $i\n";
+  $i++;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/wordkick.tcl	Tue Sep 21 13:12:49 2010 +0300
@@ -0,0 +1,207 @@
+##########################################################################
+#
+# WordKick v1.60 by ccr/TNSP <ccr@tnsp.org>
+#
+# TO-DO:
+# - document this pile of shit.
+#
+##########################################################################
+# Configure these as you like
+
+## Kickword mask/message file
+# (FORMAT: See the example file!)
+set wc_badword_file "data.wordkick"
+
+
+## Stupid call-out kick
+# 1 = kick everyone who only say someone's nick on one public msg
+# 0 = no kick
+set wc_callout_kick 1
+
+# Kickmessage for call-out kick
+set wc_callout_msg "Pälli."
+
+
+## Use "happy messages"?
+# 0 = No
+# 1 = Yes (you'll need the happymessage-file, see below)
+set wc_happy_msg_use 0
+
+
+## "Random happy-joy-joy-messages file"
+# (FORMAT: One message per line)
+set wc_happy_msg_file "data.happymsg"
+
+
+## Gentle mode:
+# 0 = Kick with kickmessage, say happymsg just before kicking
+# 1 = Don't kick, just say happymsg.
+set wc_gentlemode 0
+
+
+## Irritation treshold mode:
+# 0 = Normal, immendiate kick on detected kickword.
+# 1 = Irritation tresholded kick. See README.
+set wc_irritationmode 0
+
+
+## Irritation treshold value
+# Number of how many kickwords to ignore before starting to kick
+set wc_irritationtreshold 4
+
+
+# Preferred message type ("PRIVMSG" and "NOTICE")
+set wc_preferredmsg "PRIVMSG"
+
+
+##########################################################################
+# No need to look below this line
+##########################################################################
+set wc_message "WKick v1.60 by ccr/TNSP"
+set wc_name "WKick"
+
+
+###
+### Read the bad-word file
+###
+catch {unset wc_bad_mask_list}
+catch {unset wc_kick_msg_list}
+set wc_badword_max 0
+set fd [open $wc_badword_file r]
+   while {![eof $fd]} {
+          gets $fd foo
+          if {[string first # $foo] && ([lindex $foo 0] != "")} {
+              set foo [split $foo "$"]
+              lappend wc_bad_mask_list [lindex $foo 0]
+              lappend wc_kick_msg_list [lrange $foo 1 end]
+              incr wc_badword_max
+              }
+         }
+close $fd
+
+
+###
+### Read the happy-message file
+###
+set wc_happy_msg_max 0
+catch {unset wc_happy_msg_list}
+set fd [open $wc_happy_msg_file r]
+   while {![eof $fd]} {
+          gets $fd foo
+              lappend wc_happy_msg_list $foo
+	      incr wc_happy_msg_max
+         }
+close $fd
+
+
+###
+### Initialize the script
+###
+bind time - "* % % % %" wc_timer
+bind pubm - %* wc_check
+bind ctcp - ACTION wc_check
+
+putlog "$wc_message"
+putlog "(maskfile: $wc_badword_file, $wc_badword_max // happymsg: $wc_happy_msg_file, $wc_happy_msg_max)"
+
+if {$wc_irritationmode} {
+putlog "(irritation mode, treshold: $wc_irritationtreshold)" 
+} else {
+putlog "(normal instant wordkick)"
+}
+
+if {$wc_gentlemode} {
+putlog "(gentlemode, no kicking)"
+}
+
+if {$wc_callout_kick} {
+putlog "(call-out idiotism kick mode ON)"
+}
+
+catch {unset wc_irritation}
+set wc_irritation 0
+
+###
+### Change the irritation
+###
+proc wc_timer {umin uhour uday umonth uyear} {
+global wc_irritation
+if {$wc_irritation > 0} {
+	decr wc_irritation
+	}
+}
+
+
+###
+### Match the messages with bad-word list
+###
+proc wc_check {nick uhost hand chan itext} {
+global wc_bad_mask_list wc_kick_msg_list botnick wc_preferredmsg
+global wc_happy_msg_list wc_happy_msg_max wc_name wc_gentlemode
+global wc_irritation wc_irritationmode wc_irritationtreshold
+global wc_callout_kick wc_callout_msg
+
+# Convert to lower case
+ set itext [string tolower $itext]
+
+# Check for idiots
+if {$wc_callout_kick} {
+
+	set ilist [split $itext " "]
+	set isec [lindex $ilist 1]
+
+	if {$isec == "" || $isec == "{}"} {
+	set iword [lindex $ilist 0]
+
+	foreach inick [chanlist $chan] {
+		if {[string match [string tolower "*$inick*"] $iword]} {
+			putlog "$wc_name: $nick@$chan was idiot."
+			putserv "KICK $chan $nick :$wc_callout_msg"
+			}
+		}
+	}
+}
+
+
+# Go through the sentence
+ set kickit 0
+ set x 0
+ foreach foo $wc_bad_mask_list {
+	set foo2 [split $foo "|"]
+
+	foreach i $foo2 {
+	if {[string match $i $itext]} {
+		putlog "$wc_name: $nick@$chan said a bad thing: $i"
+
+# Say happymsg
+		if {[rand 100] > 60} {
+			putserv "$wc_preferredmsg $chan :$nick, [lindex $wc_happy_msg_list [rand $wc_happy_msg_max]]"
+			}
+
+# Check for irritation mode
+		if {$wc_irritationmode != 0} {
+			if {$wc_irritation >= $wc_irritationtreshold} {
+				set kickit 1
+				} else {
+				incr wc_irritation
+				}
+			} else {
+			set kickit 1
+			}
+
+# Check for gentle-mode
+		if {($wc_gentlemode != 0) || [matchattr $hand n]} { return 0 }
+
+# Kick the lamer
+		if {$kickit != 0} {
+			putserv "KICK $chan $nick :[lindex $wc_kick_msg_list $x]"
+			return 0
+			}
+
+		}
+	}
+
+ incr x
+ }
+}
+