#!/usr/bin/perl -w

#   SysNfo - system info script for X-Chat 2
#   Copyright (C) 2007,2008  Jernej Simoncic
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301, USA
#
#Changelog:
#
#2008-10-14: 0.6
#
#2008-10-05: 0.5
# - support temperature/fan sensors with firendly names ("Case Fan","CPU Temp" etc.)
#
#2008-01-18: 0.4
# - support for multiple templates
# - vars now include network speeds
#
#2007-08-26: 0.3
# - fixed regexp for new coretemp updates and fixed the k8temp regexp which wasn't
#   correct at all previously
#
#2007-08-17: 0.2
# - Initial (limited) public release
#

use strict;
use warnings;
use utf8;
use locale;

use constant VERSION => '0.5';

use constant DEFAULT_TEMPLATE => "\002( System:\002 {sys} \002on\002 {replace: +; ;{cpu_0_model_name}} \002){s}".
    "( Bogomips:\002 {cpu_bogomips} \002){s}".
    "( Memory:\002 total: {mem_total_mb} used: {mem_used_mb} \002[\002{bar:{mem_used};{mem_total};10;\0039;|;\0033;|}".
    "\017\002] ){s}( Disks:\002 total: {fmt_size:{disk_total}} used: {fmt_size:{disk_used}} \002[\002".
    "{bar:{disk_used};{disk_total};10;\0039;|;\0033;|}\017\002] ){s}( Uptime:\002 {fmt_time:{uptime}} \002){s}".
    "( Load avg:\002 {load1} {load5} {load15} \002){s}( Vpenis:\002 {vpenis} \002){s}".
    "( {net__dev}:\002 Rx: {fmt_size:{net__rx}}{if:{defined:net__rx_per_sec}; \002[\002{fmt_size:{net__rx_per_sec}}/s\002]\002} ".
    "Tx: {fmt_size:{net__tx}}{if:{defined:net__tx_per_sec}; \002[\002{fmt_size:{net__tx_per_sec}}/s\002]\002} \002)".
    "{if:{defined:sensor_temp1};{s}( CPU Temp:\002 {sensor_temp1} \002)}";

my %template = ( default => DEFAULT_TEMPLATE );
my $split = 400;

my @timed_data;

Xchat::print "\002System Info\002 version ".VERSION;

print "======================================================================================\n";

if ($^O !~ /linux/) {
	die "Sorry, only linux is supported at this time.\n";
}

Xchat::register("SystemInfo", VERSION, "Brag about your system");

load_settings();

Xchat::hook_command('nfo', \&command_hook, {help_text => 'Brag about your system'});
Xchat::hook_timer(1000, \&tmr_gather_data);
Xchat::print "Use \002/nfo ?\002 for short help";

sub load_settings
{
	my $cf = Xchat::get_info("xchatdir") . '/sysnfo.conf';

	open CONF,$cf or return;
	while(<CONF>) {
		chomp;
		next if (/^\s*$/); #skip empty lines
		next if (/^\s*;/); #...and comments

		next unless (/^([^=]+)=(.*)$/);
		my ($name,$value) = ($1,$2);
		if ($name =~ /^template\[(\w+)\]/) {
			$template{$1} = $value;
		} elsif ($name eq 'split') {
			$split = $value;
		}
	}
	$split = 400 unless $split =~ /^\d+$/;
	close CONF;
}

sub save_settings()
{
	my $cf = Xchat::get_info("xchatdir") . '/sysnfo.conf';

	open CONF,">$cf" or return;
	#print CONF "template=".$template."\n";
	foreach my $key (keys %template) {
		print CONF 'template['.$key.']='.$template{$key}."\n";
	}
	print CONF "split=".$split."\n";
	close CONF;
}

