#!/usr/bin/perl -w
#
#
# Socip.pl;
#
# Perl-Script by Kajetan Hinner. This program is Mailware, every user should write to Kajetan@Hinner.com
# Socip.pl hooks up on an IRC network and monitors everything you want.
# Currenty it creates statistics about the users, channels, servers and services formed on the
# network.
# All this data is written to a datafile and moreover it is fed to a RRD (Round Robin Database)
# for further processing using mrtg3, created by Tobi Oettinger.
#
# Socip.pl was developed using Linux 2.1.x, ircII 4.4, Perl 5.004 and KDE 4. As editor for large files I recommend nedit. 
# There is a lot of code contained belonging to the Net::IRC demo perl script!
#
#
# Changes: 1.01 (22.10.98, 17:43): sleep (120) when changing servers
# Changes: 1.02 (26.10.98, 16:30): added several commands through msg: leave/join/version
# Changes: 1.03 ( 2.11.98, 12:35): added min for RRD (1000 for users, 500 for channels)
# Changes: 1.04 (13. 1.99, 19:32): removed bug in changin server code; improved +o and -o msg command
#				   added changing server sequence when more than three measures yielded "unknown"
# Changes: 1.05 (25. 1.99, 13:04): changed +o on join Channel behaviour
# Changes: 1.06 (11. 4.99, 23:05): adapted to new rrdtool version 0.99
# Changes: 1.07 (13. 4.99, 22:05): added TalkCity
# Changes: 1.08 (14. 4.99, 18:05): added luserclient output for Galaxynet
# Changes: 1.09 (20. 4.99, 12:05): added Code for hanging connections
# Changes: 1.10 ( 9. 5.99, 19:15): changed Socip_D setup
# Changes: 1.11 (28. 5.99, 20:31): added Socip_M
# Changes: 1.12 (11.11.99, 18.30): added close FILEHANDLE for Errorlog Code; several little improvements.
# Changes: 1.13 (13.12.99, 14.00): changed code of reconnecting when server forbids entry; updated server list
# Changes: 1.14 (14. 3.00, 18.30): added Socip_B (BrasIRC) and Socip_W (Webchat)
# Changes: 1.15 (22. 7.00,  7.10): added Socip_F (Flirt); fixed bug in global users match (erased data)
#				   included $irc_port; fixed problem with TalkCity.
#
#
# How this script works:       
#
# First of all we hook up on IRC, using a server and nickname from a pool which must be defined
#	earlier. If server or nick are not working, we change those and try again.
# Then all the handlers are installed; they are called when there is data output of the connected
# ircserver. We sit on a channel if a name was given.
# After this we enter an infinite loop and invoke an IRC /lusers command.
# All the server replies are handled by specialized routines which feed certain variables.
# Before the 2nd invoke, all those data is saved and later written to the irc_data file and the RRD.
# 
#
# Caution:      When you read the RRD, there may be a difference
#		between the values Socip.pl stored and those you retrieve. This is because mrtg3
#		calculates an average when you supply more than two values for those hours.
#
# Using private messages of IRC it is possible to do the following
#	# to die, type			/msg <nick> passwd quit
#	# to change server, type	/msg <nick> passwd connect server
#	# to change nick, type		/msg <nick> passwd nick nick
#	# to give op type		/msg <nick> passwd +o user
#	# to take op type		/msg <nick> passwd -o user
#
# Author: Kajetan Hinner, University of Rostock, Sociology Dep., Kajetan@Hinner.com
#
# Notice: My aim was to write a working program which is reliable and easy to maintain. It was not intended to write
#         state of the art perl code, which may be hard to read for others. Some remarks are in german. Sorry for that.

my $version="1.14 of 22.7.2000";

#     
#

use strict;
use Time::Local;
use Time::localtime;		# override localtime() to access tm_struct.
use Net::IRC;			# CPAN, supply IRC functions
use RRDs;			# CPAN, supply Round Robin Database functions

# if there is a problem for you with the last two modules, get them from CPAN at http://www.perl.com


####################################################################
# declare variables.       ##### needed because there's no #ifdef ... #endif in perl

my @irc_server;				# array of IRC servers
my $irc_port=6667;			# standard IRC port
my @irc_nick;				# array of nicks 

my $irc_channel;			# where the script sits on

my $file_path;				# standard path for combining with different logs later.
my $file_prefix;			# standard file name

my $irc_logfile;			# Logfile where your output will be stored....

my $irc_datafile;			# Your datafile, statistics, what every you want to store somewhere...

my $irc_errorfile;			# This is for error messages. Each error will be stored with Timestamp and IRC_Nick.

my $rrd_outfile;			# Round Robin Database.
# my $rrd_outfile;	     # uncomment this and comment the line before
				# to disable RRD functionality (also later!)

my $ircname;				# ircname used by the script
my $username;				# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

my $rrd_step;				# one new value every 5 min.

my $rrd_starttime;			# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);



###############################################################
# user define section
#
#	# there are several default configurations
#

# first job: scanning for arguments of invoking command line...

#		; name of standard configurations
my $Socip_B =0;		 # BrasIRC
my $Socip_C =0;		 # Talkcity
my $Socip_D =0;		 # DALnet
my $Socip_E =0;	  	 # EFnet
my $Socip_F =0;	  	 # Flirt
my $Socip_G =0;	  	 # Galaxynet
my $Socip_I =0;	  	 # IRCnet
my $Socip_M =0;		 # Microsoft Chat Network
my $Socip_T =0;	  	 # for testing things...
my $Socip_U =0;		 # Undernet
my $Socip_W =0;		 # Webchat (www.webchat.org)



my $script_name = $0;		# Name of perl-script

# print ("\$script_name: '$script_name'\n");
$script_name =~  s!^.*/!!;
# print ("\$script_name: '$script_name'\n");

if ($script_name =~ /_B/) {$Socip_B =1};
if ($script_name =~ /_C/) {$Socip_C =1};
if ($script_name =~ /_D/) {$Socip_D =1};	# set configration depending on name of script
if ($script_name =~ /_E/) {$Socip_E =1};	# this is good for making links to one original script
if ($script_name =~ /_F/) {$Socip_F =1};
if ($script_name =~ /_G/) {$Socip_G =1};	# but to find out which IRC is monitored using ps.
if ($script_name =~ /_I/) {$Socip_I =1};
if ($script_name =~ /_M/) {$Socip_M =1};
if ($script_name =~ /_T/) {$Socip_T =1};
if ($script_name =~ /_U/) {$Socip_U =1};	# great, huh? :-)
if ($script_name =~ /_W/) {$Socip_W =1};



