Make sure local_context() runs the code only when the context was found

[perl/scripts/xchat.git] / clones.pl

diff --git a/clones.pl b/clones.pl
index 46ca4d648815aada8713f28f8c029bbc70d5adcd..5fb37f07c0090ff8b27888c441cada011ea4e06f 100755 (executable)
--- 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<delay>;
-use Xchat::XPI::Utils  qw<save_context local_context>;
+use Xchat::XPI::Utils  qw<irc_lc save_context local_context>;
 
 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,7 +198,7 @@ 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;
@@ -203,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;
@@ -224,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;
@@ -239,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';
 
@@ -284,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;
@@ -294,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";
@@ -314,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;