Make sure local_context() runs the code only when the context was found
[perl/scripts/xchat.git] / 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;