#$Socip_B =1; 	# uncomment for BrasIRC		# if you uncomment one, uncomment any
#$Socip_C =1; 	# uncomment for TalkCity
#$Socip_D =1; 	# uncomment for DALnet
#$Socip_E =0; 	# uncomment for EFnet
#$Socip_F =0; 	# uncomment for Flirt
#$Socip_G =0; 	# uncomment for Galaxynet
#$Socip_I =0; 	# uncomment for IRCnet
#$Socip_M =0; 	# uncomment for Microsoft Chat Network
#$Socip_U =0; 	# uncomment for Undernet
#$Socip_W =0; 	# uncomment for Webchat


print ("Configuration loaded for BrasIRC\n") if ($Socip_B);	# print configuration...
print ("Configuration loaded for TalkCity\n") if ($Socip_C);
print ("Configuration loaded for DALnet\n") if ($Socip_D);
print ("Configuration loaded for EFnet\n") if ($Socip_E);
print ("Configuration loaded for Flirtnet\n") if ($Socip_F);
print ("Configuration loaded for Galaxynet\n") if ($Socip_G);
print ("Configuration loaded for IRCnet\n") if ($Socip_I);
print ("Configuration loaded for Microsoft Chat Network\n") if ($Socip_M);
print ("Configuration loaded for Undernet\n") if ($Socip_U);
print ("Configuration loaded for Webchat\n") if ($Socip_W);
print ("Testing enabled\n") if ($Socip_T);



#######################################################################
################Global Settings for BrasIRC Network
#######################################################################



if ($Socip_B)

{

# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("irc.svn.com.br", "irc.ranet.com.br", "irc.transnet.com.br", "irc.ism.com.br" );
# not working good: "efnet.telia.no", "irc.df.lth.se", 

@irc_nick = ("Socip_B1", "Socip_B2", "Socip_B3", "Socip_B4");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
$irc_channel = "#hose";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_B";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

$ircname="www.hinner.com";	# ircname used by the script
$username="research";		# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);


}




#######################################################################
################Global Settings for TalkCity
#######################################################################


if ($Socip_C)

{

# There was special Code necessary to include Talkcity. At April, 13th, they changed their IRCd system
# and only allowed special clients to connect. After some time (to be correct, after three months, I had
# the time to check what they are exactly doing.
# First of all, it is needed to send "IRCX" at the end of the user command to make sure that IRCX
# compatibility is given.
# Then, a special Talkcity User (trackallusers) checks the Version of the IRC client. Because only
# one Windows IRC client (Pirch) is allowed to connect that I know of, it is needed to send this
# ID string back to stay connected.


# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("chat.talkcity.com", "morechat.talkcity.com");
$irc_port=7070;	# special port for Talkcity

@irc_nick = ("Socip_C1", "Socip_C2");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
$irc_channel = "#hose";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_C";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

$ircname="Kajetan Hinner";	# ircname used by the script
$username="Socip_C1";			# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);


}



#######################################################################
################Global Settings for DALnet
#######################################################################



if ($Socip_D)

{

# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("powertech.no.eu.dal.net", "viking.no.eu.dal.net", "spider.ca.us.dal.net", "ced.se.eu.dal.net" );
# not working good: "efnet.telia.no", "irc.df.lth.se", 

@irc_nick = ("Socip_D1", "Socip_D2", "Socip_D3", "Socip_D4");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
$irc_channel = "#hose2";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_D";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

$ircname="www.hinner.com";	# ircname used by the script
$username="research";		# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);


}



#######################################################################
################Global Settings for Efnet
#######################################################################



if ($Socip_E)

{

# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("irc.isdnet.fr", "irc.nijenrode.nl", "irc.idle.net");
#@irc_server = ("efnet.telia.no", "irc.telia.se", "irc.isdnet.fr",  "irc.nijenrode.nl", "irc.idle.net");
# not working good: "irc.ais.net",  , "irc.mcs.net", "irc.ced.chalmers.se", "irc2.homelien.no",

@irc_nick = ("Socip_E1", "Socip_E2", "Socip_E3", "Socip_E4");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
$irc_channel = "#hose";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_E";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

$ircname="www.hinner.com";		# ircname used by the script
					# changed for effnet server irc.idle.com because
					# it didn't accept other names.
$username="Tannhaeuser Tor";			# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);


}

#######################################################################
################Global Settings for Flirtnet
#######################################################################



if ($Socip_F)

{

# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("irc.de.flirt.ch");
# not working good: "irc.ais.net",  , "irc.mcs.net", "irc.ced.chalmers.se", "irc2.homelien.no",

@irc_nick = ("Socip_F1", "Socip_F2", "Socip_F3", "Socip_F4");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
# $irc_channel = "#hose";
$irc_channel = "";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_F";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

$ircname="www.hinner.com";		# ircname used by the script
					# changed for effnet server irc.idle.com because
					# it didn't accept other names.
$username="Tannhaeuser Tor";			# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);


}


#######################################################################
################Global Settings for Galaxynet
#######################################################################



if ($Socip_G)

{

# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("paris.fr.galaxynet.org", "nottingham.uk.galaxynet.org", "copenhagen.dk.galaxynet.org", 
"vltmedia.se.galaxynet.org");


@irc_nick = ("Socip_G1", "Socip_G2", "Socip_G3", "Socip_G4");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
$irc_channel = "#hose";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_G";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

$ircname="www.hinner.com";		# ircname used by the script
					# changed for effnet server irc.idle.com because
					# it didn't accept other names.
$username="Tannhaeuser Tor";			# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);


}




#######################################################################
################Global Settings for IRCnet
#######################################################################

if ($Socip_I)

{
###############################################################
# user define section
#


# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("irc.fu-berlin.de", "irc.informatik.tu-muenchen.de", "irc.tu-ilmenau.de");


@irc_nick = ("Socip_I1", "Socip_I2", "Socip_I3", "Socip_I4");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
$irc_channel = "#hose";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_I";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

$ircname="http://www.hinner.com/irc";	# ircname used by the script
$username="Tannhaeuser Tor";			# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);

}


#######################################################################
################Global Settings for Microsoft Network
#######################################################################



if ($Socip_M)

