]> git.vpit.fr Git - perl/scripts/xchat.git/commitdiff
Use the correct IRC lowercase whereever needed
authorVincent Pit <vince@profvince.com>
Fri, 20 Nov 2015 17:01:01 +0000 (15:01 -0200)
committerVincent Pit <vince@profvince.com>
Fri, 20 Nov 2015 17:20:37 +0000 (15:20 -0200)
Xchat/XPI/Utils.pm
clones.pl
hl.pl
opers.pl
services.pl

index cbd9494ae1cd5a158d34dc78a32a2196eadd7ff8..0b4bff91b7266fa72e4ff65c617e81e9d310efcb 100644 (file)
@@ -7,6 +7,14 @@ use Xchat qw<:all>;
 
 our $VERSION = '0.02';
 
+sub irc_lc {
+ my ($bytes) = @_;
+
+ $bytes =~ y/A-Z[\\]^/a-z{|}~/;
+
+ return $bytes;
+}
+
 my @rcolors;
 BEGIN {
  if (nickcmp(get_info('version'), '2.4.0') < 0) {
@@ -83,6 +91,7 @@ use base qw<Exporter>;
 
 our @EXPORT         = ();
 our %EXPORT_TAGS    = ('funcs' => [ qw<
+ irc_lc
  dye_nick
  gui
  save_context local_context
index c1e0dd950ebc47c5a3666179c6906cbc7a72d2ec..d661eb91f1c214ccabd184b88615ab1cd9e97f09 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);
@@ -59,6 +61,8 @@ sub host {
 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";
diff --git a/hl.pl b/hl.pl
index 0a9fa11984c0ea16ce1e882daef191c1b7463de0..e4692ef775a2ab2ddaf887bf9fc3e640cd86fc22 100755 (executable)
--- a/hl.pl
+++ b/hl.pl
@@ -8,7 +8,7 @@ use Xchat qw<:all>;
 use lib get_info 'xchatdir';
 use Xchat::XPI;
 use Xchat::XPI::Events qw<filter>;
-use Xchat::XPI::Utils  qw<gui>;
+use Xchat::XPI::Utils  qw<irc_lc gui>;
 
 our $VERSION = '0.04';
 
@@ -52,7 +52,7 @@ for (keys %hl) {
 }
 
 filter 'Channel Action' => sub {
- my $chan = lc get_info 'channel';
+ my $chan = irc_lc get_info 'channel';
  if ($hl{$chan} and $_[1] =~ /$hl{$chan}/) {
   gui 'highlight';
   1;
@@ -73,7 +73,7 @@ for (keys %skip) {
 }
 
 filter 'Channel Action Hilight' => sub {
- my $chan = lc get_info 'channel';
+ my $chan = irc_lc get_info 'channel';
  if ($skip{$chan} and $_[1] =~ /$skip{$chan}/) {
   gui 'clear';
   1;
index 66c9c0b17974b39253a3c03c8b2e7c0e93eb39b5..218b2d2dc8d8c34d85eb7bb3de68729b471179ce 100755 (executable)
--- a/opers.pl
+++ b/opers.pl
@@ -7,7 +7,7 @@ use Xchat qw<:all>;
 
 use lib get_info 'xchatdir';
 use Xchat::XPI;
-use Xchat::XPI::Utils qw<save_context>;
+use Xchat::XPI::Utils qw<irc_lc save_context>;
 
 our $VERSION = '0.03';
 
@@ -20,8 +20,8 @@ hook_server '352', sub {
 
  my $serv = get_info 'server';
  my $nick = $_[0][7];
- return EAT_NONE if $opers{$serv}{$nick};
- $opers{$serv}{$nick} = 1;
+ return EAT_NONE if $opers{$serv}{irc_lc($nick)};
+ $opers{$serv}{irc_lc($nick)} = $nick;
 
  my $host = $_[0][4] . '@' . $_[0][5];
  my %chans;
@@ -63,7 +63,7 @@ hook_server 'QUIT', sub {
  my ($nick) = $_[0][0] =~ /^:([^!]+)!/;
 
  my $serv = get_info 'server';
- delete $opers{$serv}{$nick};
+ delete $opers{$serv}{irc_lc($nick)};
 
  return EAT_NONE;
 };
@@ -71,9 +71,11 @@ hook_server 'QUIT', sub {
 sub nick_cb {
  my ($old, $new) = @{$_[0]};
 
+ $old = irc_lc $old;
+
  my $ops = $opers{get_info 'server'};
  if ($ops and $ops->{$old}) {
-  $ops->{$new} = 1;
+  $ops->{irc_lc($new)} = $new;
   delete $ops->{$old};
  }
 
@@ -101,11 +103,11 @@ hook_command 'OPSCAN', sub {
  my ($name, @ops);
  if ($isnet) {
   $name = 'network';
-  @ops  = keys %{$opers{$serv}};
+  @ops  = values %{$opers{$serv}};
  } else {
   $name = 'channel';
   @ops  = map $_->{nick},
-           grep $opers{$serv}{$_->{nick}},
+           grep $opers{$serv}{irc_lc($_->{nick})},
             get_list 'users';
  }
 
index 0b7af6d1ddfd04f40abe305e71cf3a90427aeb97..e57845cf13c0af877a224357bcee38a4807317f6 100755 (executable)
@@ -89,7 +89,7 @@ sub csmode {
 
 hook_command "C$_", \&csmode, {
  data => $_,
- help_text => join ' ', $_, '[nicks] ,', (lc $_),
+ help_text => join ' ', $_, '[nicks] ,', lc($_),
     'the specified targets (or you if none) on the current channel via ChanServ'
 } for map { $_, "DE$_" } qw<VOICE HALFOP OP PROTECT>;