#!/usr/bin/perl -w

#   SysNfo - system info script for X-Chat 2
#   Copyright (C) 2007-2009  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:
#
#2009-08-18: 0.1
# - first release, based on sysnfo.pl
#

use strict;
use warnings;
use utf8;

use constant VERSION => '0.1';

use constant DEFAULT_TEMPLATE => "/me is listening to \0033\002{if:{defined:artist};{artist}\00314 -\0033 }".
    "{if:{defined:album};{album}\00314 -\0033 }{title}\00314\002".
    " [{bar:{playback_time};{length};10;\0039;:;\0033;.}\00314] \00315{fmt_time:{playback_time}}\00314/\00315{fmt_time:{length}}";
use constant DEFAULT_FILEVARS => "status artist album title codec bitrate samplerate genre tracknumber totaltracks album_artist ".
    "playback_time length";
use constant DEFAULT_DELIMITER => '\x0A';

my %template = ( default => DEFAULT_TEMPLATE );
my $filevars = DEFAULT_FILEVARS;
my $delimiter = DEFAULT_DELIMITER;
my $split = 400;
my $controlfile;

my @timed_data;

Xchat::print "\002NowPlaying\002 version ".VERSION;

Xchat::register("NowPlaying", VERSION, "Spam what you're plaing");

load_settings();

Xchat::hook_command('np', \&command_hook, {help_text => 'Spam what you\'re plaing'});
Xchat::print "Use \002/np ?\002 for short help";

sub load_settings
{
	my $cf = Xchat::get_info("xchatdir") . '/nowplaying.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 'controlfile') {
			$controlfile = $value;
		} elsif ($name eq 'filevars') {
			$filevars = $value;
		} elsif ($name eq 'delimiter') {
			$delimiter = $value;
		} elsif ($name eq 'split') {
			$split = $value;
		}
	}
	$split = 400 unless $split =~ /^\d+$/;
	close CONF;
}

sub save_settings()
{
	my $cf = Xchat::get_info("xchatdir") . '/nowplaying.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";
	print CONF "controlfile=".$controlfile."\n";
	print CONF "filevars=".$filevars."\n";
	print CONF "delimiter=".$delimiter."\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: replace text with regexps
#
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;

	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}) && $data->{$var} ne '?') {
		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.'}';
			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;
}

##
# f_fmt_time($): Returns human-readable time
#
# $seconds: time in seconds to convert
#
# Return value: time formatted like this: 1 day 02:03:04
sub f_fmt_time($)
{
	my $seconds = shift;

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

	$seconds = int($seconds);

	my ($retstr,$need_hours);
	foreach my $unit ([86400, "day ","days "], [3600, ":"], [60, ":"], [1, ""]) {
		my $tmp = int($seconds / $unit->[0]);
		$seconds -= $tmp * $unit->[0];
		if (defined($unit->[2])) {
			if ($tmp > 1) {
				$retstr .= $tmp . $unit->[2];
			} elsif ($tmp == 1) {
				$retstr .= $tmp . $unit->[1];
			}
			$need_hours = 1;
		} else {
			$retstr .= sprintf('%02d',$tmp) . $unit->[1] unless ($unit->[0] == 3600 && $need_hours);
		}
	}
	
	return $retstr;
}

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

	die "Control file is not defined. Use /np controlfile <path> first!\n" unless defined($controlfile);

	my $d = $delimiter;
	$d = '\x0a' if (!defined($d) || length($d) == 0);
	$d =~ s:\\x([0-9a-fA-F]{2}):chr(hex($1)):eg;

	$filevars =~ s:^\s+|\s+$::g;

	open CF,'<:utf8',$controlfile or die "Error opening control file.";
	local $/;
	$/ = $d;
	foreach my $field (split(/ +/,$filevars)) {
		chomp($data->{$field} = <CF>);
	}
	close CF;
}

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

	my %data;

	grab_info_from_control_file(%data);

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

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

	return %data;
}

sub show_help($)
{
	my $topic = shift;

	my @help;
	if ($topic eq 'filevars') {
		@help = (
			'filevars usage:',
			'/np filevars delimiter field_1[ field_2[...]]',
			'filevars sets the order of variables read from the control file',
			'First parameter is the delimiter used in the file. You can use \xNN (where NN is a hex code) to enter unprintable'
			.' characters. The default delimiter is \x0a. The delimiter does not need to be a single character. Note that the'
			.' delimiter should never appear in any of the fields, as there is no way to escape it.',
			'Remaining parameters set the field names read from the file, which can then be directly used in the formatting'
			.' templates. The field names are limited to letters, numbers and the _ character.',
		);
	} else {
		@help = (
			'Usage:',
			'/np [id] - send now playing to the current chat',
			'/np set [id] <string> - change the formatting string',
			'/np del <id> - delete the formatting string',
			'/np reset - reset the default formatting string',
			'/np get - display the current settings (including formatting templates)',
			'/np get 1 - same as get, but show xchat control codes',
			'/np view - show now playing info locally',
			'/np vars - displays all variables (with their content) and functions available for use with /np set',
			'/np split <number> - maximum line length before it\'s split',
			'/np playerinfo - shows information about configuring your player',
            '/np controlfile [filename] - file from which to read the now playing info',
			'/np filevars - set up reading now playing info from control file (use   /np ? filevars   for more info on filevars)',
			'',
			'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);

	my $action;
	if ($where) {
		if ($out[0] =~ /^\/me /) {
			$out[0] =~ s:^/me ::;
			$action = 1;
		}
		if ($action) {
			Xchat::command 'me '.$_ foreach @out;
		} else {
			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 "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 set_var(\$$)
{
	my ($var,$what) = @_;

	if (!defined($what)) {
		if (defined($$var)) {
			Xchat::print $$var;
		} else {
			Xchat::print "\002not defined";
		}
		return;
	} else {
		$$var = $what;
		Xchat::print "Set to $what";
	}
	save_settings();

}

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

	if (!defined($args)) {

		brag(1);

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

		show_vars();

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

		show_help($1);

	} 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+)$/) {

		set_var($split,$1);

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

		brag(0,$1);

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

		set_var($controlfile,$1);

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

		set_var($delimiter,$1);

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

		set_var($filevars,$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;
}