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