##
# de_code($text,$style): Convert color codes and text styles to Xchat %-codes
#
# $text: Text to process
# $style: Style of processing (0=keep control codes, 1=strip control codes)
#
# Return value: $text with control codes expanded
sub de_code($$)
{
	my ($text,$style) = @_;
	if ($style == 0) {
		$text =~ s/\003(1[0-5]|0?\d)(?!,)/\003$1%C$1/g;
		$text =~ s/\003(1[0-5]|0?\d),(1[0-5]|0?\d)/\003$1,$2%C$1,$2/g;
		$text =~ s/\037/\037%U/g;
		$text =~ s/\002/\002%B/g;
		$text =~ s/\017/\017%O/g;
	} else {
		$text =~ s/\003(1[0-5]|0?\d)(?!,)/%C$1/g;
		$text =~ s/\003(1[0-5]|0?\d),(1[0-5]|0?\d)/%C$1,$2/g;
		$text =~ s/\037/%U/g;
		$text =~ s/\002/%B/g;
		$text =~ s/\017/%O/g;
	}
	return $text."\017";
}

##
# f_s: insert optional split marker
#
sub f_s
{
	my $repl = shift;

	$repl = "" unless defined($repl);

	return "\x01".$repl."\x01";
}

##
# evaluate a perl expression from var
#
sub f_eval
{
	my $out = eval(join(';',@_));

	if ($@) {
		$out = "$@";
		$out =~ s:\n$::;
		$out =~ s:\n:|:g;
		$out = "[eval: $out]";
	} else {
		$out = "" unless defined($out);
	}

	return $out;
}

##
# draw a percentage bar
#
# parameters: percentage, length, style1, char1, style2, char2
#         or: num1, num2, length, style1, char1, style2, char2
#
sub f_bar
{
	my ($pct,$len,$style1,$style2,$char1,$char2);

	if (@_ == 6) {

		$pct = shift(@_) / 100;

	} elsif (@_ == 7) {

		my $n1 = shift;
		my $n2 = shift;
		$pct = $n1 / $n2;

	} else {

		return "[bar: Incorrect number of parameters]";

	}

	($len,$style1,$char1,$style2,$char2) = @_;

	my $bars = int(0.5 + $len * $pct);

	return $style1.
		$char1 x $bars.
		$style2.
		$char2 x ($len - $bars);
		
}

##
# f_replace:
#
sub f_replace
{
	my ($from,$to,$text) = @_;

	$text =~ s/$from/$to/g;

	return $text;
}


##
# f_if: if first parameter is true, return 2nd parameter, otherwise return 3rd param
#
sub f_if
{
	my ($check,$true,$false) = @_;

	$true = "" unless defined $true;
	$false = "" unless defined $false;

	print "<< $check ; $true ; $false\n";

	if ($check) {
		return $true;
	} else {
		return $false;
	}
}

##
# f_defined: return 1 if variable is defined, 0 otherwise
#
sub f_defined
{
	my $data = shift;
	my $var = shift;

	if (exists($data->{$var}) && defined($data->{$var})) {
		return 1;
	} else {
		return 0;
	}
}

##
# get_params($text): split the input text at the first unmatched closing curly brace
#
sub get_params($)
{
	my $in = shift;

	my $out;
	my $para = 0; #number of open curly parenthesis

	while ($in =~ /(.*?)((?<!\\)[{}])/gsc) {
		$out .= $1;
		if ($2 eq '{') {
			$para++;
		} else {
			$para--;
		}
		last if $para < 0; #we've reached the end of the variable
		$out .= $2;
	}
	$in =~ /\G(.*)$/gsc;

	return $out,$1;
}

##
# replace_vars($template,$vars): Do the actual formatting of the template
#
#
sub replace_vars #($$)
{
	my ($text,%vars) = @_;

	my $out;

	while ($text) {

		last unless $text =~ m=^([^{]*)          #text before variable/function
		                       \{                #start of var/func
		                       ([^\s\}:]*)       #variable/function
		                       ([\}:])           #end of var/func name, possible start of parameters
		                       (.*)              #the rest, to be processed later (if needed)
		                       $=x;

		$out .= $1;
		my $var = $2;
		$text = $4;

		my $params;
		if ($3 eq ':') {  #parameters?

			($params,$text) = get_params($text);

			$params = replace_vars($params,%vars) if $params =~ /(?<!\\)\{.*?(?<!\\)\}/; #expand embedded variables
		}
		
		unless (defined($vars{$var})) {
			$var .= ":" . $params if (defined($params));
			$out .= '{'.$var.'}';
			#Xchat::print "Warning: undefined variable: {$var}";
			next;
		}

		if (ref($vars{$var}) eq 'CODE') {

			my @params; 
			@params = split(/(?<!\\);/,$params) if defined $params; #split the parameters to array
			s/\\(.)/$1/g foreach @params;           #unescape the parameters

			if ($var eq 'defined') {
				$out .= $vars{'defined'}->(\%vars,@params);
			} else {
				$out .= $vars{$var}->(@params);
			}

		} else {

			$out .= $vars{$var};

		}

	}
	$out .= $text if defined($text);

	return $out;
}

