From: Vincent Pit <vince@profvince.com>
Date: Thu, 11 Sep 2008 21:14:27 +0000 (+0200)
Subject: Initial import
X-Git-Url: http://git.vpit.fr/?p=perl%2Fscripts%2Fxchat.git;a=commitdiff_plain;h=263b6777b90548951a13bd56419fa911b010eb9b

Initial import
---

263b6777b90548951a13bd56419fa911b010eb9b
diff --git a/Xchat/XPI.pm b/Xchat/XPI.pm
new file mode 100644
index 0000000..f71bb1e
--- /dev/null
+++ b/Xchat/XPI.pm
@@ -0,0 +1,164 @@
+package Xchat::XPI;
+
+use strict;
+use warnings;
+
+use Tie::RefHash;
+
+use Xchat;
+
+our $VERSION = '0.03';
+
+use constant { COLOR_TAG => "\00307" };
+
+sub new {
+ my $class = shift;
+ $class = ref($class) || $class || return;
+ return if @_ % 2;
+ my %opts = @_;
+
+ my $caller = (caller 0)[0];
+ $opts{tag}     ||= ($caller =~ /([^:]*):*$/) ? $1 : 'UNKNOWN';
+ $opts{name}    ||= $opts{tag};
+ $opts{desc}    ||= $opts{name};
+ $opts{version} ||= do { no strict 'refs'; ${$caller.'::VERSION'} }
+                || '0.01';
+
+ my $email = $opts{email};
+ $email = '<' . $email . '>' if defined $email;
+ my $desc = join ', ', grep defined, $opts{author}, $email, $opts{url};
+ $desc = ' (' . $desc . ')' if length $desc;
+ $opts{banner} = $opts{desc} . $desc;
+
+ my $ph = bless \do { local *PH }, $class;
+ tie *$ph, $ph, @_;
+
+ *$ph->{$_}  = $opts{$_} for qw/tag name version desc author email url banner/;
+ *$ph->{buf} = '';
+
+ Xchat::register(@opts{qw/name version banner/}, sub {
+  $ph->flush;
+  if (*$ph->{atexit_id}) {
+   my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
+                    keys %{*$ph->{atexit}};
+   $_->($ph) for @callbacks;
+  }
+  undef $ph;
+ });
+ $ph->add_atexit($opts{unload}) if $opts{unload};
+
+ $ph->print("\002", $ph->name, ' v', $ph->version,
+            " loaded\002 (", $ph->banner, ")\n");
+
+ return $ph;
+}
+
+sub tag {
+ my $ph = shift;
+ return unless $ph;
+ return *$ph->{tag};
+}
+
+sub name {
+ my $ph = shift;
+ return unless $ph;
+ return *$ph->{name};
+}
+
+sub version {
+ my $ph = shift;
+ return unless $ph;
+ return *$ph->{version};
+}
+
+sub desc {
+ my $ph = shift;
+ return unless $ph;
+ return *$ph->{desc};
+}
+
+sub author {
+ my $ph = shift;
+ return unless $ph;
+ return *$ph->{author};
+}
+
+sub email {
+ my $ph = shift;
+ return unless $ph;
+ return *$ph->{email};
+}
+
+sub url {
+ my $ph = shift;
+ return unless $ph;
+ return *$ph->{url};
+}
+
+sub banner {
+ my $ph = shift;
+ return unless $ph;
+ return *$ph->{banner};
+}
+
+sub print {
+ my $ph = shift;
+ return unless $ph;
+ my $ret  = 0;
+ my $data = join '', *$ph->{buf},
+                     grep defined,
+                      (@_) ? @_ : ((defined) ? $_ : '');
+ while ((my $i = index $data, "\n") >= 0) {
+  Xchat::print(COLOR_TAG . $ph->tag . "\t" . (substr $data, 0, ($i + 1), ''));
+  $ret = 1;
+ }
+ *$ph->{buf} = $data;
+ return $ret;
+}
+
+sub printf { shift->print(sprintf @_) }
+
+sub flush {
+ my ($ph) = @_;
+ return unless $ph;
+ $ph->print("\n") if length $ph->{buf};
+}
+
+sub add_atexit {
+ my ($ph, $callback) = @_;
+ return unless $ph && $callback && ref $callback eq 'CODE';
+ if (!*$ph->{atexit_id}) {
+  tie my %h, 'Tie::RefHash';
+  *$ph->{atexit} = \%h;
+ }
+ return *$ph->{atexit}{$callback} = ++*$ph->{atexit_id};
+}
+
+sub remove_atexit {
+ my ($ph, $callback) = @_;
+ return unless $ph && $callback;
+ if (exists *$ph->{atexit}{$callback}) {
+  delete *$ph->{atexit}{$callback};
+  return 1;
+ }
+ return 0;
+}
+
+sub TIEHANDLE {
+ my $ph = shift;
+ ((defined $ph && $ph->isa(__PACKAGE__))
+  ? $ph
+  : shift->new(@_));
+}
+
+sub PRINT { shift->print(@_) }
+
+sub PRINTF { shift->printf(@_) }
+
+my $ph = new __PACKAGE__, name   => 'Extended Xchat Perl Interface',
+                          desc   => 'Adds extended support for Perl scripts',
+                          author => 'Vincent Pit (VPIT)',
+                          email  => 'perl@profvince.com',
+                          url    => 'http://www.profvince.com';
+
+1;
diff --git a/Xchat/XPI/Events.pm b/Xchat/XPI/Events.pm
new file mode 100644
index 0000000..b26f784
--- /dev/null
+++ b/Xchat/XPI/Events.pm
@@ -0,0 +1,64 @@
+package Xchat::XPI::Events;
+
+use strict;
+use warnings;
+
+use Xchat qw/:all/;
+
+use lib get_info 'xchatdir';
+use Xchat::XPI;
+
+use constant {
+ DEFAULT_DELAY => 1000
+};
+
+our $VERSION = '0.03';
+
+my $ph;
+
+sub delay {
+ my $d = shift;
+ $d = (defined $d) ? int $d : DEFAULT_DELAY;
+ return hook_timer $d, sub {
+  my ($cb, $data) = @{$_[0]};
+  &$cb($data);
+  return REMOVE;
+ }, { data => \@_ };
+}
+
+my %reorder;
+
+sub filter {
+ return unless @_ == 3;
+ not defined and return for @_;
+ my ($cb, $to) = @_[1, 2];
+ return hook_print $_[0], sub {
+  my @args = @{$_[0]};
+  if ($cb->(@args)) {
+   $reorder{$to}->(@args) if exists $reorder{$to};
+   emit_print $to, @args;
+   return EAT_ALL;
+  } else {
+   return EAT_NONE;
+  }
+ }
+}
+
+use base qw/Exporter/;
+
+our @EXPORT         = ();
+our %EXPORT_TAGS    = (
+ 'funcs'  => [ qw/delay filter/ ],
+ 'consts' => [ qw/DEFAULT_DELAY/ ]
+);
+our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
+$EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
+
+$ph = new Xchat::XPI name   => 'Extended Xchat Perl Interface :: Events',
+                     tag    => 'XPI::Events',
+                     desc   => 'More events handlers',
+                     author => 'Vincent Pit (VPIT)', 
+                     email  => 'perl@profvince.com',
+                     url    => 'http://www.profvince.com';
+
+1;
diff --git a/Xchat/XPI/Net.pm b/Xchat/XPI/Net.pm
new file mode 100644
index 0000000..56cd68f
--- /dev/null
+++ b/Xchat/XPI/Net.pm
@@ -0,0 +1,127 @@
+package Xchat::XPI::Net;
+
+use strict;
+use warnings;
+
+use IO::Socket::INET;
+
+use Net::DNS;
+
+use Xchat qw/:all/;
+
+use lib get_info 'xchatdir';
+use Xchat::XPI qw/register init/;
+
+our $VERSION = '0.02';
+
+my ($ph, $res);
+
+BEGIN {
+ $res = Net::DNS::Resolver->new;
+
+ my $timeout = 5;
+ $res->tcp_timeout($timeout);
+ $res->udp_timeout($timeout);
+
+ my $nameservers = '';
+ $res->nameservers( [ split ' ', $nameservers ] ) if $nameservers;
+}
+
+sub resolve {
+ my ($host, $callback) = @_[0, 1];
+ return unless $host && $callback;
+ my $args = $_[2];
+ my $sock = $res->bgsend($host);
+ return unless $sock;
+ $sock->autoflush(1);
+ my $hook = Xchat::hook_fd($sock, \&_dns_recv, { flags => FD_READ, data => [ $callback, $args ] } );
+ return $hook;
+}
+
+sub _dns_recv {
+ my $fd = $_[0];
+ my ($callback, $args) = @{$_[2]};
+ my $p = $res->bgread($fd);
+ $fd->shutdown(2);
+ close $fd;
+ undef $fd;
+ &$callback($p, $args);
+ return REMOVE;
+}
+
+my %whois_servers = (
+ domain => {
+  default => 'whois.internic.net',
+     arpa => 'whois.arin.net',
+#      mil => 'whois.nic.mil',
+ },
+ ipv4 => { default => 'whois.ripe.net' },
+ ipv6 => { default => 'whois.6bone.net' }
+);
+
+sub whois {
+ my ($host, $callback) = @_[0, 1];
+ return unless $host && $callback;
+ my $args = $_[2];
+ my $server;
+ if ($host =~ /^\s*\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(\/\d{1,2})?$/) {
+  $server = $whois_servers{ipv4}{default};
+ } elsif ($host =~ /^\s*[\d:]*(\/\d{1,2})?\s*$/) {
+  $server = $whois_servers{ipv6}{default};
+ } elsif ($host =~ /([^\.]+)\.+([a-z]+)\.*$/) {
+  $host = $1.'.'.$2;
+  $server = $whois_servers{domain}{$2};
+  $server = $whois_servers{domain}{default} if !$server;
+ }
+ return unless $server;
+ my $hook;
+
+# resolve($server, \&_whois_send, [ \$hook, $host, $callback, $args ] );
+# return \$hook;
+#}
+#
+#sub _whois_send {
+# my $p = $_[0];
+# my @a = grep { $_->type eq 'A' && $_->address } $p->answer;
+# return unless @a;
+# my ($hookref, $host, $callback, $args) = @{$_[1]};
+# my $server = $a[rand(@a)]->address;
+
+ my $sock = IO::Socket::INET->new(
+  PeerAddr => $server,
+  PeerPort => 43,
+  Proto => 'tcp'
+ ) or return;
+ $sock->autoflush(1);
+ print $sock "$host\x0D\x0A";
+ $sock->shutdown(1); # stop writing
+ $hook = Xchat::hook_fd($sock, \&_whois_recv, { flags => FD_READ, data => [ $callback, $args ] } );
+ return $hook;
+}
+
+sub _whois_recv {
+ my $fd = $_[0];
+ my ($callback, $args) = @{$_[2]};
+ my $raw = do { local $/; <$fd>; };
+ $fd->shutdown(2);
+ close $fd;
+ undef $fd;
+ &$callback($raw, $args);
+ return REMOVE;
+}
+
+use base qw/Exporter/;
+
+our @EXPORT         = ();
+our %EXPORT_TAGS    = ('funcs' => [ qw/resolve whois/ ]);
+our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
+$EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
+
+$ph = new Xchat::XPI name   => 'Extended Xchat Perl Interface :: Net',
+                     tag    => 'XPI::Net',
+                     desc   => 'Asynchronous network tools',
+                     author => 'Vincent Pit (VPIT)',
+                     email  => 'perl@profvince.com',
+                     url    => 'http://www.profvince.com';
+
+1;
diff --git a/Xchat/XPI/Utils.pm b/Xchat/XPI/Utils.pm
new file mode 100644
index 0000000..1cb3ade
--- /dev/null
+++ b/Xchat/XPI/Utils.pm
@@ -0,0 +1,39 @@
+package Xchat::XPI::Utils;
+
+use strict;
+use warnings;
+
+use Xchat qw/:all/;
+
+use lib get_info 'xchatdir';
+use Xchat::XPI qw/register init/;
+ 
+our $VERSION = '0.01';
+
+my $ph;
+
+sub dye_nick {
+ my ($nick, $col) = ($_[0], 0);
+ $col += ord for split //, $nick;
+ my @rcolors = (nickcmp(get_info('version'), '2.4.0') < 0)
+               ? (3, 4, 6, 8, 9, 10, 11, 12, 13)
+               : (19, 20, 22, 24, 25, 26, 27, 28, 29);
+ $col %= @rcolors;
+ return sprintf "\003%d%s", $rcolors[$col], $nick;
+}
+
+use base qw/Exporter/; 
+ 
+our @EXPORT         = ();
+our %EXPORT_TAGS    = ('funcs' => [ qw/dye_nick/ ]);
+our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
+$EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
+ 
+$ph = new Xchat::XPI name   => 'Extended Xchat Perl Interface :: Utils',
+                     tag    => 'XPI::Utils',
+                     desc   => 'Utility functions',
+                     author => 'Vincent Pit (VPIT)',
+                     email  => 'perl@profvince.com',
+                     url    => 'http://www.profvince.com';
+
+1;
diff --git a/clones.pl b/clones.pl
new file mode 100755
index 0000000..a8b01fb
--- /dev/null
+++ b/clones.pl
@@ -0,0 +1,267 @@
+package Xchat::VPIT::Clones;
+
+use strict;
+use warnings;
+
+use Scalar::Util qw/dualvar/;
+
+use Xchat qw/:all/;
+
+use lib get_info 'xchatdir';
+use Xchat::XPI;
+use Xchat::XPI::Events qw/delay/;
+
+use constant {
+ JOIN_DELAY => 1000,
+ PRE  => ' ',
+ POST => "\n"
+};
+
+our $VERSION = '0.04';
+
+my ($ph, %users, %fetched);
+my $extractor = PRE . '(.+?)' . POST;
+$extractor = qr/$extractor/;
+
+sub clone_enter_str {
+ my ($host, $nick, $clones) = @_;
+ my @clones = $clones =~ /$extractor/g;
+ return "\002$nick\002 ($host) is a clone of : \002@clones\002\n";
+}
+
+sub clone_leave_str {
+ my ($host, $nick, $clones) = @_;
+ my @clones = $clones =~ /$extractor/g;
+ return "\002$nick\002 ($host) has "
+                       . int($clones) . ' clone' . ($clones > 1 ? 's' : '')
+                       . " left : \002@clones\002\n";
+}
+
+sub clone_list_str {
+ my ($host, $clones) = @_;
+ my @clones = $clones =~ /$extractor/g;
+ return "Clones ($host) : \002@clones\002\n";
+}
+
+sub host {
+ my $userhost = lc $_[0];
+ my ($host) = $userhost =~ /@([^@]+)$/;
+ return $host || $userhost;
+}
+
+sub add {
+ my ($nick, $host, $serv, $chan) = @_;
+ my $hosts = $users{$serv}{$chan};
+ $users{$serv}{$chan} = $hosts = { } if not defined $hosts;
+ my $clones = $hosts->{$host};
+ $nick = PRE . $nick . POST;
+ if (defined $clones) {
+  if ((index $clones, $nick) < $[) {
+   $hosts->{$host} = dualvar int($clones) + 1, $clones . $nick;
+  }
+ } else {
+  $clones = dualvar 0, '';
+  $hosts->{$host} = dualvar 1, $nick;
+ }
+ return $clones;
+}
+
+sub remove {
+ my ($nick, $host, $serv, $chan) = @_;
+ my $hosts = $users{$serv}{$chan};
+ return 0 unless $hosts;
+ my $clones = $hosts->{$host};
+ return 0 unless $clones;
+ $nick = PRE . $nick . POST;
+ if ((my $off = index $clones, $nick) >= $[) {
+  my $count = int $clones;
+  if ($count > 1) {
+   substr $clones, $off, length $nick, '';
+   return $hosts->{$host} = dualvar $count - 1,
+                                    $clones;
+  } else {
+   delete $hosts->{$host};
+  }
+ }
+ return 0;
+}
+
+sub replace {
+ my ($old, $new, $host, $serv, $chan) = @_;
+ my $hosts = $users{$serv}{$chan};
+ $users{$serv}{$chan} = $hosts = { } unless defined $hosts;
+ my $clones = $hosts->{$host};
+ ($old, $new) = map { PRE . $_ . POST } $old, $new;
+ if (defined $clones && (my $off = index $clones, $old) >= $[) {
+  my $count = int $clones;
+  substr $clones, $off, length $old, '';
+  $hosts->{$host} = dualvar $count, $clones . $new;
+ } else {
+  $hosts->{$host} = dualvar 1, $new;
+ }
+}
+
+sub scan {
+ my ($serv, $chan) = @_;
+ return unless $fetched{$serv}{$chan};
+ my $hosts = $users{$serv}{$chan};
+ my $count = 0;
+ while (my ($host, $clones) = each %$hosts) {
+  if ($clones > 1) {
+   ++$count;
+   print $ph clone_list_str $host, $clones;
+  }
+ }
+ return $count;
+}
+
+sub flush {
+ my ($serv, $chan) = @_;
+ return 0 unless $serv && $chan && $fetched{$serv}{$chan};
+ delete $users{$serv}{$chan};
+ delete $users{$serv} unless keys %{$users{$serv}};
+ delete $fetched{$serv}{$chan};
+ delete $fetched{$serv} unless keys %{$fetched{$serv}};
+ return 1;
+}
+
+sub fetch {
+ my ($serv, $chan) = @_;
+ my @users = grep { defined $_->{host} and length $_->{host} }
+              get_list 'users';
+ if (@users) {
+  add $_->{nick}, host($_->{host}), $serv, $chan for @users;
+  $fetched{$serv}{$chan} = 1;
+ }
+ return scalar @users;
+}
+
+hook_server '315', sub { # WHO end
+ my $serv = get_info 'server';
+ my $chan = lc $_[0][3];
+ return EAT_NONE if $fetched{$serv}{$chan};
+ my $oldctxt = get_context;
+ set_context $chan, $serv or return EAT_NONE;
+ fetch $serv, $chan;
+ scan $serv, $chan;
+ set_context $oldctxt;
+ return EAT_NONE;
+};
+
+# On join, the who finishes sometimes before the tab opens, so the scan result
+# isn't always displayed in the proper context. Hence the delay()
+
+hook_server 'JOIN', sub {
+ my ($nick, $userhost) = ($_[0][0] =~ /^:([^!]+)!(.*)/);
+ my $serv = get_info 'server';
+ my $chan = lc substr $_[0][2], 1; # starts with colon
+ my $clones = add $nick, host($userhost), $serv, $chan;
+ if ($clones > 0) {
+  my $oldctxt = get_context;
+  if (set_context $chan, $serv) {
+   print $ph clone_enter_str $userhost, $nick, $clones;
+   set_context $oldctxt;
+  } else {
+   delay JOIN_DELAY, sub {
+    my $oldctxt = get_context;
+    return unless set_context $chan, $serv;
+    print $ph clone_enter_str $userhost, $nick, $clones;
+    set_context $oldctxt;
+   };
+  }
+ }
+ return EAT_NONE;
+};
+
+hook_server 'KICK', sub {
+ my $nick = $_[0][3];
+ my $serv = get_info 'server';
+ my $chan = lc $_[0][2];
+ if (nickcmp get_info('nick'), $nick) {
+  my $userinfo = user_info $nick;
+  return EAT_NONE unless $userinfo;
+  my $userhost = $userinfo->{host};
+  my $clones = remove $nick, host($userhost), $serv, $chan;
+  print $ph clone_leave_str $userhost, $nick, $clones if $clones > 0;
+ } else {
+  flush $serv, $chan;
+ }
+ return EAT_NONE;
+};
+
+hook_server 'PART', sub {
+ my ($nick, $userhost) = ($_[0][0] =~ /^:([^!]+)!(.*)/);
+ my $serv = get_info 'server';
+ my $chan = lc $_[0][2];
+ if (nickcmp get_info('nick'), $nick) {
+  my $clones = remove $nick, host($userhost), $serv, $chan;
+  print $ph clone_leave_str $userhost, $nick, $clones if $clones > 0;
+ } else {
+  flush $serv, $chan;
+ }
+ return EAT_NONE;
+};
+
+hook_server 'QUIT', sub {
+ my ($nick, $userhost) = ($_[0][0] =~ /^:([^!]+)!(.*)/);
+ my $serv = get_info 'server';
+ my @chans = map { [ lc $_->{channel}, $_->{context} ] }
+              grep { $_->{type} eq 2 && $_->{server} eq $serv }
+               get_list 'channels';
+ if (nickcmp get_info('nick'), $nick) {
+  my $oldctxt = get_context;
+  my $host = host $userhost;
+  for (@chans) {
+   my $clones = remove $nick, $host, $serv, $_->[0];
+   if ($clones > 0) {
+    set_context $_->[1] or next;
+    print $ph clone_leave_str $userhost, $nick, $clones;
+   }
+  }
+  set_context $oldctxt;
+ } else {
+  flush $serv, $_->[0] for @chans;
+ }
+ return EAT_NONE;
+};
+
+hook_print 'Disconnected', sub {
+ my %servers = map { $_->{server} => 1 }
+                grep { $_->{flags} & 9 && not $_->{flags} & 2 }
+                 get_list 'channels';
+ delete $users{$_} for grep { !$servers{$_} } keys %users;
+ delete $fetched{$_} for grep { !$servers{$_} } keys %fetched;
+ return EAT_NONE;
+};
+
+sub nick_cb {
+ my ($old, $new) = @{$_[0]};
+ my $userinfo = user_info $new;
+ replace $old => $new, host($userinfo->{host}),
+                       get_info('server'), lc get_info('channel') if $userinfo;
+ return EAT_NONE;
+}
+
+hook_print $_, \&nick_cb for ('Change Nick', 'Your Nick Changing');
+
+hook_command 'CLSCAN', sub {
+ my ($serv, $chan) = (get_info('server'), lc get_info('channel'));
+ if (!$fetched{$serv}{$chan} && !fetch($serv, $chan)) {
+  print $ph "Data still not available\n";
+ } elsif (!scan($serv, $chan)) {
+  print $ph "No clones found\n";
+ }
+ return EAT_ALL;
+}, {
+ help_text => 'Scan for clones in the current channel'
+};
+
+$ph = new Xchat::XPI name   => 'Clones scanner',
+                     tag    => 'Clones',
+                     desc   => 'Automatic & on-demand clones scanner',
+                     author => 'Vincent Pit (VPIT)',
+                     email  => 'perl@profvince.com',
+                     url    => 'http://www.profvince.com',
+                     unload => sub { undef %users };
+
+1;
diff --git a/hl.pl b/hl.pl
new file mode 100755
index 0000000..c2f32b9
--- /dev/null
+++ b/hl.pl
@@ -0,0 +1,50 @@
+package Xchat::VPIT::Highlight;
+
+use strict;
+use warnings;
+
+use Xchat qw/:all/;
+
+use lib get_info 'xchatdir';
+use Xchat::XPI;
+use Xchat::XPI::Events qw/filter/;
+
+our $VERSION = '0.02';
+
+my $ph;
+
+sub guihl {
+ command 'GUI FLASH';
+ command 'GUI COLOR 3';
+}
+
+hook_print 'Private Message to Dialog', sub { guihl; return EAT_NONE };
+
+my %words = (
+ '#cpantesters' => [ qw/Linux-SysInfo MorseSignals Regexp-Wildcards Scalar-Vec-Util Sub-Prototype-Util Test-Valgrind Variable-Magic with- B-RecDeparse Sub-Nary indirect- subs-auto/ ]
+);
+
+for (keys %words) {
+ my $rx = '(?:' . (join '|', @{$words{$_}}) . ')';
+ $words{$_} =  qr/$rx/;
+}
+
+filter 'Channel Action' => sub {
+ my $chan = lc get_info 'channel';
+ if ($words{$chan} and $_[1] =~ /$words{$chan}/) {
+  guihl;
+  1;
+ } else {
+  0;
+ }
+} => 'Channel Action Hilight';
+
+$ph = new Xchat::XPI name   => 'Smart highlighting',
+                     tag    => 'HL',
+                     desc   => 'Highlight on private messages',
+                     author => 'Vincent Pit (VPIT)',
+                     email  => 'perl@profvince.com',
+                     url    => 'http://www.profvince.com';
+ 
+1;
+
diff --git a/mpd.pl b/mpd.pl
new file mode 100755
index 0000000..440fea7
--- /dev/null
+++ b/mpd.pl
@@ -0,0 +1,62 @@
+package Xchat::VPIT::MPD;
+
+use strict;
+use warnings;
+
+use Audio::MPD;
+
+use Xchat qw/:all/;
+
+use lib get_info 'xchatdir'; 
+use Xchat::XPI;
+
+our $VERSION = 0.04;
+
+my $ph;
+
+hook_command $_, sub {
+ my $mpd = Audio::MPD->new;
+ unless ($mpd) {
+  print $ph "Couldn't connect to the MPD server\n";
+  return EAT_ALL;
+ }
+
+ my $status = $mpd->status;
+ unless ($status) {
+  print $ph "MPD doesn't seem to be running\n";
+  return EAT_ALL;
+ }
+ if ($status->state eq 'stop') {
+  print $ph "MPD is stopped\n";
+  return EAT_ALL;
+ }
+
+ my $song = $mpd->current;
+ my $title;
+ if ($title = $song->title) {
+  $title = $_ . ' - ' . $title for grep defined, $song->album, $song->artist;
+ } else {
+  $title = $song->file;
+  $title =~ s!\.\w+$!!;
+  $title = $1 if $title =~ m!/([^/]*)$!;
+ }
+
+ my $time = $status->time;
+ my $duration = sprintf '[%d:%02d/%d:%02d]',
+                        $time->sofar_mins, $time->sofar_secs,
+                        $time->total_mins, $time->total_secs;
+ command 'ACTION np: ' . $title . ' ' . $duration;
+
+ return EAT_ALL;
+}, {
+ help_text => "$_, output which song is currently played by mpd"
+} for qw/MPD NP/;
+
+$ph = new Xchat::XPI name   => 'MPD Client',
+                     tag    => 'MPD',
+                     desc   => 'Music Player Daemon client',
+                     author => 'Vincent Pit (VPIT)',
+                     email  => 'perl@profvince.com',
+                     url    => 'http://www.profvince.com';
+
+1;
diff --git a/net.pl b/net.pl
new file mode 100755
index 0000000..eefa83c
--- /dev/null
+++ b/net.pl
@@ -0,0 +1,142 @@
+package Xchat::VPIT::Net;
+
+use strict;
+use warnings;
+
+use List::Util      qw/max/;
+use Locale::Country qw/code2country/;
+
+use Xchat qw/:all/;
+
+use lib get_info 'xchatdir';
+use Xchat::XPI;
+use Xchat::XPI::Net qw/resolve whois/;
+
+our $VERSION = '0.02';
+
+my $ph;
+
+sub parse_url {
+ local $_ = $_[0];
+ return unless defined;
+ my %h = ();
+ if (s/^([^:]*)://) { $h{proto} = lc $1; }
+ ($_, my @path) = grep length, (split m!/!);
+ return unless defined;
+ if (s/:([0-9]*)$// && length $1) { $h{port} = $1; }
+ if (s/(.*)@([^@]*)$/$2/) { ($h{user}, $h{passwd}) = split /:/, $1, 2; }
+ $h{host} = lc;
+ $h{path} = \@path if @path;
+ return \%h;
+}
+
+sub output {
+ my ($motif, $head, @strings) = @_;
+ $head = join ' ', ($motif x 3), $head, ($motif x 3);
+ if (@strings) {
+  my $l = max(map length, @strings) - length($head) - 1; # -1 for CR
+  $head .= ($motif x $l) if $l > 0;
+ }
+ print $ph "\002$head\n", @strings;
+}
+
+hook_command 'DIG', sub {
+ my @reqs = @{$_[0]};
+ shift @reqs;
+ return EAT_ALL unless @reqs;
+ my @users = get_info('users');
+ my $context = get_context;
+ for (@reqs) {
+  my $info = user_info $_;
+  my $req = parse_url($info ? $info->{host} : $_);
+  resolve $req->{host}, \&dig_print, [ $context, $req ];
+ }
+ return EAT_ALL;
+}, {
+ help_text => 'DIG <ip(s)/hostname(s)>, resolve given names/addresses'
+};
+
+sub dig_print {
+ my $p = $_[0];
+ my ($context, $req) = @{$_[1]};
+ my $oldctxt = get_context;
+ set_context $context;
+ if ($p) {
+  my @a = $p->answer;
+  if (@a) {
+   output '-', 'Results for ' . $req->{host},
+             map { $_->string . "\n" } (@a, $p->authority, $p->additional);
+  } else {
+   output '*', 'Resolution failed for ' . $req->{host},
+          map {
+           $_->mname . ' IN SOA ' . $_->rname . "\n", 
+           join ' ', 'serial:' . $_->serial, 'ref:' . $_->refresh,
+                     'ret:' . $_->retry, 'exp:' . $_->expire,
+                     'min:' . $_->minimum . "\n";
+          } grep { $_->type eq 'SOA' } $p->authority;
+  }
+ } else {
+  print $ph 'Request ' . $req->{host} . " timed out\n";
+ }
+ set_context $oldctxt;
+}
+
+hook_command 'NETWHOIS', sub {
+ my @reqs = @{$_[0]};
+ shift @reqs;
+ return EAT_ALL unless @reqs;
+ my $context = get_context;
+ for (@reqs) {
+  my $info = user_info $_;
+  my $req = parse_url($info ? $info->{host} : $_);
+  whois $req->{host}, \&netwhois_print, [ $context, $req ];
+ } 
+ return EAT_ALL; 
+}, {
+ help_text => 'NETWHOIS <ip(s)/hostname(s)>, retrieve domain/ip information'
+};
+
+sub netwhois_print {
+ my $raw = $_[0];
+ my ($context, $req) = @{$_[1]};
+ my $oldctxt = get_context;
+ set_context $context;
+ if ($raw) {
+  $raw =~ s/.*(Domain|inetnum)/$1/s;
+  $raw =~ s/[\r\n]*\>\>\>.*//s;
+  output '-', 'Results for ' . $req->{host},
+         map {
+          s/^\s+//; s/\s+$//;
+          $_ . "\n";
+         } grep { !/^\s*(#|%)/ } split /\r?\n/, $raw;
+ } else {
+  output '*', 'No results for ' . $req->{host};
+ }
+ set_context $oldctxt;
+}
+
+hook_command 'TLD', sub {
+ my @reqs = @{$_[0]};
+ shift @reqs;
+ return EAT_ALL unless @reqs;
+ for (@reqs) {
+  my $info = user_info $_;
+  my $host = parse_url($info ? $info->{host} : $_)->{host};
+  my ($tld) = $host =~ /\.([a-z]+)\.*$/;
+  next unless $tld;
+  my $name = code2country $tld;
+  print $ph $tld . ' is ' . ($name ? $name : 'unknown') . "\n";
+ }  
+ return EAT_ALL;
+}, {
+ help_text => 'TLD <hostname(s)>, give the TLD text representation of the hosts'
+};
+
+$ph = new Xchat::XPI name   => 'Networking tools',
+                     tag    => 'Net',
+                     desc   => 'DNS & Whois clients, TLD names',
+                     author => 'Vincent Pit (VPIT)',
+                     email  => 'perl@profvince.com',
+                     url    => 'http://www.profvince.com';
+
+1;
diff --git a/opers.pl b/opers.pl
new file mode 100755
index 0000000..4ff5c78
--- /dev/null
+++ b/opers.pl
@@ -0,0 +1,99 @@
+package Xchat::VPIT::Opers;
+
+use strict;
+use warnings;
+
+use Xchat qw/:all/;
+
+use lib get_info 'xchatdir';
+use Xchat::XPI;
+
+our $VERSION = '0.03';
+
+my ($ph, %opers);
+
+sub print_op { print $ph "\002$_[0]\002 ($_[1]) \002is an IRC operator\n"; 1 }
+
+hook_server '352', sub {
+ return EAT_NONE unless (rindex $_[0][8], '*') >= 0;
+ my $serv = get_info 'server';
+ my $nick = $_[0][7];
+ if (!$opers{$serv}{$nick}) {
+  $opers{$serv}{$nick} = 1;
+  my $host = $_[0][4].'@'.$_[0][5];
+  my %chans;
+  push @{$chans{$_->{type}}}, $_ for grep { $_->{server} eq $serv }
+                                      get_list 'channels';
+  my $oldctxt = get_context;
+  my $onachan = grep { $_ } map {
+   set_context($_->{context}) && user_info($nick) && print_op($nick, $host)
+  } @{$chans{2}};
+  do {
+   set_context($_->{context}) && print_op($nick, $host)
+  } for ($onachan ? () : @{$chans{1}}),
+                         grep { !nickcmp($_->{channel}, $nick) } @{$chans{3}};
+  set_context $oldctxt;
+ }
+ return EAT_NONE;
+};
+
+hook_print 'Disconnected', sub {
+ my %servers = map { $_->{server} => 1 }
+                grep { $_->{flags} & 9 && not $_->{flags} & 2 }
+                 get_list 'channels';
+ delete $opers{$_} for grep { !$servers{$_} } keys %opers;
+ return EAT_NONE;
+};
+
+hook_server 'QUIT', sub {
+ my ($nick) = ($_[0][0] =~ /^:([^!]+)!/);
+ my $serv = get_info 'server';
+ delete $opers{$serv}{$nick};
+ return EAT_NONE;
+};
+
+sub nick_cb {
+ my ($old, $new) = @{$_[0]};
+ my $ops = $opers{get_info 'server'};
+ if ($ops && $ops->{$old}) {
+  $ops->{$new} = 1;
+  delete $ops->{$old};
+ }
+ return EAT_NONE;
+}
+
+hook_print $_, \&nick_cb for ('Change Nick', 'Your Nick Changing');
+
+hook_command 'OPSCAN', sub {
+ my $serv = get_info 'server';
+ if (!$opers{$serv}) {
+  print $ph "No information for this network yet\n";
+  return EAT_ALL;
+ }
+ my ($chan, $isnet) = (get_info('channel'), 0);
+ for (get_list 'channels') {
+  if ($_->{type} eq 1 && $_->{channel} eq $chan) { $isnet = 1; last; }
+ }
+ my ($name, @ops) = ($isnet) ? ('network', keys %{$opers{$serv}})
+                             : ('channel', map { $_->{nick} }
+                                            grep { $opers{$serv}{$_->{nick}} }
+                                             get_list 'users');
+ if (@ops) {
+  print $ph 'IRC operators on this '.$name." : \002@ops\n";
+ } else {
+  print $ph 'No IRC operators on this '.$name."\n";
+ }
+ return EAT_ALL;
+}, {
+ help_text => 'OPSCAN, scan for IRC operators in the current channel'
+};
+
+$ph = new Xchat::XPI name   => 'Operators',
+                     tag    => 'Opers',
+                     desc   => 'IRC operators scanner',
+                     author => 'Vincent Pit (VPIT)',
+                     email  => 'perl@profvince.com',
+                     url    => 'http://www.profvince.com',
+                     unload => sub { undef %opers; };
+
+1;
diff --git a/services.pl b/services.pl
new file mode 100755
index 0000000..10f4fd4
--- /dev/null
+++ b/services.pl
@@ -0,0 +1,104 @@
+package Xchat::VPIT::Services;
+
+use strict;
+use warnings;
+
+use Xchat qw/:all/;
+
+use lib get_info 'xchatdir';
+use Xchat::XPI;
+
+our $VERSION = '0.03';
+
+my $ph;
+
+sub get_servers_ctxt {
+ my %s;
+ return map $_->{context},
+         grep !$s{$_->{server}}++,
+          sort { $a->{type} <=> $b->{type} }
+           get_list 'channels';
+}
+
+hook_command 'ID', sub {
+ return EAT_PLUGIN if $_[0][1];
+ my $passwd = get_info 'nickserv';
+ return EAT_ALL unless $passwd;
+ command 'ID ' . $passwd;
+ return EAT_ALL;
+}, {
+ help_text => 'ID [password], identify you to NickServ'
+};
+
+hook_command 'AID', sub {
+ my $forcepasswd = $_[0][1];
+ my $oldctxt = get_context;
+ my @contexts = get_servers_ctxt;
+ for (@contexts) {
+  set_context $_;
+  my $passwd = $forcepasswd || get_info 'nickserv';
+  next unless $passwd;
+  command 'ID ' . $passwd;
+ }
+ set_context $oldctxt;
+ return EAT_ALL;
+}, {
+ help_text => 'AID [password], identify you on all servers'
+};
+
+hook_command 'GHOST', sub {
+ return EAT_PLUGIN if $_[0][2];
+ my $target = $_[0][1] || get_prefs 'irc_nick1';
+ my $passwd = get_info 'nickserv';
+ return EAT_ALL unless $target && $passwd;
+ if (nickcmp(get_info('nick'), $target)) {
+  command join ' ', 'GHOST', $target, $passwd;
+ }
+ return EAT_ALL;
+}, {
+ help_text => 'GHOST [nick] [password], kill the client currently connected with your nickname'
+};
+
+hook_command 'AGHOST', sub {
+ my $target = $_[0][1] || get_prefs 'irc_nick1';
+ return EAT_ALL unless $target;
+ my $forcepasswd = $_[0][2];
+ my $oldctxt = get_context;
+ my @contexts = get_servers_ctxt;
+ for (@contexts) {
+  set_context $_;
+  my $passwd = $forcepasswd || get_info 'nickserv';
+  next unless $passwd;
+  if (nickcmp(get_info('nick'), $target)) {
+   command join ' ', 'GHOST', $target, $passwd;
+  }
+ }
+ set_context $oldctxt;
+ return EAT_ALL;
+}, {
+ help_text => 'AGHOST [nick] [password], kill usurping clients on all servers'
+};
+
+sub csmode {
+ my $cmd = join ' ', 'QUOTE CHANSERV', $_[2], get_info('channel');
+ my @targets = @{$_[0]};
+ shift @targets;
+ @targets = (get_info 'nick') unless @targets;
+ command join ' ', $cmd, $_ for @targets;
+ return EAT_ALL;
+}
+
+hook_command "C$_", \&csmode, {
+ data => $_,
+ help_text => join ' ', $_, '[nicks] ,', (lc $_),
+    'the specified targets (or you if none) on the current channel via ChanServ'
+} for map { $_, "DE$_" } qw/VOICE HALFOP OP PROTECT/;
+
+$ph = new Xchat::XPI name   => 'IRC Services',
+                     tag    => 'Services',
+                     desc   => 'Various IRC services helpers',
+                     author => 'Vincent Pit (VPIT)',
+                     email  => 'perl@profvince.com',
+                     url    => 'http://www.profvince.com';
+
+1;
diff --git a/tools.pl b/tools.pl
new file mode 100755
index 0000000..bd98aa3
--- /dev/null
+++ b/tools.pl
@@ -0,0 +1,123 @@
+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;
+
+our $VERSION = '0.04';
+
+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] <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'
+};
+
+$ph = new Xchat::XPI name   => 'Misc tools',
+                     tag    => 'Tools',
+                     desc   => 'Perl interpretor, URI escaper',
+                     author => 'Vincent Pit (VPIT)',
+                     email  => 'perl@profvince.com',
+                     url    => 'http://www.profvince.com';
+
+1;