package Xchat::VPIT::Tools; use strict; use warnings; use Data::Dumper; use Encode qw; use Xchat qw<:all>; use lib get_info 'xchatdir'; use Xchat::XPI; 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 $oldctxt = get_context; for (get_list 'channels') { set_context $_->{context}; command 'GUI COLOR 0'; } set_context $oldctxt; 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] , 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] , 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 , 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 , 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;