Code: Select all
#
# qstat4eggdrop.tcl v1.0
#
# A little script to redirect output of Qstat to IRC
# for eggdrop 1.4
# Author: Mikael Blomqvist (micke@peachpuff.com)
#
# http://eggdrop.peachpuff.com/
#
# Sometimes I don't get along with Tcl, so please don't complain too
# much about the code. Comments are very welcome though.
# There was an earlier version of this script which only managed to list QW servers
# This is a completely rewritten one which supports everything that Qstat does (hopefully)
# ATM all the files has to be in the same directory as the bot is started (including qstat).
# You can ofcourse change the exec lines in exec_get_servers & exec_get_servers_with_players
# if you want to move them.
#
# public commands
bind pub -|- !help help
bind pub -|- !q q
bind pub -|- !qp qplayers
bind pub -|- !qf qfind
proc help {nick host hand chan arg} {
putserv "NOTICE $nick :Commands:"
putserv "NOTICE $nick : !q <searchword>; List servers"
putserv "NOTICE $nick : !qf <player searchword>; Search for players on all servers"
putserv "NOTICE $nick : !qp <searchword>; Display all players on matched servers"
return 0
}
proc exec_get_servers {} {
return [exec ./qstat -sort g -default qws -Ts server.qstat -Tp players.qstat -f qstat4eggdrop.lst]
}
proc exec_get_servers_with_players {} {
return [exec ./qstat -sort g -default qws -Ts server.qstat -Tp players.qstat -f qstat4eggdrop.lst -P]
}
proc get_number_of {i type} {
switch -exact $i {
0 {
return "No ${type}s found."
}
1 {
return "1 $type found."
}
default {
return "$i ${type}s found."
}
}
}
proc sort2 {a b} {
set tal1 [string trim [string range $a 0 2]]
set tal2 [string trim [string range $b 0 2]]
return [expr int($tal1) < int($tal2)]
}
proc q {nick host hand chan arg} {
set stat [exec_get_servers]
set stat_arr [split $stat "\n"]
set i 0
set str [lsort $stat_arr]
set players [list]
set found 0
if {[llength $arg] == 1} then {
foreach rad $str {
if {[string first $arg [string tolower $rad]] != -1} then {
incr i
putquick "NOTICE $nick :$rad"
incr found
}
}
} else {
foreach rad $str {
incr i
putquick "NOTICE $nick :$i: $rad"
incr found
}
}
set info_str [get_number_of $found "server"]
putquick "NOTICE $nick :$info_str"
return 0
}
proc qplayers {nick host hand chan arg} {
if {[llength $arg] < 1} then {
putquick "NOTICE $nick : You might wanna put in a search word to limit the list a bit"
return
}
set stat [exec_get_servers_with_players]
set stat_arr [split $stat "\n"]
set str $stat_arr
set found 0
set players_found 0
for {set i 0} {$i < [llength $str]} {incr i} {
if {[string range [lindex $str $i] 0 6] != "Player:"} then {
if {[string first $arg [string tolower [lindex $str $i]]] != -1} then {
incr found
set players [list]
set j [expr $i + 1]
# Loop through all the players and save them into a list
while {[string range [lindex $str $j] 0 6] == "Player:"} {
lappend players [string trimleft [lindex $str $j] "Player:"]
incr j
incr players_found
}
# Display server
putquick "NOTICE $nick :[lindex $str $i]"
# If we have any players list them up sorted
if {[llength $players] > 0} then {
foreach player [lsort -command sort2 $players] {
putquick "NOTICE $nick : $player"
}
}
}
}
}
set info_str [get_number_of $found "server"]
set info_str2 [get_number_of $players_found "player"]
putquick "NOTICE $nick :$info_str $info_str2"
return 0
}
proc qfind {nick host hand chan arg} {
if {[llength $arg] < 1} then {
putquick "NOTICE $nick : You might wanna put in a search word to limit the list a bit"
return
}
set stat [exec_get_servers_with_players]
set stat_arr [split $stat "\n"]
set i 0
set str $stat_arr
set found 0
# set str [lsort $stat_arr]
for {set i 0} {$i < [llength $str]} {incr i} {
set j [expr $i + 1]
# Loop through all the players and save them into a list
while {[string range [lindex $str $j] 0 6] == "Player:"} {
set player [string trimleft [lindex $str $j] "Player:"]
set playername [lindex [split $player " "] 2]
set server [join [lindex [split [lindex $str $i] ""] 1] " "]
if {[string first [string tolower $arg] [string tolower $playername]] != -1} then {
incr found
putquick "NOTICE $nick :$playername is on $server"
}
incr j
}
# Make sure we don't check through the players again
set i [expr $j - 1]
}
set info_str [get_number_of $found "player"]
putquick "NOTICE $nick :$info_str"
return 0
}