{

# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("mschat.msn.com" );
# not working good: "efnet.telia.no", "irc.df.lth.se", 

@irc_nick = ("Socip_M1", "Socip_M2", "Socip_M3", "Socip_M4");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
$irc_channel = "#hose";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_M";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

$ircname="www.hinner.com";	# ircname used by the script
$username="research";		# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);


}




#######################################################################
################Global Settings for Undernet
#######################################################################

if ($Socip_U)

{
###############################################################
# user define section
#


# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("graz.at.eu.undernet.org", "oslo.no.eu.undernet.org"  );
# "gothenburg.se.eu.undernet.org", "regensburg.de.eu.undernet.org", "goettingen.de.eu.undernet.org, "lulea.se.eu.undernet.org"" 

@irc_nick = ("Socip_U1", "Socip_U2", "Socip_U3", "Socip_U4");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
$irc_channel = "#hose";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_U";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick, one common file.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

$ircname="http://www.hinner.com/irc";	# ircname used by the script
$username="Tannhaeuser Tor";			# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);

}



#######################################################################
################Global Settings for Webchat
#######################################################################



if ($Socip_W)

{

# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("enterprise.il.us.webchat.org", "atlanta.ga.us.webchat.org", "oco.ca.us.webchat.org");
# not working good: 

@irc_nick = ("Socip_W1", "Socip_W2", "Socip_W3", "Socip_W4");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
$irc_channel = "#hose";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_W";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

$ircname="www.hinner.com";	# ircname used by the script
$username="research";		# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);


}




#######################################################################
################Global Settings for Testing!
#######################################################################

if ($Socip_T)

{
###############################################################
# user define section
#


# First of all, give a couple of IRC servers which may be used. We will cycle through those when problems occur
@irc_server = ("irc.fu-berlin.de", "irc.uni-stuttgart.de", "irc.uni-karlsruhe.de");


@irc_nick = ("Socip_T1", "Socip_T2", "Socip_T3", "Socip_T4");


# This is not intended as a bot or warscript. You may sit on one channel for fun reasons...
$irc_channel = "#hose";

$file_path = "/usr/home/khh/ircstat/";		# standard path for combining with different logs later.
$file_prefix = "Socip_T";		# standard file name
# Logfile where your output will be stored....
$irc_logfile = "$file_path$file_prefix.log";

# Your datafile, statistics, what every you want to store somewhere...
$irc_datafile = "$file_path$file_prefix.data";

# This is for error messages. Each error will be stored with Timestamp and IRC_Nick, one common file.
$irc_errorfile = $file_path . "Socip.error";

$rrd_outfile = "$file_path$file_prefix.rrd";		# Round Robin Database.
# $rrd_outfile;				  # uncomment this and comment the line before
							# to disable RRD functionality

# $ircname="http://www.hinner.com/irc";	        # ircname used by the script
# $username="Tannhaeuser Tor";			# username in irc, used by the script


# Define the Round-Robin-Database and Round-Robin-Archives

$rrd_step = 300;		# one new value every 5 min.

$rrd_starttime = timelocal (0,0,0,1,0,98);		# first time when data is accepted for the RRD
							# we took 1/1/98
# format:         timelocal($sec,$min,$hours,$mday,$mon,$year);

}



#################################
#################################  end of default section
###########################################################################################

my $msg_command_pw="defaultpw";		# Message-Command-Password


print ("RRD_Starttime (epoch: $rrd_starttime): " . ctime ($rrd_starttime) . "\n");

#################################
################################# end user define section
#################################
# do not alter anything below this line unless you know what you're doing
###########################################################################################



my $debug=2;

print ("Debug Mode On ($debug)\n") if ($debug);

# 1: print serious bugs (default)
# 2: print something (for the interested into the internal working of the program)
# 3: print everything (for debugging)


my $self = $0;
$self =~  s!^.*/!!;     		# Name of perl-script

if ((@ARGV > 1) || (scalar @ARGV && ($ARGV[0] =~ /-h/)))
{
    die "Usage:  perl $self [onlyrrd]\n	onlyrrd: Just create the RRD and exit\n";
}  

my $rrd_action="gothrough";			# what to do after creation of rrd
if (scalar @ARGV) {$rrd_action = $ARGV[0]};




# global variables

my $irc_self;	# bot object reference; defined later after connect

my $stat_users;		# variables which store the statistical information
my $stat_invisible;
my $stat_channels;
my $stat_services;
my $stat_servers;
my $stat_time;

my $r_users;		# received information, decoded server output
my $r_invisible;
my $r_channels;
my $r_services;
my $r_servers;

my $invoke_time;	# when the command was issued to our lovely irc server
#
#  Create the IRC and Connection objects
#

my $irc;			# instance of irc connection


my $conn;			# Connection handle
my $irc_server;			# IRC server name
my $irc_nick;			# Nick name of script

my $unknown_change_servers =0;	# counting none output of statistical command

#
#  Several output messages when it's about a whitty reply
#

my @zippy = (
  "Vanity. Definitely my favourite sin.",
  "I've seen things you people wouldn't believe.",
  "Attack ships on fire at the shoulder of orion.",
  "I watched C-beams glitter in the dark near Tannhäuser Gate.",
  "All those moments.. will be lost.... in time... like. ... tears ... in rain",
  "It's artificial? Of course it is.",
  "Are you also a true Beatles fan?",
  "Laurent Garnier rulez",
  "Men fears time. And time fears the pyramids.",
  "House music.",
  "House of House.",
  "Ich hab schon Deep House gemacht da hast Du noch in die Windeln geschissen.",
  "Der Mensch ist bereit, für jede Idee zu sterben, vorausgesetzt, daß ihm die Idee nicht ganz klar ist.", 
  "I think that IRC would be a much nicer place if people would masturbate BEFORE joining - Adam Noel Harris on #Hotsex.",
  "Guter Geschmack ist das schlimmste Laster, das jemals erfunden wurde. - Edith Sitwell", 
  "Revenge of the Nerds",
  "Tune In, Log On, Drop Out. - Richard Scheinin", 
  "Get a Cyberlife", 
  "If idiots could fly, IRC would be an international airport. - eFx^2)", 
  "I do not 'work'. I have people who pay me to do my hobbies in a timely fashion.", 
  "Your time is all used up.",
  "They call me the Dude.",
  "The Dude abides.",
  "Cannot join #real_life (invite only)",
  "Find a job you truly love, and you will never have to work another day in
your life.", 
  
  
	     );

