1use strict; 2use 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 15our %links; 16our $lock_own = 0; 17 18our $config = Irssi::get_irssi_dir . "/linkchan.cfg"; 19 20Irssi::command_bind "link", sub 21{ 22 my ($args, $server, $target) = @_; 23 Irssi::command_runsub "link", $args, $server, $target; 24}; 25 26Irssi::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 51Irssi::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 71Irssi::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 93sub 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 107Irssi::signal_add "setup saved", sub 108{ 109 my ($main_config, $auto) = @_; 110 save_config unless $auto; 111}; 112 113sub 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 132Irssi::signal_add "setup reread", \&load_config; 133 134sub message($$) 135{ 136 my ($chan, $msg) = @_; 137 $lock_own = 1; 138 $chan->{server}->command("msg $chan->{name} $msg"); 139 $lock_own = 0; 140} 141 142sub special_message($$) 143{ 144 my ($chan, $msg) = @_; 145 message $chan, "-!- $msg"; 146} 147 148sub special_message_for($$$) 149{ 150 my ($chan, $nick, $msg) = @_; 151 message $chan, 152 (defined $nick ? "$nick: " : "") . 153 "-!- $msg"; 154} 155 156sub 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 177sub 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 204sub 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 224sub 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 234sub 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 247sub 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 296my %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 332sub 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 345Irssi::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 369Irssi::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 385Irssi::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 392Irssi::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 402Irssi::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 410Irssi::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 418Irssi::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 428Irssi::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 447Irssi::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 457Irssi::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 468Irssi::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 477Irssi::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 487load_config; 488 489