opers.pl

   1 package Xchat::VPIT::Opers;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Xchat qw<:all>;
   7
   8 use lib get_info 'xchatdir';
   9 use Xchat::XPI;
  10
  11 our $VERSION = '0.03';
  12
  13 my ($ph, %opers);
  14
  15 sub print_op { print $ph "\002$_[0]\002 ($_[1]) \002is an IRC operator\n" }
  16
  17 hook_server '352', sub {
  18  return EAT_NONE unless 0 <= rindex $_[0][8], '*';
  19
  20  my $serv = get_info 'server';
  21  my $nick = $_[0][7];
  22  return EAT_NONE if $opers{$serv}{$nick};
  23  $opers{$serv}{$nick} = 1;
  24
  25  my $host = $_[0][4] . '@' . $_[0][5];
  26  my %chans;
  27  push @{$chans{$_->{type}}}, $_ for grep $_->{server} eq $serv,
  28                                      get_list 'channels';
  29
  30  my $oldctxt = get_context;
  31
  32  my $onachan;
  33  for (@{$chans{2}}) {
  34   set_context $_->{context} or next;
  35   user_info   $nick         or next;
  36   print_op    $nick, $host;
  37   ++$onachan;
  38  }
  39
  40  my @opchans;
  41  @opchans = @{$chans{1}} unless $onachan;
  42  push @opchans, grep !nickcmp($_->{channel}, $nick), @{$chans{3}};
  43  for (@opchans) {
  44   set_context $_->{context} or next;
  45   print_op $nick, $host;
  46  }
  47
  48  set_context $oldctxt;
  49
  50  return EAT_NONE;
  51 };
  52
  53 hook_print 'Disconnected', sub {
  54  my %servers;
  55  $servers{$_->{server}} = 1 for grep +($_->{flags} & 0b1011) == 0b1001,
  56                                  get_list 'channels';
  57
  58  delete @opers{grep !$servers{$_}, keys %opers};
  59
  60  return EAT_NONE;
  61 };
  62
  63 hook_server 'QUIT', sub {
  64  my ($nick) = $_[0][0] =~ /^:([^!]+)!/;
  65
  66  my $serv = get_info 'server';
  67  delete $opers{$serv}{$nick};
  68
  69  return EAT_NONE;
  70 };
  71
  72 sub nick_cb {
  73  my ($old, $new) = @{$_[0]};
  74
  75  my $ops = $opers{get_info 'server'};
  76  if ($ops and $ops->{$old}) {
  77   $ops->{$new} = 1;
  78   delete $ops->{$old};
  79  }
  80
  81  return EAT_NONE;
  82 }
  83
  84 hook_print $_, \&nick_cb for 'Change Nick', 'Your Nick Changing';
  85
  86 hook_command 'OPSCAN', sub {
  87  my $serv = get_info 'server';
  88  if (!$opers{$serv}) {
  89   print $ph "No information for this network yet\n";
  90   return EAT_ALL;
  91  }
  92
  93  my $chan  = get_info 'channel';
  94  my $isnet = 0;
  95  for (get_list 'channels') {
  96   if ($_->{type} == 1 and $_->{channel} eq $chan) {
  97    $isnet = 1;
  98    last;
  99   }
 100  }
 101
 102  my ($name, @ops);
 103  if ($isnet) {
 104   $name = 'network';
 105   @ops  = keys %{$opers{$serv}};
 106  } else {
 107   $name = 'channel';
 108   @ops  = map $_->{nick},
 109            grep $opers{$serv}{$_->{nick}},
 110             get_list 'users';
 111  }
 112
 113  if (@ops) {
 114   print $ph "IRC operators on this $name : \002@ops\n";
 115  } else {
 116   print $ph "No IRC operators on this $name\n";
 117  }
 118
 119  return EAT_ALL;
 120 }, {
 121  help_text => 'OPSCAN, scan for IRC operators in the current channel'
 122 };
 123
 124 $ph = Xchat::XPI->new(
 125  name   => 'Operators',
 126  tag    => 'Opers',
 127  desc   => 'IRC operators scanner',
 128  author => 'Vincent Pit (VPIT)',
 129  email  => 'perl@profvince.com',
 130  url    => 'http://www.profvince.com',
 131  unload => sub { undef %opers },
 132 );
 133
 134 1;