X-Git-Url: http://git.vpit.fr/?p=perl%2Fscripts%2Fxchat.git;a=blobdiff_plain;f=clones.pl;h=5fb37f07c0090ff8b27888c441cada011ea4e06f;hp=fded636bd38c8aee60a92426d5ddb911972026ab;hb=HEAD;hpb=edd1cbfd1a969e16d8df9988eb448a53c97c02e7 diff --git a/clones.pl b/clones.pl index fded636..5fb37f0 100755 --- a/clones.pl +++ b/clones.pl @@ -10,7 +10,7 @@ use Xchat qw<:all>; use lib get_info 'xchatdir'; use Xchat::XPI; use Xchat::XPI::Events qw; -use Xchat::XPI::Utils qw; +use Xchat::XPI::Utils qw; use constant { JOIN_DELAY => 1000, @@ -18,6 +18,8 @@ use constant { POST => "\n", }; +die 'Invalid PRE/POST' unless irc_lc(PRE . POST) eq PRE . POST; + our $VERSION = '0.04'; my ($ph, %users, %fetched); @@ -53,12 +55,14 @@ sub clone_list_str { sub host { my $userhost = lc $_[0]; - return $userhost =~ /@([^@]+)$/ ? $1 : $userhost; + return $userhost =~ /@([^@]+)$/ ? strip_code($1) : $userhost; } sub add { my ($nick, $host, $serv, $chan) = @_; + $chan = irc_lc $chan; + my $hosts = $users{$serv}{$chan}; $users{$serv}{$chan} = $hosts = { } unless defined $hosts; @@ -66,7 +70,7 @@ sub add { $nick = PRE . $nick . POST; if (defined $clones) { - if (index($clones, $nick) < $[) { + if (index(irc_lc($clones), irc_lc($nick)) < $[) { $hosts->{$host} = dualvar int($clones) + 1, $clones . $nick; } } else { @@ -80,6 +84,9 @@ sub add { sub remove { my ($nick, $host, $serv, $chan) = @_; + $nick = irc_lc $nick; + $chan = irc_lc $chan; + my $hosts = $users{$serv}{$chan}; return 0 unless $hosts; @@ -87,7 +94,7 @@ sub remove { return 0 unless $clones; $nick = PRE . $nick . POST; - if ((my $off = index $clones, $nick) >= $[) { + if ((my $off = index irc_lc($clones), $nick) >= $[) { my $count = int $clones; if ($count > 1) { substr $clones, $off, length $nick, ''; @@ -102,13 +109,16 @@ sub remove { sub replace { my ($old, $new, $host, $serv, $chan) = @_; + $old = irc_lc $old; + $chan = irc_lc $chan; + my $hosts = $users{$serv}{$chan}; $users{$serv}{$chan} = $hosts = { } unless defined $hosts; my $clones = $hosts->{$host}; $_ = PRE . $_ . POST for $old, $new; - if (defined $clones and (my $off = index $clones, $old) >= $[) { + if (defined $clones and (my $off = index irc_lc($clones), $old) >= $[) { my $count = int $clones; substr $clones, $off, length $old, ''; $hosts->{$host} = dualvar $count, $clones . $new; @@ -120,6 +130,8 @@ sub replace { sub scan { my ($serv, $chan) = @_; + $chan = irc_lc $chan; + return unless $fetched{$serv}{$chan}; my $hosts = $users{$serv}{$chan}; @@ -137,7 +149,10 @@ sub scan { sub flush { my ($serv, $chan) = @_; - return 0 unless $serv and $chan and $fetched{$serv}{$chan}; + return 0 unless $serv and $chan; + + $chan = irc_lc $chan; + return 0 unless $fetched{$serv}{$chan}; delete $users{$serv}{$chan}; delete $users{$serv} unless keys %{$users{$serv}}; @@ -158,16 +173,16 @@ sub fetch { add $_->{nick}, host($host), $serv, $chan; ++$users; } - $fetched{$serv}{$chan} = 1 if $users; + $fetched{$serv}{irc_lc($chan)} = 1 if $users; return $users; } hook_server '315', sub { # WHO end my $serv = get_info 'server'; - my $chan = lc $_[0][3]; + my $chan = $_[0][3]; - return EAT_NONE if $fetched{$serv}{$chan}; + return EAT_NONE if $fetched{$serv}{irc_lc($chan)}; local_context $chan, $serv => sub { fetch $serv, $chan; @@ -183,20 +198,18 @@ hook_server '315', sub { # WHO end hook_server 'JOIN', sub { my ($nick, $userhost) = ($_[0][0] =~ /^:([^!]+)!(.*)/); my $serv = get_info 'server'; - my $chan = lc substr $_[0][2], 1; # starts with colon + my $chan = substr $_[0][2], 1; # starts with colon my $clones = add $nick, host($userhost), $serv, $chan; return EAT_NONE unless $clones > 0; - local_context $chan, $serv => sub { + my $printer = sub { print $ph clone_enter_str $userhost, $nick, $clones; 1 - } or do { - delay JOIN_DELAY, sub { - local_context $chan, $serv => sub { - print $ph clone_enter_str $userhost, $nick, $clones; - } - } + }; + + local_context $chan, $serv, $printer or delay JOIN_DELAY, sub { + local_context $chan, $serv, $printer; }; return EAT_NONE; @@ -205,7 +218,7 @@ hook_server 'JOIN', sub { hook_server 'KICK', sub { my $nick = $_[0][3]; my $serv = get_info 'server'; - my $chan = lc $_[0][2]; + my $chan = $_[0][2]; if (nickcmp get_info('nick'), $nick) { my $userinfo = user_info $nick; @@ -226,7 +239,7 @@ hook_server 'KICK', sub { hook_server 'PART', sub { my ($nick, $userhost) = ($_[0][0] =~ /^:([^!]+)!(.*)/); my $serv = get_info 'server'; - my $chan = lc $_[0][2]; + my $chan = $_[0][2]; if (nickcmp get_info('nick'), $nick) { my $clones = remove $nick, host($userhost), $serv, $chan; @@ -241,7 +254,7 @@ hook_server 'PART', sub { hook_server 'QUIT', sub { my ($nick, $userhost) = ($_[0][0] =~ /^:([^!]+)!(.*)/); my $serv = get_info 'server'; - my @chans = map [ lc $_->{channel}, $_->{context} ], + my @chans = map [ $_->{channel}, $_->{context} ], grep { $_->{type} == 2 and $_->{server} eq $serv } get_list 'channels'; @@ -286,7 +299,7 @@ sub nick_cb { # Otherwise, the new nick would be added right now, and the old one would be # when the WHO responses arrives (which may still refer to the old nick). replace $old => $new, host($userhost), - get_info('server'), lc get_info('channel'); + get_info('server'), get_info('channel'); } return EAT_NONE; @@ -296,9 +309,9 @@ hook_print $_, \&nick_cb for 'Change Nick', 'Your Nick Changing'; hook_command 'CLSCAN', sub { my $serv = get_info 'server'; - my $chan = lc get_info 'channel'; + my $chan = get_info 'channel'; - if (!$fetched{$serv}{$chan} and !fetch($serv, $chan)) { + if (!$fetched{$serv}{irc_lc($chan)} and !fetch($serv, $chan)) { print $ph "Data still not available\n"; } elsif (!scan($serv, $chan)) { print $ph "No clones found\n"; @@ -316,7 +329,10 @@ $ph = Xchat::XPI->new( author => 'Vincent Pit (VPIT)', email => 'perl@profvince.com', url => 'http://www.profvince.com', - unload => sub { undef %users }, + unload => sub { + undef %users; + undef %fetched; + }, ); 1;