sub process_template($%)
{
	my ($templ,%vars) = @_;

	my $text = replace_vars($templ,%vars);

	my @out;
	foreach my $splittext (split(/\x0d/,$text)) {		
		$splittext =~ /^([^\x01]*)/gsc; #text before first optional linebreak
		my $out = $1;

		$out = force_split($out,@out);

		while ($splittext =~ m=\x01([^\x01]*)   #replacement text if no linebreak
		                       \x01([^\x01]*)   #text after linebreak
		                      =gscx) {

			my ($repl,$rest) = ($1,$2);

			if (length($out . $repl . $rest) > $split) {

				my $style = get_style_from_line($out); #probably not desirable, since you can set the style with {s:1;2;3}

				push @out,$out;

				$out = $style . $rest;
				$out = force_split($out,@out); #ensure that $out still isn't too long
			
			} else {

				$out .= $repl . $rest;

			}
		}

		push @out,$out;
	}

	return @out;
}

##
# Returns human-readable speed
#
# $speed: speed in MHz to format
#
sub f_fmt_speed($;$)
{
	my ($speed,$pl) = @_;

	$speed = 0 unless (defined($speed));
	$pl = 2 unless (defined($pl));

	if ($speed < 1000) {
		return sprintf('%d MHz', $speed);
	} else {
		return sprintf("%.".$pl."f GHz", $speed/1000);
	}
}

##
# Returns human-readable size
#
# $bytes: size in bytes to format
#
sub f_fmt_size($;$)
{
	my ($size,$pl) = @_;

	$size = 0 unless (defined($size));
	$pl = 1 unless (defined($pl));

	if ($size < 1000) {
		return sprintf('%d B', $size);
	} elsif($size < 1024000) {
		return sprintf("%.".$pl."f kB", $size/1024);
	} elsif($size < 1048576000) {
		return sprintf("%.".$pl."f MB", $size/1048576);
	} else {
		return sprintf("%.".$pl."f GB", $size/1073741824);
	}
}

##
# f_fmt_time($): Returns human-readable time
#
# $seconds: time in seconds to convert
#
# Return value: time formatted like this: 1d 2h 3min 4s
sub f_fmt_time($)
{
	my $seconds = shift;

	$seconds = 0 unless (defined($seconds));

	$seconds = int($seconds);

	my $retstr;
	foreach my $unit ([31536000, "y"], [604800, "w"], [86400, "d"], [3600, "h"], [60, "min"], [1, "s"]) {
		my $tmp = int($seconds / $unit->[0]);
		next unless $tmp;
		$seconds -= $tmp * $unit->[0];
		$retstr .= $tmp . $unit->[1] . " ";
	}
	$retstr =~ s: $::;
	
	return $retstr;
}

sub find_prog($)
{
	my $prog = shift;
	foreach ('/usr/bin/','/usr/local/bin/','/bin/','/usr/sbin/','/usr/local/sbin/','/sbin/') {
		return $_.$prog if (-x $_.$prog);
	}
	foreach (split(':',$ENV{PATH})) {
		my $d = $_;
		$d .= '/' unless ($d =~ m,/$,);
		return $d.$prog if (-x $d.$prog);
	}
}

sub read_oneliner($)
{
	my $file = shift;
	open FILE,"<$file" or return;
	$file = <FILE>;
	chomp($file);
	close FILE;
	return $file;
}


