html/linkchan.pl
1 use strict;
2 use vars qw($VERSION %IRSSI);
3
4 $VERSION = "1.5";
5 %IRSSI =
6 (
7 authors => 'Marcin \'Qrczak\' Kowalczyk',
8 contact => 'qrczak@knm.org.pl',
9 name => 'LinkChan',
10 description => 'Link several channels on serveral networks',
11 license => 'GNU GPL',
12 url => 'http://qrnik.knm.org.pl/~qrczak/irssi/linkchan.pl',
13 );
14
15 our %links;
16 our $lock_own = 0;
17
18 our $config = Irssi::get_irssi_dir . "/linkchan.cfg";
19
20 Irssi::command_bind "link", sub
21 {
22 my ($args, $server, $target) = @_;
23 Irssi::command_runsub "link", $args, $server, $target;
24 };
25
26 Irssi::command_bind "link add", sub
27 {
28 my ($args, $server, $target) = @_;
29 unless ($args =~ m|^ *([^ /]+)/([^ ]+) +([^ /]+)/([^ ]+) *$|)
30 {
31 print CLIENTERROR "Usage: /link add <chatnet1>/<channel1> <chatnet2>/<channel2>";
32 return;
33 }
34 my ($chatnet1, $channel1, $chatnet2, $channel2) =
35 (lc $1, lc $2, lc $3, lc $4);
36 foreach my $link ([$chatnet1, $channel1], [$chatnet2, $channel2])
37 {
38 my ($chat1, $chan1) = @{$link};
39 if ($links{$chat1}{$chan1})
40 {
41 my ($chat2, $chan2) = @{$links{$chat1}{$chan1}};
42 print CLIENTERROR "Channel $chat1/$chan1 is already linked to $chat2/$chan2";
43 return;
44 }
45 }
46 $links{$chatnet1}{$channel1} = [$chatnet2, $channel2];
47 $links{$chatnet2}{$channel2} = [$chatnet1, $channel1];
48 print CLIENTNOTICE "Added link: $chatnet1/$channel1 <-> $chatnet2/$channel2";
49 };
50
51 Irssi::command_bind "link remove", sub
52 {
53 my ($args, $server, $target) = @_;
54 unless ($args =~ m|^ *([^ /]+)/([^ ]+) *$|)
55 {
56 print CLIENTERROR "Usage: /link remove <chatnet>/<channel>";
57 return;
58 }
59 my ($chatnet1, $channel1) = (lc $1, lc $2);
60 unless ($links{$chatnet1}{$channel1})
61 {
62 print CLIENTERROR "Channel $chatnet1/$channel1 was not linked";
63 return;
64 }
65 my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
66 delete $links{$chatnet1}{$channel1};
67 delete $links{$chatnet2}{$channel2};
68 print CLIENTNOTICE "Removed link: $chatnet1/$channel1 <-> $chatnet2/$channel2";
69 };
70
71 Irssi::command_bind "link list", sub
72 {
73 my ($args, $server, $target) = @_;
74 unless ($args =~ /^ *$/)
75 {
76 print CLIENTNOTICE "Usage: /link list";
77 return;
78 }
79 print CLIENTNOTICE "The following pairs of channels are linked:";
80 my %shown = ();
81 foreach my $chatnet1 (sort keys %links)
82 {
83 foreach my $channel1 (sort keys %{$links{$chatnet1}})
84 {
85 next if $shown{$chatnet1}{$channel1};
86 my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
87 print CLIENTNOTICE "$chatnet1/$channel1 <-> $chatnet2/$channel2";
88 $shown{$chatnet2}{$channel2} = 1;
89 }
90 }
91 };
92
93 sub save_config()
94 {
95 open CONFIG, ">$config";
96 foreach my $chatnet1 (keys %links)
97 {
98 foreach my $channel1 (keys %{$links{$chatnet1}})
99 {
100 my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
101 print CONFIG "$chatnet1/$channel1 $chatnet2/$channel2\n";
102 }
103 }
104 close CONFIG;
105 }
106
107 Irssi::signal_add "setup saved", sub
108 {
109 my ($main_config, $auto) = @_;
110 save_config unless $auto;
111 };
112
113 sub load_config()
114 {
115 %links = ();
116 open CONFIG, $config or return;
117 while (<CONFIG>)
118 {
119 chomp;
120 next if /^ *$/ || /^#/;
121 unless (m|^ *([^ /]+)/([^ ]+) +([^ /]+)/([^ ]+) *$|)
122 {
123 print CLIENTERROR "Syntax error in $config: $_";
124 return;
125 }
126 my ($chatnet1, $channel1, $chatnet2, $channel2) =
127 (lc $1, lc $2, lc $3, lc $4);
128 $links{$chatnet1}{$channel1} = [$chatnet2, $channel2];
129 }
130 }
131
132 Irssi::signal_add "setup reread", \&load_config;
133
134 sub message($$)
135 {
136 my ($chan, $msg) = @_;
137 $lock_own = 1;
138 $chan->{server}->command("msg $chan->{name} $msg");
139 $lock_own = 0;
140 }
141
142 sub special_message($$)
143 {
144 my ($chan, $msg) = @_;
145 message $chan, "-!- $msg";
146 }
147
148 sub special_message_for($$$)
149 {
150 my ($chan, $nick, $msg) = @_;
151 message $chan,
152 (defined $nick ? "$nick: " : "") .
153 "-!- $msg";
154 }
155
156 sub channel_context($$)
157 {
158 my ($server1, $channel1) = @_;
159 my $chatnet1 = lc $server1->{chatnet};
160 my $chan1 = $server1->channel_find($channel1) or return undef;
161 my $other = $links{$chatnet1}{lc $channel1} or return undef;
162 my ($chatnet2, $channel2) = @{$other};
163 my $server2 = Irssi::server_find_chatnet($chatnet2) or return;
164 my $chan2 = $server2->channel_find($channel2) or return;
165 return {
166 chatnet1 => $chatnet1,
167 server1 => $server1,
168 channel1 => $channel1,
169 chan1 => $chan1,
170 chatnet2 => $chatnet2,
171 server2 => $server2,
172 channel2 => $channel2,
173 chan2 => $chan2,
174 };
175 }
176
177 sub channel_contexts_with_nick($$)
178 {
179 my ($server1, $nick1) = @_;
180 my $chatnet1 = lc $server1->{chatnet};
181 return () unless $links{$chatnet1};
182 my @contexts = ();
183 foreach my $channel1 (keys %{$links{$chatnet1}})
184 {
185 my $chan1 = $server1->channel_find($channel1) or next;
186 next unless $chan1->nick_find($nick1);
187 my ($chatnet2, $channel2) = @{$links{$chatnet1}{$channel1}};
188 my $server2 = Irssi::server_find_chatnet($chatnet2) or next;
189 my $chan2 = $server2->channel_find($channel2) or next;
190 push @contexts, {
191 chatnet1 => $chatnet1,
192 server1 => $server1,
193 channel1 => $channel1,
194 chan1 => $chan1,
195 chatnet2 => $chatnet2,
196 server2 => $server2,
197 channel2 => $channel2,
198 chan2 => $chan2,
199 };
200 }
201 return @contexts;
202 }
203
204 sub must_be_op($$)
205 {
206 my ($context, $nick) = @_;
207 unless (defined $nick ?
208 $context->{chan1}->nick_find($nick)->{op} :
209 $context->{chan1}->{chanop})
210 {
211 special_message_for $context->{chan1}, $nick,
212 "You're not channel operator in $context->{channel1}";
213 return 0;
214 }
215 unless ($context->{chan2}->{chanop})
216 {
217 special_message_for $context->{chan1}, $nick,
218 "Sorry, I'm not channel operator in $context->{channel2}";
219 return 0;
220 }
221 return 1;
222 }
223
224 sub change_mode($$$)
225 {
226 my ($context, $nick, $mode) = @_;
227 return unless must_be_op($context, $nick);
228 special_message $context->{chan2},
229 "mode/$context->{channel2} [$mode] by $nick"
230 if defined $nick;
231 $context->{server2}->command("mode $context->{channel2} $mode");
232 }
233
234 sub change_perms($$$$$$)
235 {
236 my ($command, $dir, $mode, $context, $nick, $args) = @_;
237 my @nicks = split ' ', $args;
238 unless (@nicks)
239 {
240 special_message_for $context->{chan1}, $nick,
241 "Usage: \\$command <nicks>";
242 return;
243 }
244 change_mode $context, $nick, $dir . $mode x @nicks . " @nicks";
245 }
246
247 sub names($$$)
248 {
249 my ($context, $nick, $args) = @_;
250 my @nicks = $context->{chan2}->nicks();
251 my @ops = grep {$_->{op}} @nicks;
252 my @voices = grep {!$_->{op} && $_->{voice}} @nicks;
253 my @normal = grep {!$_->{op} && !$_->{voice}} @nicks;
254 my @list = (
255 map ({['@', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @ops),
256 map ({['+', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @voices),
257 map ({[' ', $_]} sort {lc $a cmp lc $b} map {$_->{nick}} @normal));
258 my $max_width = 62 - length $context->{server1}->{nick};
259 my $rows = 1;
260 my @column_widths;
261 while ($rows < @list)
262 {
263 @column_widths = ();
264 my $width = 0;
265 my $i = 0;
266 while ($i < @list)
267 {
268 my $column_width = 0;
269 foreach my $j ($i .. $i+$rows-1)
270 {
271 last if $j >= @list;
272 my $len = length $list[$j][1];
273 $column_width = $len if $column_width < $len;
274 }
275 push @column_widths, $column_width;
276 $width += $column_width + 4;
277 $i += $rows;
278 }
279 last if $width - 1 <= $max_width;
280 ++$rows;
281 }
282 my @output;
283 foreach my $i (0..$#list)
284 {
285 $output[$i % $rows] .=
286 sprintf "[%s%*s] ",
287 $list[$i][0], -$column_widths[int ($i / $rows)], $list[$i][1];
288 }
289 foreach my $row (@output)
290 {
291 chop $row;
292 message $context->{chan1}, $row;
293 }
294 }
295
296 my %commands =
297 (
298 mode => sub
299 {
300 my ($context, $nick, $args) = @_;
301 unless ($args =~ /^ +\* +(.*)$/ ||
302 $args =~ /^ +\Q$context->{channel2}\E +(.*)$/)
303 {
304 special_message_for $context->{chan1}, $nick,
305 "Usage: \\mode * <mode> [<mode parameters>]";
306 return;
307 }
308 change_mode $context, $nick, $1;
309 },
310 op => sub {&change_perms('op', '+', 'o', @_)},
311 deop => sub {&change_perms('deop', '-', 'o', @_)},
312 voice => sub {&change_perms('voice', '+', 'v', @_)},
313 devoice => sub {&change_perms('devoice', '-', 'v', @_)},
314 kick => sub
315 {
316 my ($context, $nick, $args) = @_;
317 unless ($args =~ /^ +([^ ]+)(| .*)$/)
318 {
319 special_message_for $context->{chan1}, $nick,
320 "Usage: \\kick <nicks> [<reason>]";
321 return;
322 }
323 my ($nicks, $reason) = ($1, $2);
324 $reason = $reason =~ /^ ?$/ ? " $nick" : " <$nick>$reason"
325 if defined $nick;
326 return unless must_be_op($context, $nick);
327 $context->{server2}->command("kick $context->{channel2} $nicks$reason");
328 },
329 names => \&names,
330 );
331
332 sub run_command($$$$)
333 {
334 my ($context, $nick, $command, $args) = @_;
335 my $func = $commands{lc $command};
336 unless ($func)
337 {
338 special_message_for $context->{chan1}, $nick,
339 "Unknown command: $command";
340 return;
341 }
342 $func->($context, $nick, $args);
343 }
344
345 Irssi::signal_add "message public", sub
346 {
347 my ($server1, $msg, $nick, $address, $channel1) = @_;
348 my $context = channel_context($server1, $channel1) or return;
349 if ($msg =~ /^\\([^ ]+)(| .*)$/)
350 {
351 Irssi::signal_continue @_;
352 run_command $context, $nick, $1, $2;
353 }
354 elsif ($msg =~ /^<.[^ ]+> /)
355 {
356 print CLIENTERROR
357 "Warning! Channels $context->{chatnet1}/$context->{channel1} " .
358 "and $context->{chatnet2}/$context->{channel2} are linked twice.";
359 Irssi::command "beep";
360 }
361 else
362 {
363 my $nk = $context->{chan1}->nick_find($nick);
364 my $perm = $nk->{op} ? '@' : $nk->{voice} ? '+' : ' ';
365 message $context->{chan2}, "<$perm$nick> $msg";
366 }
367 };
368
369 Irssi::signal_add "message own_public", sub
370 {
371 my ($server1, $msg, $channel1) = @_;
372 return if $lock_own;
373 my $context = channel_context($server1, $channel1) or return;
374 if ($msg !~ s/^\\ // && $msg =~ /^\\([^ ]+)(| .*)$/)
375 {
376 Irssi::signal_continue @_;
377 run_command $context, undef, $1, $2;
378 }
379 else
380 {
381 message $context->{chan2}, $msg;
382 }
383 };
384
385 Irssi::signal_add "message irc action", sub
386 {
387 my ($server1, $msg, $nick, $address, $channel1) = @_;
388 my $context = channel_context($server1, $channel1) or return;
389 message $context->{chan2}, " * $nick $msg";
390 };
391
392 Irssi::signal_add "message irc own_action", sub
393 {
394 my ($server1, $msg, $channel1) = @_;
395 return if $lock_own;
396 my $context = channel_context($server1, $channel1) or return;
397 $lock_own = 1;
398 $context->{server2}->command("action $context->{channel2} $msg");
399 $lock_own = 0;
400 };
401
402 Irssi::signal_add "message join", sub
403 {
404 my ($server1, $channel1, $nick, $address) = @_;
405 my $context = channel_context($server1, $channel1) or return;
406 special_message $context->{chan2},
407 "$nick [$address] has joined $channel1";
408 };
409
410 Irssi::signal_add "message part", sub
411 {
412 my ($server1, $channel1, $nick, $address, $reason) = @_;
413 my $context = channel_context($server1, $channel1) or return;
414 special_message $context->{chan2},
415 "$nick [$address] has left $context->{channel1} [$reason]";
416 };
417
418 Irssi::signal_add "message quit", sub
419 {
420 my ($server1, $nick, $address, $reason) = @_;
421 foreach my $context (channel_contexts_with_nick($server1, $nick))
422 {
423 special_message $context->{chan2},
424 "$nick [$address] has quit [$reason]";
425 }
426 };
427
428 Irssi::signal_add "message topic", sub
429 {
430 my ($server1, $channel1, $topic, $nick, $address) = @_;
431 return if $nick eq $server1->{nick};
432 my $context = channel_context($server1, $channel1) or return;
433 if ($topic eq "")
434 {
435 special_message $context->{chan2},
436 "Topic unset by $nick on $context->{channel1}";
437 $context->{server2}->command("topic -delete $context->{channel2}");
438 }
439 else
440 {
441 special_message $context->{chan2},
442 "$nick changed the topic of $context->{channel1} to: $topic";
443 $context->{server2}->command("topic $context->{channel2} $topic");
444 }
445 };
446
447 Irssi::signal_add "message nick", sub
448 {
449 my ($server1, $newnick, $oldnick, $address) = @_;
450 foreach my $context (channel_contexts_with_nick($server1, $newnick))
451 {
452 special_message $context->{chan2},
453 "$oldnick is now known as $newnick";
454 }
455 };
456
457 Irssi::signal_add "message own_nick", sub
458 {
459 my ($server1, $newnick, $oldnick, $address) = @_;
460 foreach my $context (channel_contexts_with_nick($server1, $newnick))
461 {
462 next if $context->{chatnet1} eq $context->{chatnet2};
463 special_message $context->{chan2},
464 "$oldnick is now known as $newnick";
465 }
466 };
467
468 Irssi::signal_add "message kick", sub
469 {
470 my ($server1, $channel1, $nick, $kicker, $address, $reason) = @_;
471 my $context = channel_context($server1, $channel1) or return;
472 special_message $context->{chan2},
473 "$nick was kicked from $context->{channel1} " .
474 "by $kicker [$reason]";
475 };
476
477 Irssi::signal_add "event mode", sub
478 {
479 my ($server1, $data, $nick) = @_;
480 $data =~ /^([^ ]*) (.*)$/ or return;
481 my ($channel1, $mode) = ($1, $2);
482 my $context = channel_context($server1, $channel1) or return;
483 special_message $context->{chan2},
484 "mode/$context->{channel1} [$mode] by $nick";
485 };
486
487 load_config;
488