package Xchat::VPIT::Tools;

use strict;
use warnings;

use Data::Dumper;
use Encode qw<encode>;

use Xchat qw<:all>;

use lib get_info 'xchatdir';
use Xchat::XPI;
use Xchat::XPI::Utils qw<save_context>;

use constant MAX_MATCHES => 10;

our $VERSION = '0.05';

my $ph;

BEGIN {
 $Data::Dumper::Indent = 1;
 $Data::Dumper::Sortkeys = 1;
}

hook_command 'TC', sub {
 my $guard = save_context;
 for (get_list 'channels') {
  set_context $_->{context};
  command 'GUI COLOR 0';
 }
 return EAT_ALL;
}, {
 help_text => 'TC, reset all tab color indicators'
};

sub d { return Dumper @_; }
sub dp { print $ph Dumper(@_), "\n" }

sub warneval { print $ph 'Warning: ' . (join ' ', @ _) }

hook_command 'PERL', sub  {
 return EAT_ALL unless defined $_[0][1];
 if ($_[0][1] eq '-o') {
  return EAT_ALL unless defined $_[1][2];
  local $SIG{__WARN__} = \&warneval;
  my @result = grep defined, (eval $_[1][2]);
  local $SIG{__WARN__} = 'DEFAULT';
  if ($@) {
   chomp $@;
   print $ph "Error: $@\n";
  } elsif (@result) {
   command join ' ', 'MSG', get_info('channel'), @result;
  } else {
   print $ph "No output\n";
  }
 } else {
  local $SIG{__WARN__} = \&warneval;
  my @result = eval $_[1][1];
  local $SIG{__WARN__} = 'DEFAULT';
  if ($@) {
   chomp $@;
   print $ph "Error: $@\n";
   return EAT_ALL;
  }
  @result = ('(empty)') unless @result;
  my ($c, @scalars) = (0);
  my @refs = grep {
      (defined || (push @scalars, '(undef)') && 0)
   && (ref || (push @scalars, $_) && 0)
   && ((push @scalars, '$REF' . ++$c) || 1)
  } @result;
  {
   local $Data::Dumper::Varname = 'REF';
   print $ph 'Return: ', (join ' | ', @scalars), "\n", d @refs;
  }
 }
 return EAT_ALL;
}, {
 help_text => 'PERL [-o] <perlexp>, evalute the expression with Perl'
};

hook_command 'URIESCAPE', sub {
 return EAT_ALL unless defined $_[0][1];
 my ($uri, $out, $protect);
 if ($_[0][1] eq '-o') {
  $uri = $_[1][2];
  $out = 1;
 } elsif ($_[0][1] eq '-p') {
  $uri = $_[1][2];
  $protect = 1;
 } else {
  $uri = $_[1][1];
 }
 $uri = encode get_info('charset'), $uri;
 $uri =~ s/([^A-Za-z0-9\-_.!~*'():\/])/sprintf("%%%02X",ord($1))/ge;
 if ($out) {
  command 'SAY ' . $uri;
 } else {
  $uri =~ s/%/%%/g if $protect;
  print $ph $uri, "\n";
 }
 return EAT_ALL;
}, {
 help_text => 'URIESCAPE [-o|-p] <uri>, escape unsafe characters in the URI'
};

hook_command 'WIDE', sub {
 my $txt = $_[1][1];
 return EAT_ALL unless defined $txt;
 $txt =~ s/([\x21-\x7e])/chr 0xfee0 + ord $1/ge;
 command 'SAY ' . $txt;
 return EAT_ALL;
}, {
 help_text => 'WIDE <text>, say text in wide unicode characters'
};

hook_command 'HGREP', sub {
 my $txt = $_[1][1];
 return EAT_ALL unless defined $txt;
 $txt = qr/$txt/i;
 my @matches;
 for (get_list 'users') {
  my $host = $_->{host};
  next unless $host =~ /$txt/;
  push @matches, [ $_->{nick}, $host ];
 }
 my $nbr = @matches;
 print $ph ($nbr == 0 ? 'No' : $nbr)
           . ' match' . ('es' x ($nbr > 1))
           . ' to ' . $txt;
 if (@matches < MAX_MATCHES) {
  print $ph +(':' x ($nbr > 0)) . "\n";
  print $ph "\002$_->[0]\002 ($_->[1])\n" for @matches;
 } else {
  print $ph " (too many of them, omitted)\n";
 }
 return EAT_ALL;
}, {
 help_text => 'HGREP <text>, print users in the current context whose hostname matches text'
};

$ph = Xchat::XPI->new(
 name   => 'Misc tools',
 tag    => 'Tools',
 desc   => 'Perl interpretor, URI escaper',
 author => 'Vincent Pit (VPIT)',
 email  => 'perl@profvince.com',
 url    => 'http://www.profvince.com',
);

1;