sub get_cpuinfo(\%)
{
	my $data = shift;

	open NFO,"</proc/cpuinfo" or return;
	my $cpu = 0;
	while(<NFO>) {
		chomp;
		if (/processor\s*:\s*(\d+)$/) {
			$data->{cpu_number}++;
			$cpu = $1;
		} elsif (/bogomips\s*:\s(\d+(?:\.\d+)?)$/) {
			$data->{cpu_bogomips} += $1;
		}

		if (/^([^:]+):\s*(.+)/) {

			my $fld = $1;
			my $cont = $2;
			$fld =~ s/\s+$//;
			$fld =~ s/\s/_/g;
			$fld =~ s/^cpu_//;

			$data->{"cpu_".$cpu."_".$fld} = $cont;

		}
	}
	close NFO;
}

sub get_meminfo(\%)
{
	my $data = shift;

	open NFO,"</proc/meminfo" or return;
	while(<NFO>) {
		chomp;
		if (/MemTotal:\s*(\d+)\skB/) {
			$data->{mem_total} = $1;
		} elsif (/(?:MemFree):\s*(\d+)\skB/) {
			$data->{mem_free} = $1;
		}
	}
	close NFO;

	$data->{mem_used} = $data->{mem_total} - $data->{mem_free};

	foreach('mem_total','mem_used','mem_free') {
		$data->{$_."_mb"} = sprintf("%.01f",$data->{$_} / 1024)." MB"; #{fmt_size:} rounds >= 1024MB to GB, which may not be wanted with memory
		$data->{$_} *= 1024; #/proc/meminfo returns memory in kB, this allows the use of {fmt_size:}
	}
}

sub get_diskspace(\%)
{
	my $data = shift;

	my $df = find_prog('df');
	return unless defined $df;

	open DF,"$df -PkT 2>/dev/null |" or return; #P - POSIX format (always 1 line per device), k - 1024B blocks, T - show fs type

	while (<DF>) {
		chomp;
		next unless m=\S+            #Filesystem
		              \s+
		              (\S+)          #Type
		              \s+
		              (\d+)          #1024-blocks (size)
		              \s+
		              (\d+)          #Used
		              \s+
		              (\d+)          #Available
		              \s+
		              \d+%
		             =x;

		next if $1 eq 'tmpfs';

		$data->{disk_total} += $2 * 1024;
		$data->{disk_used}  += $3 * 1024;
		$data->{disk_free}  += $4 * 1024;
	}
	close DF;
}

sub get_sensors(\%)
{
	my $data = shift;

	my $sensors = find_prog('sensors');
	return unless defined $sensors;

	open SENSORS,"$sensors 2>/dev/null |" or return;
	
	while(my $s = <SENSORS>) {
		chomp($s);

		if ($s =~ /^([^:]*(?:temp|fan|volt)[^:]*):\s*((?:[+-])?\d+(?:[\.,]\d+)?).+?((?:RPM|[FCV]))/i) {

			my $tmp = " ";
			$tmp = "\x{00B0}" if ($3 eq 'F' || $3 eq 'C'); #encoding-independent :)
			
			my ($name,$value,$unit) = (lc($1),$2,$3);
			$name =~ s:^\s+::;
			$name =~ s: :_:g;

			$data->{"sensor_".$name} = $value.$tmp.$unit;
			$data->{"sensor_".$name} =~ s:^\+::;

		} elsif ($s =~ /^(core|k8)temp-.*?-([a-f\d]+)/) { #only in new enough lm_sensors and kernel; requires kernel
		                                                  #patch as of 2.6.21 to get coretemp module
			my $type = $1.$2;
			my $k8core;
			while(<SENSORS>) {
				chomp;
				if (/^$/) {
					last;
				} elsif (/^Core(\d+)\s+Temp:/) {
					$k8core = $1;
				} elsif (/^\s+((?:[+-])?\d+(?:[\.,]\d+)?).+?([FC])/) {  #k8temp
					if (defined $k8core) {
						$data->{"sensor_".$type."_".$k8core} = $1."\x{00B0}".$2;
						$data->{"sensor_".$type."_".$k8core} =~ s:^\+::;
					}
				} elsif (/(?:temp|Core\s)(\d+):\s*((?:[+-])?\d+(?:[\.,]\d+)?).+?([FC])/) {  #coretemp
					$data->{"sensor_".$type."_".$1} = $2."\x{00B0}".$3;
					$data->{"sensor_".$type."_".$1} =~ s:^\+::;
				}
			}

		}
	}
	close SENSORS;
}

