irssi-config/scripts/display_userlist.pl

#!/usr/bin/perl
use strict;
use Term::ReadKey;
use Term::ANSIColor;
use IO::Socket;

my $path = "$ENV{HOME}/.irssi/sock";
my $umap = '@%+ ';
my $offset = 0;
my $lastoutput = "";

my %modes = (
      '@' => 'green',
      '%' => 'blue',
      '+' => 'yellow',
      ' ' => '',
);

$|++;
my($width, $height) = GetTerminalSize;
$height -= 2;

$SIG{WINCH} = sub {
   ($width, $height) = GetTerminalSize;
   $height -= 2;
};

ReadMode 4;
END { ReadMode 0; }

my $socket = IO::Socket::UNIX->new($path) or die $!;
#for(;;) {
   print $socket "userlist\n";

   my($channel, $mode, $userlist) = split / /, <$socket>, 3;
   exit unless defined $channel;
   chomp $userlist;

   my $output = "\n" . substr("$channel($mode)", 0, $width);

   my @users;
   for(sort { # Adapted from CGI:IRC
         return lc $a->[1] cmp lc $b->[1] if $a->[0] eq $b->[0];
         return index($umap, $a->[0]) <=> index($umap, $b->[0]);
      } map(/^[@%+]/ ? [substr($_, 0, 1), substr($_, 1)] : [" ", $_],
          split(/ /, $userlist))) {
      if(1 + length($_->[1] > $width)) {
         $_->[1] = substr($_->[1], 0, $width - 1);
      }
      push @users, color($modes{$_->[0]}) . $_->[0] . color('reset') . $_->[1];
   }

   $output .= "\n$_" for @users[$offset .. ($offset + $height)];

   if($output ne $lastoutput) {
      $lastoutput = $output;
      print $output;
   }

   my $key = ReadKey(1);
   if($key eq "\003" or $key eq 'q') { exit; }
   if($key eq '' and ReadKey(-1) eq '[') {
      $key = ReadKey(-1);
      if($key eq 'A') {#up
         $offset -= 1;
      }elsif($key eq 'B') {#down
         $offset += 1;
      }elsif($key eq '5') {# Pgup
         $offset -= $height;
      }elsif($key eq '6') {# Pgdn
         $offset += $height;
      }
      $offset = $#users - $height if $offset > $#users - $height;
      $offset = 0 if $offset < 0;
   }elsif($key eq ' ') {# spacebar
      # force refresh
      $lastoutput = "";
   }elsif($key eq 'r') { #re-exec, useful for testing
      exec("perl", $0);
   }
#}