#
# Subroutines

sub append_irclog {

 (my $note) = @_;	# text to append
 if (!(open FILEOUT, ">>$irc_logfile"))
                              {
			   	&append_errorlog(ctime() . "$irc_nick Can't open $irc_logfile: $!\n");
				return(0);
		            	};
 if (!(print FILEOUT ctime() . " $note"))
                              {
			   	&append_errorlog(ctime() . "$irc_nick Can't write to $irc_logfile: $!\n");
				return(0);
		            	};
 			  
 close (FILEOUT);

}

sub append_datafile {

 (my $note) = @_;	# text to append
 if (!open(FILEOUT, ">>$irc_datafile"))
                              {
			   	&append_errorlog(ctime() . "$irc_nick Can't open $irc_datafile: $!\n");
				return(0);
		            	};
 if (!(print FILEOUT "$note"))
                              {
			   	&append_errorlog(ctime() . "$irc_nick Can't write to $irc_datafile: $!\n");
				return(0);
		            	};
 			  
 close (FILEOUT);

}

sub append_errorlog {

 (my $note) = @_;	# text to append
 open(FILEOUT, ">>$irc_errorfile")
                           or die (ctime() . "$irc_nick Can't open $irc_errorfile: $!\n");
		            	
 (print FILEOUT ctime() . " $note")
                           or die (ctime() . "$irc_nick Can't open $irc_errorfile: $!\n");
 close (FILEOUT);
}





sub connecttoserver {

# you will notice that $ircname and $username variables were not used
# here and they are not effective. Well, I tried for one hour and did
# not find the reason why they won't work. So this information is
# hard-coded. 

$irc = new Net::IRC;

return ($irc->newconn(Server   => $irc_server,
			 Port     => $irc_port,
			 Nick     => $irc_nick,
			 Ircname  => $ircname,
			 Username => $username));

}


sub installhandlers {

print "Installing handler routines...\n";

$conn->add_handler('cping',  \&on_ping);
$conn->add_handler('crping', \&on_ping_reply);

$conn->add_handler('msg',    \&on_msg);
$conn->add_handler('chat',   \&on_chat);
$conn->add_handler('public', \&on_public);
$conn->add_handler('caction', \&on_action);
$conn->add_handler('join',   \&on_join);
$conn->add_handler('part',   \&on_part);
$conn->add_handler('cdcc',   \&on_dcc);


# local handlers for stats etc. **********************************************

$conn->add_handler(513, \&on_needpong);			# 513  # ERR_NEEDPONG 

$conn->add_handler(800, \&on_ircrpl_ircx);		# 800 (for Talkcity)
$conn->add_handler('cversion', \&on_cversion_reply);	# special for Talkcity


$conn->add_handler('luserclient', \&on_luserclient);		# 251, RPL_LUSERCLIENT (":There are <integer> users and <integer> invisible on <integer> servers")
$conn->add_handler('luserme', \&on_luserme);		# 255, RPL_LUSERME (":I have <integer> clients and <integer> servers")
$conn->add_handler('luserchannels', \&on_luserchannels);	# 254, RPL_LUSERCHANNELS ("<integer> :channels formed")
$conn->add_handler('n_global', \&on_n_global);		# 266 => "n_global": 'Current global users: 42125  Max: 43728'


$conn->add_global_handler (402, \&on_servernosuch);	# ERR_NOSUCHSERVER (server doesn't exist)

$conn->add_global_handler(463, \&on_servernoperm);	# ERR_NOPERMFORHOST (not allowed to connect to server)

$conn->add_global_handler(465, \&on_serverban);		# ERR_YOUREBANNEDCREEP (banned from server)

$conn->add_global_handler('disconnect', \&on_disconnect); # created at Connection.pm, when a "Closing Link" message
							  # came from the server. (clonebot, etc.)


# ***********************************************************
# global handlers
# 


$conn->add_global_handler([ 251,252,253,254,302,255 ], \&on_init);
$conn->add_global_handler( 376, \&on_connect);		# RPL_ENDOFMOTD	; Message of the Day.
$conn->add_global_handler([433, 436], \&on_nick_taken);	# ERR_NICKNAMEINUSE, ERR_NICKCOLLISION
$conn->add_global_handler(353, \&on_names);		# RPL_NAMREPLY


}











#  Here are the handler subroutines.
#

# What to do when the bot successfully connects.
sub on_connect {
	my $self = shift;

        $irc_self = $self;		# define global handle for communication with Net::Irc

        if (!defined $irc_self) {&append_errorlog ("$irc_nick: Serious problem at on_connect, undefined \$irc_self\n")};
        # this just prints "xxx" operators online (No. 252), because there is no special handler for that...
        # print ("on_init: '@args', length is " . scalar @args . " and irc_self is $irc_self\n") if ($debug > 1);

        &sub_kh_debug_ircself if ($debug > 1);	# print status of ircself

	# $conn->debug("1");		# set net::irc debug mode (does not work :( )

	print "Joining $irc_channel\n";
	$self->join("$irc_channel");
#      $self->privmsg("#IRC.pm", &pickrandom());
}

sub on_disconnect {

    my ($self, $event) = @_;
    my (@args) = ($event->args);     

    print ("on_disconnect: '@args', length is " . scalar @args . "\n") if ($debug > 1);


    &append_errorlog("Disconnected: " . $self->nick . " $args[0]\n");

    # this is not elegantly... when server sends "Closing Link... (clonebots sux)"
    # it sends another "Connection reset by peer", which will call on_disconnect
    # again and interrupt the new connection process which will be interrupted again.
    # so i check only for the 2nd and reset my connection then... :)
    if (($args[0] =~ /reset/) or ($args[0] =~ /try another server/) or ($args[0] =~ /not authorized to use this server/))
     {
      $conn="";
      &append_errorlog("Disconnected, Connection was reset. Connecting new\n");
     };
}

# Handles some messages you get when you connect
sub on_init {
    my ($self, $event) = @_;
    my (@args) = ($event->args);
    # shift (@args);

    $irc_self = $self;		# define global handle for communication with Net::Irc

    if (!defined $irc_self) {&append_errorlog ("$irc_nick: Serious problem, undefined \$irc_self\n")};
    # this just prints "xxx" operators online (No. 252), because there is no special handler for that...
    print ("on_init: '@args', length is " . scalar @args . " and irc_self is $irc_self\n") if ($debug > 2);

    &sub_kh_debug_ircself;	# print status of ircself
    
}

