# showusers.tcl --
#
# Short statistic of users.
#
# Bug reports:  http://code.google.com/p/avilontcl/issues/list
# Script wiki:  http://code.google.com/p/avilontcl/w/list
# New versions: http://code.google.com/p/avilontcl/downloads/list
# More scripts: http://code.google.com/p/avilontcl/
#
# Copyright (c) 2007, Markus Knöpfle, avilon87@gmail.com, http://avilon.eu/
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
#   * Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#   * Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#   * The name of the author may not be used to endorse or promote products
#     derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
#
# Usage:
# /sbnc showusers or /msg -sBNC showusers
#
# $Id: showusers.tcl,v 0.1 2007/02/08 17:29 avilon Exp $
#

# Version 0.1     First official release (Feb 08 2007)

package require Tcl 8.4;    # Tcl minimum version

if { [namespace exists ::showusers] } {
  namespace delete ::showusers
}

namespace eval ::showusers {

  variable version        "0.1"
  variable fileName       "[info script]"
  variable scriptName     "[namespace tail [namespace current]] $version"

  if { ([llength [info commands putmainlog]] ne "0") } {
    putmainlog "Loading $scriptName, Filename: $fileName"
  }
}

# Will be triggered when a command was sent (either via /sbnc or /msg -sBNC)
internalbind command ::showusers::clientCommand

# ::showusers::clientCommand --
#

proc ::showusers::clientCommand {client arg} {

  if { [string equal -nocase "showusers" [join $arg]] && [getbncuser $client admin] } {

    variable ctx [getctx]
    variable online 0 connected 0 suspended 0 unknown 0
    array set networks {}

    foreach user [bncuserlist] {
      setctx $user
      if { [getbncuser $user hasclient] } {
        incr online
      }

      if { [getbncuser $user hasserver] } {
        incr connected
        set un [getisupport NETWORK]
        if { $un eq "" } {
          incr unknown
          continue
        }
        if { ![info exists networks($un)] } {
          set networks($un) 1
        } else {
          incr networks($un)
        }
      }
      if { ([getbncuser $user lock] eq "1") } {
        incr suspended
      }
    }

    setctx $ctx
    bncreply "Total user count: [llength [bncuserlist]], logged on: $online, connected to IRC: $connected, suspended: $suspended."
    set result [list]
    foreach name [array names networks] {
      lappend result "$networks($name) on $name"
    }
    if { $unknown ne "0" } {
      lappend result "$unknown on unknown networks"
    }
    bncreply [join $result {, }]
    haltoutput
  }

  return
}

# remove bind from old versions
internalunbind command showusers;#EOF