sub get_hddtemp(\%)
{
	my $data = shift;

	my $hddtemp = find_prog('hddtemp');
	return unless defined $hddtemp;

	my ($avgtemp,$numdsk);

	foreach(`$hddtemp /dev/[sh]d? 2>/dev/null`) {
		chomp;
		if (m=^(/dev/\w+):\s+(.*?):\s+(\d+(?:[\.,]\d+)?).+?([CF])=) {
			$data->{"hddtemp_".$1} = $3."\x{00B0}".$4;
			$data->{"hddtemp_".$1."_type"} = $2;

			if ($4 eq 'C') {
				$avgtemp += $3;
			} else {
				$avgtemp += (($3-32)/1.8);
			}
			$numdsk++;
		}
	}

	$data->{hddtemp_average} = sprintf("%.1f\x{00B0}C",$avgtemp/$numdsk) if ($numdsk);
	$data->{hdd_num} = $numdsk if ($numdsk);
}

sub get_net(\%)
{
	my $data = shift;

	open NFO,"</proc/net/dev" or return;
	while(<NFO>) {
		chomp;
		if (/^\s*
		     (\w+):\s*    #interface
		     (\d+)\s+     #receive bytes
		     (\d+)\s+     #receive packets
		     (\d+)\s+     #receive errs
		     (\d+)\s+     #receive drop
		     (\d+)\s+     #receive fifo
		     (\d+)\s+     #receive frame
		     (\d+)\s+     #receive compressed
		     (\d+)\s+     #receive multicast
		     (\d+)\s+     #transmit bytes
		     (\d+)\s+     #transmit packets
		     (\d+)\s+     #transmit errs
		     (\d+)\s+     #transmit drop
		     (\d+)\s+     #transmit fifo
		     (\d+)\s+     #transmit colls
		     (\d+)\s+     #transmit carrier
		     (\d+)        #transmit compressed
		    /x) {
			$data->{"net_".$1."_rx"} = $2;
			$data->{"net_".$1."_rx_pkts"} = $3;
			$data->{"net_".$1."_rx_errs"} = $4;
			$data->{"net_".$1."_rx_drop"} = $5;
			$data->{"net_".$1."_rx_fifo"} = $6;
			$data->{"net_".$1."_rx_frame"} = $7;
			$data->{"net_".$1."_rx_comp"} = $8;
			$data->{"net_".$1."_rx_mcast"} = $9;
			$data->{"net_".$1."_tx"} = $10;
			$data->{"net_".$1."_tx_pkts"} = $11;
			$data->{"net_".$1."_tx_errs"} = $12;
			$data->{"net_".$1."_tx_drop"} = $13;
			$data->{"net_".$1."_tx_fifo"} = $14;
			$data->{"net_".$1."_tx_frame"} = $15;
			$data->{"net_".$1."_tx_comp"} = $16;
			$data->{"net_".$1."_tx_mcast"} = $17;

			if ($1 ne 'lo' && $2 > 0 && $10 > 0) { #network device with most traffic
				next if (defined($data->{net__rx}) && ($data->{net__rx}+$data->{net__tx}) > ($2+$10));

				$data->{net__rx} = $2;
				$data->{net__tx} = $10;
				$data->{net__dev} = $1;
			}
		}
	}
	close NFO;
}

sub get_procnum(\%)
{
	my $data = shift;

	opendir PROC,"/proc" or return;  #number of processes
	$data->{proc_num} = scalar(grep( { /^\d+$/ && -d "/proc/$_" } readdir(PROC)));
	closedir PROC;
}