# What to do when someone leaves a channel the bot is on.
sub on_part {
    my ($self, $event) = @_;
    my ($channel) = ($event->to)[0];

    printf "*** %s has left channel %s\n", $event->nick, $channel;
}

# What to do when someone joins a channel the bot is on.
sub on_join {
    my ($self, $event) = @_;
    my ($channel) = ($event->to)[0];

    printf "*** %s (%s) has joined channel %s\n",
    $event->nick, $event->userhost, $channel;

    if ($event->userhost =~ /[bompf|hinner].soziologie.uni-rostock.de/) {  # Auto-ops anyone who
	$self->mode("$channel", "+o", $event->nick);      # matches hostmask.
    }
}

# What to do when we receive a private PRIVMSG.
sub on_msg {
    my ($self, $event) = @_;
    my ($nick) = $event->nick;		# sender of message

    # first check, if it's a command...

     my (@args)=($event->args);


    
    if ($args[0] =~ /$msg_command_pw/)
      {
	# to die, type			/msg <nick> passwd quit
	# to change server, type	/msg <nick> passwd connect server
	# to change nick, type		/msg <nick> passwd nick nick
	# to give op type		/msg <nick> passwd +o user [channel]
	# to take op type		/msg <nick> passwd -o user [channel]

        my @fields  = split (' ', $args[0]);
	
	# print ("Split into fields: 0'$fields[0]', 1'$fields[1]', 2'$fields[2]', 3'$fields[3]', 4'$fields[4]'\n");
	
	if ($fields[0] eq $msg_command_pw)	# check again if it's really set...
	  {
	   if ($fields[1] eq "quit")
	     {

              # $self->sl("QUIT :$fields[2]");

              $self->quit($fields[2] ?  join (' ', @fields[2 .. (@fields-1)]) : "Leaving");
	      $irc->do_one_loop();		# send command
	      print ("Received quit message from $nick. Died.\n");
       	      &append_errorlog("$irc_nick: Received quit message from $nick. Termination of Perl script.\n");
	      die();				# Termination of Perl Script!
	      
	     }
	   elsif ($fields[1] eq "connect")	# connect to irc server?
	     {
	      if ($fields[2]) 			# a specific server given?
	        {
	         unshift @irc_server, $fields[2];	# installing new server in front of our list
		}
	      $self->quit("Changing Servers - wish me good luck");
	      print ("Received connect message from $nick. Changing servers.\n");

              $irc->do_one_loop();
	      $conn="";			# mark this connection invalid
	     }
           elsif ($fields[1] eq "nick")		# change nick?
	     {
	      if ($fields[2])
	        {
		 $self->nick($fields[2]);	# if given, use this
                 print ("Received nick message from $nick. Changing nick to $fields[2].\n");

		}
		else
		{
		 $irc_nick=&picknick();		# take new one from list
		 $self->nick($irc_nick);
                 print ("Received nick message from $nick. Changing nick.\n");

		}
	      }
           elsif ($fields[1] eq "+o")		# give ops?
	     {
	      $self->mode(($fields[3] ? $fields[3] : $irc_channel), "+o", $fields[2]);      # give ops
              print ("Received +o message from $nick. Trying to give op to $fields[2].\n");
	      
	     }
	      	   
           elsif ($fields[1] eq "-o")		# take ops?
	     {
	      $self->mode(($fields[3] ? $fields[3] : $irc_channel), "-o", $fields[2]);      # take ops
              print ("Received -o message from $nick. Trying to take op from $fields[2].\n");

	     }
	     
	   elsif ($fields[1] eq "leave")	# leave channel
	     {
	      if ($fields[2])
	        {
		$self->part($fields[2]);
                print ("Received leave message from $nick. Leaving channel $fields[2].\n");
		
		}
		else
		{
		$self->part($irc_channel);
                print ("Received leave message from $nick. Leaving channel $irc_channel.\n");
		}
              }
	     
	   elsif ($fields[1] eq "join")		# join channel
	     {
	      if ($fields[2])
	        {
		$self->join($fields[2]);
                print ("Received join message from $nick. Joining channel $fields[2].\n");
		}
		else
		{
		$self->join($irc_channel);
                print ("Received join message from $nick. Joining channel $irc_channel.\n");
		}
              }
	     
	   elsif ($fields[1] eq "version")	# print Socip.pl version information
	     {
		$self->privmsg($nick, "I am running Socip.pl by Kajetan Hinner (www.hinner.com), Version $version.\n");
             }



	  }		# if password matched with the first word
      }		 	# if password was found in the message sent   



    else		# no command message. just print and add to log
     {
      print "*$nick*  ", ($event->args), "\n";
      &append_irclog("\<$irc_nick\> ***" . $event->nick . "*** $args[0]\n");
      $self->privmsg($nick, &pickrandom());   # Say a Zippy quote.
     }
}

# What to do when we receive channel text.
sub on_public {
    my ($self, $event) = @_;
    my ($to) = $event->to;
    my ($nick, $mynick) = ($event->nick, $self->nick);
    my ($arg) = ($event->args);

    print "<$nick:$to>  $arg\n";
    if ($arg =~ /$mynick/i) {                   # Say a Zippy quote if our nick
	$self->privmsg($to, &pickrandom());     # appears in the message.
    }

#    if ($arg =~ /Go away/i) {       # Tell him to leave, and he does.
#	$self->quit("Yow!!");
#	exit 0;
#    }

#    if ($arg =~ /^Chat/i) {         # Request a DCC Chat initiation
#	$self->new_chat(1, $event->nick, $event->host);
#    }

    # You can invoke this next part with "Send me Filename" or
    # "Send Filename to me". It doesn't much like ending punctuation, though.
    
#    $arg =~ s/[^"'\w]*?\b(to|me)\b[^'"\w]*?//g;

#    if ($arg =~ /^send\s+(\S+)\s*/i) {
#	if (-e $1) {
#	    $self->privmsg($nick, "Sending $1 in 10 seconds...");
#	    $self->schedule(10, \&Net::IRC::Connection::new_send, $nick, $1);
#	} else {
#	    $self->privmsg($nick, "No such file as $1, sorry.");
#	}
#    }
}

