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 5e385959a4b390729152b24c436adf8e91ed7fe4..5fb37f07c0090ff8b27888c441cada011ea4e06f 100755 (executable)
--- a/clones.pl
+++ b/clones.pl
@@ -10,6 +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<irc_lc save_context local_context>;
 
 use constant {
  JOIN_DELAY => 1000,
@@ -17,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);
@@ -52,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;
 
@@ -65,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 {
@@ -79,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;
 
@@ -86,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, '';
@@ -101,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;
@@ -119,6 +130,8 @@ sub replace {
 sub scan {
  my ($serv, $chan) = @_;
 
+ $chan = irc_lc $chan;
+
  return unless $fetched{$serv}{$chan};
  my $hosts = $users{$serv}{$chan};
 
@@ -136,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}};
@@ -157,22 +173,21 @@ 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)};
 
- my $oldctxt = get_context;
- set_context $chan, $serv or return EAT_NONE;
- fetch $serv, $chan;
- scan  $serv, $chan;
- set_context $oldctxt;
+ local_context $chan, $serv => sub {
+  fetch $serv, $chan;
+  scan  $serv, $chan;
+ };
 
  return EAT_NONE;
 };
@@ -183,23 +198,19 @@ 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;
- if ($clones > 0) {
-  my $oldctxt = get_context;
-  if (set_context $chan, $serv) {
-   print $ph clone_enter_str $userhost, $nick, $clones;
-   set_context $oldctxt;
-  } else {
-   delay JOIN_DELAY, sub {
-    my $oldctxt = get_context;
-    return unless set_context $chan, $serv;
-    print $ph clone_enter_str $userhost, $nick, $clones;
-    set_context $oldctxt;
-   };
-  }
- }
+ return EAT_NONE unless $clones > 0;
+
+ my $printer = sub {
+  print $ph clone_enter_str $userhost, $nick, $clones;
+  1
+ };
+
+ local_context $chan, $serv, $printer or delay JOIN_DELAY, sub {
+  local_context $chan, $serv, $printer;
+ };
 
  return EAT_NONE;
 };
@@ -207,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;
@@ -228,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;
@@ -243,13 +254,13 @@ 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';
 
  if (nickcmp get_info('nick'), $nick) {
-  my $oldctxt = get_context;
-  my $host    = host $userhost;
+  my $guard = save_context;
+  my $host  = host $userhost;
   for (@chans) {
    my $clones = remove $nick, $host, $serv, $_->[0];
    if ($clones > 0) {
@@ -257,7 +268,6 @@ hook_server 'QUIT', sub {
     print $ph clone_leave_str $userhost, $nick, $clones;
    }
   }
-  set_context $oldctxt;
  } else {
   flush $serv, $_->[0] for @chans;
  }
@@ -266,9 +276,9 @@ hook_server 'QUIT', sub {
 };
 
 hook_print 'Disconnected', sub {
- my %servers = map { $_->{server} => 1 }
-                grep { $_->{flags} & 9 and not($_->{flags} & 2) }
-                 get_list 'channels';
+ my %servers;
+ $servers{$_->{server}} = 1 for grep +($_->{flags} & 0b1011) == 0b1001,
+                                 get_list 'channels';
 
  delete @users{  grep !$servers{$_}, keys %users};
  delete @fetched{grep !$servers{$_}, keys %fetched};
@@ -289,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;
@@ -299,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";
@@ -319,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;