sub get_graphics(\%)
{
	my $data = shift;

	my $lspci = find_prog('lspci');
	return unless defined $lspci;

	my $vga;
	foreach (`$lspci 2>/dev/null`) {
		chomp;
		if (/VGA[^:]+:(.*?)(?:\(|$)/) {
			$data->{gfx_card} = $1;
			last;
		}
	}

	my $xdpyinfo = find_prog('xdpyinfo');
	return unless defined $xdpyinfo;

	foreach (`$xdpyinfo 2>/dev/null`) {
		chomp;
		if (/dimensions:\s*(\d+)x(\d+)/) {
			$data->{gfx_resolution} = $1."x".$2;
		} elsif (/depth:\s*(\d+)/) {
			$data->{gfx_depth} = $1 if (!defined($data->{gfx_depth}) || $1 > $data->{gfx_depth});
		}
	}
}

##
# vpenis formula adapted from
# http://dev.gentoo.org/~vapier/vpenis
#
sub get_vpenis(\%)
{
	my $data = shift;

	$data->{vpenis} = 70;

	$data->{vpenis} += $data->{uptime} / 864000;
	$data->{vpenis} += ($data->{cpu_0_MHz} / 30) * $data->{cpu_number};
	$data->{vpenis} += $data->{mem_total} / (1024*1024) / 3; #vpenis script uses used memory here (used as in $data->{mem_used} + cache)
	$data->{vpenis} += $data->{disk_total} / (1024*1024) / 50 / 15;  #original counted SCSI disks twice; I see this as pointless
	                                                  #nowadays, thanks to libata replacing the IDE subsystem in kernel
	                                                  #(but if you know how to detect real SCSI/SAS drives, let me know :)
	$data->{vpenis} = sprintf('%.01f cm',$data->{vpenis} / 10);
}

sub get_timed(\%)
{
	my $data = shift;

	if (@timed_data < 2) { #not enough data yet
		return;
	}

	foreach my $k (keys %{$timed_data[0]}) {
		if ($timed_data[0]->{$k} =~/^\d+$/) {
			$data->{$k.'_per_sec'} = ($timed_data[$#timed_data]->{$k} - $timed_data[0]->{$k}) / $#timed_data;
		}
	}
}

sub gather_data(;$)
{
	my $templ = shift;

	my %data;

	get_cpuinfo(%data);
	get_meminfo(%data);
	get_diskspace(%data);
	get_sensors(%data) if (!defined($templ) || $templ =~ /\{sensor/);
	get_hddtemp(%data) if (!defined($templ) || $templ =~ /\{hdd/); #hddtemp might block for a few seconds
	get_net(%data);
	get_procnum(%data) if (!defined($templ) || $templ =~ /\{proc/);
	get_graphics(%data) if (!defined($templ) || $templ =~ /\{gfx/);
	get_timed(%data);

	my $tmp = read_oneliner("/proc/uptime");
	$tmp =~ /^(\d+\.\d+)\s+(\d+\.\d+)/;
	$data{uptime} = $1;
	$data{uptime_idle} = $2;

	$tmp = read_oneliner("/proc/loadavg");
	$tmp =~ /^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)\s+/;
	$data{load1} = $1;
	$data{load5} = $2;
	$data{load15} = $3;

	$tmp = read_oneliner("/proc/version");
	$tmp =~ /^(\S+)\s+version\s+(\S+)/;
	$data{sys} = $1." ".$2;

	get_vpenis(%data);

	$data{'n'} = "\x0d";
	$data{''} = "{";

	$data{'s'} = \&f_s;
	$data{'bar'} = \&f_bar;
	$data{'eval'} = \&f_eval;
	$data{'fmt_size'} = \&f_fmt_size;
	$data{'fmt_speed'} = \&f_fmt_speed;
	$data{'fmt_time'} = \&f_fmt_time;
	$data{'if'} = \&f_if;
	$data{'defined'} = \&f_defined;
	$data{'replace'} = \&f_replace;

	return %data;
}

sub show_help()
{
	my @help = (
		'Usage:',
		'/nfo [id] - send info about your system to the current chat',
		'/nfo set [id] <string> - change the formatting string for system info',
		'/nfo del <id> - delete the formatting string',
		'/nfo reset - reset the default formatting string',
		'/nfo get - display the current settings',
		'/nfo get 1 - same as get, but show xchat control codes',
		'/nfo view - show the system info locally',
		'/nfo vars - displays all variables (with their content) and functions available for use with /nfo set',
		'/nfo split <number> - maximum line length before it\'s split',
		'',
		'id is the template ID you want to use. If you don\'t specify it, default is assumed.',
		'id can only consist of letters, numbers and the _ character.',
	);
	Xchat::print $_ foreach @help;
}

##
# find the style at the end of line
#
sub get_style_from_line($)
{
	my $style = shift;

	$style =~ s/^.*\017//s; #Ctrl+O resets the style, anything in front of it is not important
	my @style = split(/\003/,$style); #check all remaining color definitions...
	my ($fg,$bg);
	foreach (@style) {
		if (s/^(1[0-5]|\d)(,(?:1[0-5]|\d))?//) { #...and pick the last defined background and foreground color
			$fg = $1;
			$bg = $2 if defined($2);
		}
		s/[^\002\026\037]//gs; #throw out anything that isn't bold/underline/reversed
	}
	$style = join('',@style); #$style now contains just bold, underline and reversed
	$style =~ s/\002(.*?)\002/$1/gs; #two Ctrl+B's cancel eachother out...
	$style =~ s/\037(.*?)\037/$1/gs; #...same for underline...
	$style =~ s/\026(.*?)\026/$1/gs; #...and reversed

	if (defined($bg)) { #add the color
		$style .= "\003$fg$bg";
	} elsif (defined($fg)) {
		$style .= "\003$fg";
	}

	return $style;
}

sub split_out($)
{
	my $in = shift;

	my $tmp = substr($in,0,$split);

	$tmp =~ /^(.*[\002\003\017\037])/s; #try to split at style change first...
	
	my $splitlen = 0;
	my $splitpos = length($1)-1;

	if ($splitpos <= 0) {
		$splitpos = rindex($tmp," "); #...then at a space...
		if ($splitpos == -1) { #...and finally at the upper limit
			$splitpos = $split;
		} else {
			$splitlen = 1; #don't include the space on beginning of next line
		}
	}

	my $splitted = substr($in,0,$splitpos);

	my $style = get_style_from_line($splitted);

	my $rest = substr($in,$splitpos+$splitlen);

	return ($splitted,$style.$rest);
}

##
# force_split($out,\@out): ensure that the text is shorter than $limit
#
sub force_split($\@)
{
	my ($out,$out_a) = @_;

	while (length($out) > $split) {
		my $outed;
		($outed,$out) = split_out($out);
		push @{$out_a},$outed;
	}

	return $out;
}

sub brag(;$$)
{
	my ($where,$which) = @_;

	$which = 'default' unless defined $which;

	my $use_template;

	if (exists($template{$which})) {

		$use_template = $template{$which};

	} else {

		if ($which =~ /^\{.*\}$/ || $where == 0) {
			$use_template = $which; #used to show a single variable
		} else {
			Xchat::print "Template $which doesn't exist. [$where]";
			return;
		}

	}

	if ($where) {
		CHECK: foreach my $channel (Xchat::get_list('channels')) {
			if ($channel->{channel} eq Xchat::get_info('channel')) {
				if ($channel->{type} != 2 && $channel->{type} != 3) {
					Xchat::print 'You can only use this command in channels and private chats.';
					$where = 0; #display locally
					last CHECK;
				}
			}
		}
	}

	my %data = gather_data($use_template);

	my @out = process_template($use_template,%data);

	if ($where) {
		Xchat::command 'say '.$_ foreach @out;
	} else {
		Xchat::print $_ foreach @out;
	}
}

sub test($)
{
	my $templ = shift;

	my %data = gather_data($templ);

	my @out = process_template($templ,%data);

	Xchat::print $_ foreach @out;
}

sub show_vars()
{
	Xchat::print "Gathering data, this may take a few seconds...";
	Xchat::hook_timer(100, \&show_vars_tmr);
}

sub show_vars_tmr()
{
	my %data = gather_data();

	foreach (sort grep(!/^[ns]$/,keys %data)) {
		Xchat::print "\002{$_}\002 ".$data{$_} unless ref($data{$_}) eq 'CODE';
	}

	Xchat::print "Functions:";
	Xchat::print "\002{n}\002 - forced linebreak";
	Xchat::print "\002{s:\002text\002}\002 - optional linebreak; when not needed replaced by the text parameter";
	Xchat::print "\002{eval:\002perl expression\002}\002 - just like eval in perl";
	Xchat::print "\002{bar:\002pct\002;\002length\002;\002style_full\002;\002char_full\002;\002style_empty\002;\002char_empty\002}".
	             "\002 - draw a bar; pct sets the amount of bar to fill";
	Xchat::print "\002{bar:\002num1\002;\002num2\002;\002length\002;\002style_full\002;\002char_full\002;\002style_empty\002;".
	             "\002char_empty\002}\002 - same as above, but calculate the percentage as num1/num2.";
	Xchat::print "\002{if:\002condition\002;\002true\002;\002false\002}\002 - return true text if condition is true, false text ".
	             "otherwise";
	Xchat::print "\002{defined:\002variable\002}\002 - return 1 if variable is defined, 0 otherwise; don't enclose variable with ".
	             "{}; for use with {if}";
	Xchat::print "\002{replace:\002from\002;\002to\002;\002text\002}\002 - replace all occurences of from in text with to; from is ".
	             "a regular expression";
	Xchat::print "\002{fmt_size:\002bytes\002;\002si\002}\002 - convert size in bytes to kB/MB/GB; if si is 1, use KiB/MiB/GiB ".
	             "instead";
	Xchat::print "You can nest functions. To use a literal ;, { or } as a function parameter, escape it with \\. To use a { ".
	             "outside a function, use {}.";

	return Xchat::REMOVE;
}

sub command_hook
{
	my $args = $_[1][1];

	if (!defined($args)) {

		brag(1);

	} elsif ($args =~ /^vars$/) {

		show_vars();

	} elsif ($args =~ /^(?:help|\?)$/) {

		show_help();

	} elsif ($args =~ /^set\s+(?:(\w+)\s+)?(.*)$/) {

		my $which = $1;
		$which = 'default' unless defined $which;

		$template{$which} = $2;
		Xchat::print "Template $which set to ".de_code($template{$which},0);
		save_settings();

	} elsif ($args =~ /^get(?:\s+(\d))?$/) {

		Xchat::print "Templates:";
		foreach my $key (keys %template) {
			if ($1) {
				Xchat::print "$key: ".de_code($template{$key},$1 - 1);
			} else {
				Xchat::print "$key: ".$template{$key};
			}
		}
		Xchat::print "Split: ".$split;

	} elsif ($args =~ /^reset$/) {

		$template{default} = DEFAULT_TEMPLATE;
		Xchat::print "Default template reset to ".de_code($template{default},0);
		save_settings();

	} elsif ($args =~ /^test (.*)$/) {

		test($1);

	} elsif ($args =~ /^split\s+(\d+)$/) {

		$split = $1;
		save_settings();

	} elsif ($args =~ /^view(?:\s(.+))?$/) {

		brag(0,$1);

	} elsif ($args =~ /^del(?:\s(\w+))?$/) {

		if (defined($1)) {
			if ($1 ne 'default') {
				if (exists($template{$1})) {
					delete $template{$1};
				} else {
					Xchat::print "Template $1 doesn't exist.";
				}
			} else {
				$template{default} = DEFAULT_TEMPLATE;
				Xchat::print "Default template reset to ".de_code($template{default},0);
			}
		} else {
			Xchat::print "You need to specify the id of template you wish to delete.";
		}
		save_settings();

	} else {

		brag(1,$args);

	}

	return Xchat::EAT_ALL;
}

##
# tmr_gather_data: gather periodic data for things like network troughput
#
sub tmr_gather_data
{
	my %data;

	get_net(%data);

	push @timed_data,{%data};

	if (@timed_data > 10) { #keep data for the last 10 seconds
		splice @timed_data,0,1;
	}

	return Xchat::KEEP;
}