# What to do when we receive a message via DCC CHAT.
sub on_chat {
    my ($self, $event) = @_;
    my ($sock) = $event->to;

    print '*' . $event->nick . '* ' . ($event->args), "\n";
    &append_irclog("\<$irc_nick\> =" . $event->nick . "= " . $event->args . "\n");
    $self->privmsg($sock, &pickrandom());   # Say a Zippy quote.
}

# Prints the names of people in a channel when we enter.
sub on_names {
    my ($self, $event) = @_;
    my (@list, $channel) = ($event->args);

    ($channel, @list) = splice @list, 2;

    print "Users on $channel: @list\n";
}

# What to do when we receive a DCC SEND or CHAT request.
sub on_dcc {
    my ($self, $event) = @_;
    my $type = ($event->args)[1];

#    if (uc($type) eq 'SEND') {
#	open TEST, ">/tmp/net-irc.dcctest"
#	    or do { warn "Can't open test file: $!"; return; };
#	$self->new_get($event, \*TEST);
#	print "Saving incoming DCC SEND to /tmp/net-irc.dcctest\n";
#    } elsif(uc($type) eq 'CHAT') {
#	$self->new_chat($event);
#    } else {
#	print STDERR ("Unknown DCC type: " . $type);
#    }
}

# Yells about incoming CTCP PINGs.
sub on_ping {
    my ($self, $event) = @_;
    my $nick = $event->nick;

    $self->ctcp_reply($nick, join (' ', ($event->args)));
    print "*** CTCP PING request from $nick received\n";
}

sub on_cversion_reply {
    my ($self, $event) = @_;
    my $nick = $event->nick;

    $_="Social Science Research program Socip, $version, Look at http://www.hinner.com/ircstat";
    if ($Socip_C)
      {
      	# check if in Talkcity mode... if so, answer politely
	$_= "VERSION PIRCH98 for Talk City:WIN 95/98/WIN NT:1.0 (build 1.0.1.1268)";
        $self->ctcp_reply($nick, $_);
      }
    print "*** CTCP Version request from $nick received, answered: '$_'\n";
    
    $self->mode($irc_nick, "-isw");
}

# Gives lag results for outgoing PINGs.
sub on_ping_reply {
    my ($self, $event) = @_;
    my ($args) = ($event->args)[1];
    my ($nick) = $event->nick;

    $args = time - $args;
    print "*** CTCP PING reply from $nick: $args sec.\n";
}



# Change our nick if someone stole it.
sub on_nick_taken {
    my ($self) = shift;
    # my ($self, $event) = @_;
    # my (@args) = ($event->args)[1];

    print ("on_nick_taken: '" . $self->nick . "' \n") if ($debug > 1);

    &append_errorlog("Can't use nickname " . $self->nick . ", trying next.\n");
    

    my $irc_nick=&picknick();
    $self->nick($irc_nick);
}

# Display formatted CTCP ACTIONs.
sub on_action {
    my ($self, $event) = @_;
    my ($nick, @args) = ($event->nick, $event->args);
    
    # :FIXME: this should not be necessary:
    shift @args;
    
    print "* $nick @args\n";
}



sub on_luserclient {
    my ($self, $event) = @_;

    my (@args) = ($event->args);

    print ("on_luserclient: '@args', length is " . scalar @args . "\n") if ($debug > 2);

    # shift (@args);

    if (($r_users, $r_services, $r_servers) = ($args[1] =~ /^There are (\d+) users and (\d+) services on (\d+) servers/)) {return};
    
	# if not the first type, check for the 2nd: "There are 8042 users and 33582 invisible on 52 servers"

    if (($r_users, $r_invisible, $r_servers) = ($args[1] =~ /^There are (\d+) users plus (\d+) invisible on (\d+) servers/)) {return};
    if (($r_users, $r_invisible, $r_servers) = ($args[1] =~ /^There are (\d+) users and (\d+) invisible on (\d+) servers/)) {return};
    if (($r_users, $r_invisible, $r_servers) = ($args[1] =~ /^There are (\d+) visible and (\d+) invisible users on (\d+) servers/)) {return};
    if (($r_users, $r_invisible, $r_servers) = ($args[1] =~ /^Es sind (\d+) User und (\d+) unsichtbare auf (\d+) Server\(n\)/)) {return};
 
    # add error, if we didn't succeed
    &append_errorlog("$irc_nick: Could not match on_luserclient, Output was '$args[1]'\n"); 
    
    # print ("Extracted Users: $r_users, Services $r_services, Invisible $r_invisible, Servers: $r_servers\n") if ($debug > 2);


}

sub on_luserme {
    my ($self, $event) = @_;

    my (@args) = ($event->args);

    print ("on_luserme: '@args', length is " . scalar @args . "\n") if ($debug > 2);

    # shift (@args);
    # qx { echo $time@args >>$irc_logfile};

}

sub on_luserchannels {
    my ($self, $event) = @_;

    my (@args) = ($event->args);

    print ("on_luserchannels: '@args', length is " . scalar @args . "\n") if ($debug > 2);


    # shift (@args);

    # print ("Channels: The string I received: '@args', 3: $args[1]\n");    

    # ($r_channels) = ($args[1] =~ /^\S*(\d*) channels formed$/);

    $r_channels=$args[1];		# this is our searched data... no more decoding. :-)

    # print ("Extracted: $r_channels\n");

    # print ("Channels Length: " . scalar @args . "***\n");

}





sub on_servernosuch {
     my ($self, $event) = @_;
     my (@args) = ($event->args);     
     shift (@args);
     print ("No such server: '@args'\n");
     &append_errorlog("No such server $irc_server");
     $conn="";		# reset connection and force new connection

}

sub on_servernoperm {

     my ($self, $event) = @_;
     my (@args) = ($event->args);     
     shift (@args);
     print ("No permition to connect on server: '@args'\n");
     &append_errorlog("No permition to connect $irc_server");
     $conn="";		# reset connection and force new server



}


sub on_serverban {

     my ($self, $event) = @_;
     my (@args) = ($event->args);     
     shift (@args);
     print ("Banned on server: '@args'\n");
     &append_errorlog("Banned on server $irc_server");
     $conn="";		# reset connection

}

