Restyle clones.pl

diff --git a/clones.pl b/clones.pl
index 72e1092fc834fb58a09267552976f453fa4fe199..5e385959a4b390729152b24c436adf8e91ed7fe4 100755 (executable)
--- a/clones.pl
+++ b/clones.pl
@@ -13,8 +13,8 @@ use Xchat::XPI::Events qw<delay>;
 
 use constant {
  JOIN_DELAY => 1000,
- PRE  => ' ',
- POST => "\n"
+ PRE        => ' ',
+ POST       => "\n",
 };
 
 our $VERSION = '0.04';
@@ -25,13 +25,17 @@ $extractor = qr/$extractor/;
 
 sub clone_enter_str {
  my ($host, $nick, $clones) = @_;
- my @clones = $clones =~ /$extractor/g;
+
+ my @clones = $clones =~ /$extractor/go;
+
  return "\002$nick\002 ($host) is a clone of : \002@clones\002\n";
 }
 
 sub clone_leave_str {
  my ($host, $nick, $clones) = @_;
- my @clones = $clones =~ /$extractor/g;
+
+ my @clones = $clones =~ /$extractor/go;
+
  return "\002$nick\002 ($host) has "
                        . int($clones) . ' clone' . ($clones > 1 ? 's' : '')
                        . " left : \002@clones\002\n";
@@ -39,20 +43,26 @@ sub clone_leave_str {
 
 sub clone_list_str {
  my ($host, $clones) = @_;
- my @clones = $clones =~ /$extractor/g;
+
+ my @clones = $clones =~ /$extractor/go;
+
  return "Clones ($host) : \002@clones\002\n";
 }
 
 sub host {
  my $userhost = lc $_[0];
+
  return $userhost =~ /@([^@]+)$/ ? $1 : $userhost;
 }
 
 sub add {
  my ($nick, $host, $serv, $chan) = @_;
- my $hosts = $users{$serv}{$chan};
+
+ my $hosts  = $users{$serv}{$chan};
  $users{$serv}{$chan} = $hosts = { } unless defined $hosts;
+
  my $clones = $hosts->{$host};
+
  $nick = PRE . $nick . POST;
  if (defined $clones) {
   if (index($clones, $nick) < $[) {
@@ -62,22 +72,25 @@ sub add {
   $clones = dualvar 0, '';
   $hosts->{$host} = dualvar 1, $nick;
  }
+
  return $clones;
 }
 
 sub remove {
  my ($nick, $host, $serv, $chan) = @_;
- my $hosts = $users{$serv}{$chan};
+
+ my $hosts  = $users{$serv}{$chan};
  return 0 unless $hosts;
+
  my $clones = $hosts->{$host};
  return 0 unless $clones;
+
  $nick = PRE . $nick . POST;
  if ((my $off = index $clones, $nick) >= $[) {
   my $count = int $clones;
   if ($count > 1) {
    substr $clones, $off, length $nick, '';
-   return $hosts->{$host} = dualvar $count - 1,
-                                    $clones;
+   return $hosts->{$host} = dualvar $count - 1, $clones;
   } else {
    delete $hosts->{$host};
   }
@@ -87,11 +100,14 @@ sub remove {
 
 sub replace {
  my ($old, $new, $host, $serv, $chan) = @_;
+
  my $hosts = $users{$serv}{$chan};
  $users{$serv}{$chan} = $hosts = { } unless defined $hosts;
+
  my $clones = $hosts->{$host};
- ($old, $new) = map { PRE . $_ . POST } $old, $new;
- if (defined $clones && (my $off = index $clones, $old) >= $[) {
+
+ $_ = PRE . $_ . POST for $old, $new;
+ if (defined $clones and (my $off = index $clones, $old) >= $[) {
   my $count = int $clones;
   substr $clones, $off, length $old, '';
   $hosts->{$host} = dualvar $count, $clones . $new;
@@ -102,8 +118,10 @@ sub replace {
 
 sub scan {
  my ($serv, $chan) = @_;
+
  return unless $fetched{$serv}{$chan};
  my $hosts = $users{$serv}{$chan};
+
  my $count = 0;
  while (my ($host, $clones) = each %$hosts) {
   if ($clones > 1) {
@@ -111,39 +129,51 @@ sub scan {
    print $ph clone_list_str $host, $clones;
   }
  }
+
  return $count;
 }
 
 sub flush {
  my ($serv, $chan) = @_;
- return 0 unless $serv && $chan && $fetched{$serv}{$chan};
+
+ return 0 unless $serv and $chan and $fetched{$serv}{$chan};
+
  delete $users{$serv}{$chan};
  delete $users{$serv} unless keys %{$users{$serv}};
+
  delete $fetched{$serv}{$chan};
  delete $fetched{$serv} unless keys %{$fetched{$serv}};
+
  return 1;
 }
 
 sub fetch {
  my ($serv, $chan) = @_;
- my @users = grep { defined $_->{host} and length $_->{host} }
-              get_list 'users';
- if (@users) {
-  add $_->{nick}, host($_->{host}), $serv, $chan for @users;
-  $fetched{$serv}{$chan} = 1;
+
+ my $users = 0;
+ for (get_list 'users') {
+  my $host = $_->{host};
+  next unless defined $host and length $host;
+  add $_->{nick}, host($host), $serv, $chan;
+  ++$users;
  }
- return scalar @users;
+ $fetched{$serv}{$chan} = 1 if $users;
+
+ return $users;
 }
 
 hook_server '315', sub { # WHO end
  my $serv = get_info 'server';
  my $chan = lc $_[0][3];
+
  return EAT_NONE if $fetched{$serv}{$chan};
+
  my $oldctxt = get_context;
  set_context $chan, $serv or return EAT_NONE;
  fetch $serv, $chan;
- scan $serv, $chan;
+ scan  $serv, $chan;
  set_context $oldctxt;
+
  return EAT_NONE;
 };
 
@@ -154,6 +184,7 @@ 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 $clones = add $nick, host($userhost), $serv, $chan;
  if ($clones > 0) {
   my $oldctxt = get_context;
@@ -169,6 +200,7 @@ hook_server 'JOIN', sub {
    };
   }
  }
+
  return EAT_NONE;
 };
 
@@ -176,6 +208,7 @@ hook_server 'KICK', sub {
  my $nick = $_[0][3];
  my $serv = get_info 'server';
  my $chan = lc $_[0][2];
+
  if (nickcmp get_info('nick'), $nick) {
   my $userinfo = user_info $nick;
   my $userhost = $userinfo->{host};
@@ -188,6 +221,7 @@ hook_server 'KICK', sub {
  } else {
   flush $serv, $chan;
  }
+
  return EAT_NONE;
 };
 
@@ -195,24 +229,27 @@ hook_server 'PART', sub {
  my ($nick, $userhost) = ($_[0][0] =~ /^:([^!]+)!(.*)/);
  my $serv = get_info 'server';
  my $chan = lc $_[0][2];
+
  if (nickcmp get_info('nick'), $nick) {
   my $clones = remove $nick, host($userhost), $serv, $chan;
   print $ph clone_leave_str $userhost, $nick, $clones if $clones > 0;
  } else {
   flush $serv, $chan;
  }
+
  return EAT_NONE;
 };
 
 hook_server 'QUIT', sub {
  my ($nick, $userhost) = ($_[0][0] =~ /^:([^!]+)!(.*)/);
- my $serv = get_info 'server';
- my @chans = map { [ lc $_->{channel}, $_->{context} ] }
-              grep { $_->{type} eq 2 && $_->{server} eq $serv }
+ my $serv  = get_info 'server';
+ my @chans = map [ lc $_->{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 $host    = host $userhost;
   for (@chans) {
    my $clones = remove $nick, $host, $serv, $_->[0];
    if ($clones > 0) {
@@ -224,22 +261,27 @@ hook_server 'QUIT', sub {
  } else {
   flush $serv, $_->[0] for @chans;
  }
+
  return EAT_NONE;
 };
 
 hook_print 'Disconnected', sub {
  my %servers = map { $_->{server} => 1 }
-                grep { $_->{flags} & 9 && not $_->{flags} & 2 }
+                grep { $_->{flags} & 9 and not($_->{flags} & 2) }
                  get_list 'channels';
- delete $users{$_}   for grep { !$servers{$_} } keys %users;
- delete $fetched{$_} for grep { !$servers{$_} } keys %fetched;
+
+ delete @users{  grep !$servers{$_}, keys %users};
+ delete @fetched{grep !$servers{$_}, keys %fetched};
+
  return EAT_NONE;
 };
 
 sub nick_cb {
  my ($old, $new) = @{$_[0]};
+
  my $userinfo = user_info $new;
  $userinfo    = user_info $old unless defined $userinfo;
+
  my $userhost = $userinfo->{host};
  if (defined $userhost and length $userhost) {
   # If the host isn't defined, the first WHO response hasn't been received yet,
@@ -249,19 +291,22 @@ sub nick_cb {
   replace $old => $new, host($userhost),
                         get_info('server'), lc get_info('channel');
  }
+
  return EAT_NONE;
 }
 
-hook_print $_, \&nick_cb for ('Change Nick', 'Your Nick Changing');
+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';
- if (!$fetched{$serv}{$chan} && !fetch($serv, $chan)) {
+
+ if (!$fetched{$serv}{$chan} and !fetch($serv, $chan)) {
   print $ph "Data still not available\n";
  } elsif (!scan($serv, $chan)) {
   print $ph "No clones found\n";
  }
+
  return EAT_ALL;
 }, {
  help_text => 'Scan for clones in the current channel'