sub on_needpong {

# originates of: 513    ERR_NEEDPONG                :To connect, type /QUOTE PONG %lX

# Message is: If your client freezes here, type /QUOTE PONG 1234006973 or /PONG 1234006973

    my ($self, $event) = @_;

    my (@args) = ($event->args);

    print ("on_needpong: '@args', length is " . scalar @args . "\n") if ($debug > 2);
    
    (my $pong) = ($args[1] =~ /PONG (\d+) or \/PONG/);

    print ("on_needpong: value '$args[1]', extracted: '$pong'\n") if ($debug > 2);

    $self->sl("PONG :$pong");		# send pong back with ping argument
}

sub on_ircrpl_ircx {

# originates of: 800 - checking ircx features

    my ($self, $event) = @_;

    my (@args) = ($event->args);

    print ("on_ircrpl_ircx: '@args', length is " . scalar @args . "\n") if ($debug > 2);
    
    # $self->sl("IRCX ");		# send IRCX back - http://irc.pages.de/doc/mic.txt
}




sub on_n_global {

# originates of: 266 => "n_global": 'Current global users: 42125  Max: 43728'

    my ($self, $event) = @_;

    my (@args) = ($event->args);

    print ("on_n_global: '@args', length is " . scalar @args . "\n") if ($debug > 2);
    
    ($_) = $args[1] =~ /Current global users: (\d+) Max:/;

    if ($_)			# make certain that something was extracted
      {
       $r_users = $_;
       print ("on_n_global extracted r_users: $r_users\n") if ($debug > 2);
       $r_invisible = 0;
      }
}



sub pickserver {	# choose next server from list

  # this is only useful when the calling line looks like: $irc_server=&pickserver();

  # return first value when nick is undefined or the last one in our list...

  if (!defined($irc_server) || ($irc_server eq $irc_server[scalar @irc_server-1])) {return ($irc_server[0])};

  for (my $i=0; $i < scalar @irc_server; $i++)
     {
      # searching which number this server is and returning the next one
      if ($irc_server[$i] eq $irc_server) {return ($irc_server[++$i])};
     }    
  return ($irc_server[0]);

 }
 

sub picknick {	   # choose next nick

  # this is only useful when the calling line looks like: $irc_nick=&picknick();

  # return first value when nick is undefined or the last one in our list...
  if (!defined($irc_nick) || ($irc_nick eq $irc_nick[scalar @irc_nick-1])) {return ($irc_nick[0])};

  for (my $i=0; $i < scalar @irc_nick; $i++)
     {
      # searching which number this nick is and returning the next one
      if ($irc_nick[$i] eq $irc_nick) {return ($irc_nick[++$i])};
     }    
  return ($irc_nick[0]);
 }
 


sub pickrandom {   # Choose a random quote from the @zippy array.
    return $zippy[ rand scalar @zippy ];
}

sub sub_kh_debug_ircself {	# print debugging output of irc connection

   
  print ("Check output: defined \$irc_self: '" . defined $irc_self) if ($debug > 2);
  if ((defined $irc_self) && ($debug > 2)) {print ("', \$irc_self->connected: '" . $irc_self->connected)};
  print ("'\n") if ($debug > 2);
}





print "Starting...\n";


# check if started for the first time

# does the irc data file exist?
if (!(-e $irc_datafile))		# datafile doesn't exist
  {
   &append_datafile("#    Date               Users Channels Services Servers\n");	# create it and write first line
  }


# does the RRD file exist?

my $rrd_error;			# Error for RRD handling
my $rrd_errorcount =0;		# counts errors during update. If too much, stop Updating RRD

print ("Checking for '$rrd_outfile'\n");
if ($rrd_outfile && !(-e $rrd_outfile))
   {					# nope
    print "Creating Round-Robin-Database $rrd_outfile\n";

    # Round-Robin-Database define...
    # first defines number of users
    # second channels
    # third servers
    # fourth services
    # Data-Source:Data-Source-Type:Hearbeat:Min:Max, U means Unknown
    # Round-Robin-Archive:Consolidation_Function:steps:rows
    # daily: the first records every value for five week (5*12*24*7), every step (Default: 5min)
    # weekly: the second records every value for 15 weeks (15*12*24*7), every hour
    # weekly: the third records every value for two years (2*52*12*24*7), every three hours
    # yearly: the fourth records the maximum for two years, every hour
    # 

    RRDs::create $rrd_outfile, "-b", $rrd_starttime, "-s", $rrd_step ,
      "DS:users:GAUGE:3600:5000:U",
      "DS:channels:GAUGE:3600:500:U",
      "DS:servers:GAUGE:3600:3:U",
      "DS:services:GAUGE:3600:3:U",
      "RRA:AVERAGE:0.5:1:10080",
      "RRA:AVERAGE:0.5:3:30240",
      "RRA:AVERAGE:0.5:12:209664",
      "RRA:MAX:0:12:209664"
      ;

      #
      
 

     if($rrd_error = RRDs::error){
	print "Problem while creating $rrd_outfile: $rrd_error\n" if $rrd_error ;		# print error and exit
        &append_errorlog("Can't create RRD output file $rrd_outfile ($rrd_error). RRD function disabled.\n");
	$rrd_outfile="";						# undef output to RRD
	}
     }


if ($rrd_action eq "onlyrrd") {die "RRD successfully created. Terminating.\n"};



my $epochsecs;		# seconds since the epoch
my $epoch_diff;

my $chkcounter =0;	# counter for check of variables...

my $epoch_step=$rrd_step;	# do job every 5 minutes (default, you can change this)
# my $epoch_step=60;	# do job every 5 minutes (default, you can change this)

$epochsecs = time();	# get current time
my $epoch_trigger=$epochsecs- ($epochsecs%$epoch_step)+$epoch_step;	# next full five minutes
my $idle_trigger;		# when action should be done to avoid idle-kick

print ("Now: " . ctime($epochsecs) . ", sleeping 'till " . ctime($epoch_trigger) . "\n");


while (1)

{

 while (!$conn)
   {
       if ($irc_server) {sleep (120)};			# rest some time, when program already running


       print ("Not connected, conn: " . (defined $conn) . " and irc_self->connected: " . (defined $irc_self ? defined $irc_self->connected : "not def") . "\nNick: $irc_nick and Server: $irc_server'\n") if ($debug > 2);

       $irc_server=&pickserver();	# get name of server
       $irc_nick=&picknick();		# get new nick, to be sure...
       print ("Creating connection to $irc_server, my nick: $irc_nick...\n");
       if ($conn=&connecttoserver())
          {
	   print ("Successfully connected to $irc_server\n");
	   # print ("Connection 1 $conn\n");
	   &installhandlers();
	   # print ("Connection 2 $conn\n");
	   
	   $idle_trigger = time()+60*60*3;		# be active every three hours. 
           $epoch_trigger=$epochsecs- ($epochsecs%$epoch_step)+$epoch_step;	# next full five minutes
	   last;
	   }
       print ("Can't connect to IRC Server $irc_server, trying next.\n");
       &append_errorlog("$irc_nick: Can't connect to IRC Server $irc_server, trying next.\n");
   };


 $irc->do_one_loop();

 if (($debug==3) && ($chkcounter++ > 10))		# debugging output 
   {
    $chkcounter = 0;
    &sub_kh_debug_ircself;		# print $ircself and if connected
    print ("Time: " . time() . "and should be triggered at \$epoch_trigger: " . $epoch_trigger . "\n");
   }

 if (defined $irc_self && $irc_self->connected && (time() > $epoch_trigger))	# enough time passed?
   {
    # now it's time to save the results of our previous operation
    # 
    $stat_users=$r_users;
    $stat_invisible=$r_invisible;
    $stat_channels=$r_channels;
    $stat_services=$r_services;
    $stat_servers=$r_servers;
    $stat_time=$invoke_time;
    
    print ("Collected data: $r_users, Services $r_services, Invisible $r_invisible, Servers: $r_servers\n") if ($debug > 2);

    # now reset everything
    undef $r_users;
    undef $r_invisible;
    undef $r_channels;
    undef $r_services;
    undef $r_servers;

    $invoke_time=time();	# set time when lusers command was executed

    $irc_self->lusers;		# invoke statistical command.

	# writing data
	#	#    Date               Users Channels Services Servers
	#  	4/10/1998 00:00        24761   10070   6       72
	# this is the preferred format for the Datafile.

    if ($stat_time)		# only update when Data is valid (not after start of the program)
      {
       print ("Statistical invoked time: $stat_time, this is " . ctime($stat_time) . "\n") if ($debug > 2);
       my $datestring = localtime($stat_time)->mday . "/" . (localtime($stat_time)->mon+1) . "/" . (localtime($stat_time)->year+1900) . " " . localtime($stat_time)->hour . ":";
       if (localtime($stat_time)->min < 10) 
         { $datestring .= "0" . localtime($stat_time)->min}	# additional leading 0 if minutes just one character
	 else
	  { $datestring .= localtime($stat_time)->min};		# if two characters, simply append minutes

       # if noone minds, I don't care about the seconds. :-)

       print ("Calculated date: '$datestring'\n") if ($debug > 2);

       if ($stat_invisible && $stat_users) {$stat_users += $stat_invisible};	# add values

       my $unknown_counter =0;

       if (!defined $stat_users) {$stat_users="U"; $unknown_counter++;};		# set to "Unknown" for RRD;
       if (!defined $stat_invisible) {$stat_invisible="U"; $unknown_counter++;};
       if (!defined $stat_channels) {$stat_channels="U"; $unknown_counter++;};
       if (!defined $stat_services) {$stat_services="U"; $unknown_counter++;};
       if (!defined $stat_servers) {$stat_servers="U"; $unknown_counter++;};

       if ($unknown_counter eq 5)		# if there was no value gathered, increase problem counter
         {
	  $unknown_change_servers++;
	 }
	 else
         {
	  $unknown_change_servers =0;		# otherwise reset it
	 }
	 
       
       my $line=$datestring . " \t$stat_users\t$stat_channels\t$stat_services\t$stat_servers\n";
       &append_datafile($line);

       # now update RRD if needed (and wanted)
       
       if ($rrd_outfile)
         {
          RRDs::update $rrd_outfile, "$stat_time:$stat_users:$stat_channels:$stat_services:$stat_servers";
	 
	  print ("Updating $rrd_outfile $stat_time:$stat_users:$stat_channels:$stat_services:$stat_servers\n") if ($debug > 1);
	 
 	  if($rrd_error = RRDs::error){
		print "Problem while updating: $rrd_error\n" if $rrd_error ;
	        print ("Updating $rrd_outfile, Epochsecs: $stat_time; DATA: $stat_users:$stat_channels:$stat_services:$stat_servers\n");

                &append_errorlog("Problem while updating $rrd_outfile: $rrd_error (time: $stat_time), DATA: $stat_users:$stat_channels:$stat_services:$stat_servers\n");

		if ($rrd_errorcount++ == 10)
		    {
                     &append_errorlog("Too much errors: Updating of $rrd_outfile stopped.\n");
		     $rrd_outfile = "";		# more than 10 errors: stop RRD function
		    };	
		}
          } # end if RRD update
      }

    $epochsecs = time();	# get current time
    $epoch_trigger=$epochsecs- ($epochsecs%$epoch_step)+$epoch_step;	# next full step
    print ("Now: " . ctime($epochsecs) . ", sleeping 'till " . ctime($epoch_trigger) . "\n");

       
   }    # end if there passed enough time...

# when there's enough time left, let's sleep a while to get other tasks done...
# note: you should uncomment this if your script has to process many requests from other users on irc...

if (($epoch_trigger - $epochsecs) > ($epoch_step / 5)) {sleep (5)};

if ($irc_self)				# valid connection?
  { if (!$irc_self->connected)		# got disconnected because of anything?
    {
     &append_errorlog("$irc_nick: Not connected.\n");	# yep, print into errorlog
     # print ("undefined irc_self $irc_self\n");
     $conn="";						# try to reconnect
     undef $irc_self;
    }

    elsif ($idle_trigger < time())		# did current time catch up?
       {
	$irc_self->privmsg("Shadow_I", "idle-kick-avoid-msg. Take it easy. :-)");
	$idle_trigger = time() + 60*60*3;		# be active every three hours. 
       }
   }

if ($unknown_change_servers eq 3)		# unknown data three times in a row? change servers.
  {
  &append_errorlog("$irc_nick: Too much unknown data ($unknown_change_servers). Changing servers.\n");
  $irc_self->quit("Changing Servers - too much unknown data");
  print ("$irc_nick: Too much unknown data ($unknown_change_servers). Changing servers.\n");
  $unknown_change_servers =0;
  sleep(5);
  $irc->do_one_loop();
  sleep(5);
  $conn="";
  undef $irc_self;			# reset $irc_self
  }
 
}

