html/ppl.pl


   1 # Copyright 2001 by Maciek Freudenheim <fahren@bochnia.pl>
   2 #  /thanks to elluin & lemur/
   3 # Copyright 2002 by Marco d'Itri <md@linux.it>
   4 #
   5 # You can use this software under the terms of the GNU General Public License.
   6 
   7 # ppl.pl for Irssi (port of asmodean's /ppl command from skuld3)
   8 #
   9 # Usage: /ppl [-o -v -i | -l] [-g | -h] [-p <n!u@h>] [-m <*ircserver*>]
  10 #             [-N | -H | -M | -D]
  11 #  To list ops | voices | normal | ircops
  12 #  To list away / unaway people, and
  13 #  To list people matching n!u@h or using server matching *ircserver*
  14 #  Multiple options can be combined
  15 
  16 use Irssi;
  17 use POSIX qw(strftime);
  18 use strict;
  19 
  20 use vars qw($VERSION %IRSSI);
  21 
  22 $VERSION = '20020128';
  23 %IRSSI = (
  24 	authors		=> 'Maciek Freudenheim, Marco d\'Itri',
  25 	contact		=> 'fahren@bochnia.pl, md@linux.it',
  26 	name		=> 'ppl',
  27 	description	=> 'port of asmodean\'s /ppl command from skuld3',
  28 	license		=> 'GPL v2',
  29 	url			=> 'http://www.linux.it/~md/irssi/',
  30 );
  31 
  32 my $ServerRewrite = '\.openprojects\.net$';
  33 my $At_Pos = 30;
  34 
  35 Irssi::theme_register([
  36 #	0 mode, 1 nick, 2 filler1, 3 user, 4 host, 5 filler2, 6 server, 7 hops
  37 	'ppl_line'	=> '%W$0%n$1%K$2%n$3%B@%n$4%K$5%n$6%C$7%n',
  38 	'ppl_end'	=> '%y>>%n $0 - matched %_$1%_ users '
  39 				.  '(*=%_$2%_ -o=%_$3%_ +v=%_$4%_ +o=%_$5%_)'
  40 ]);
  41 
  42 Irssi::command_bind('ppl' => 'cmd_ppl');
  43 Irssi::signal_add('redir ppl_line'	=> 'red_ppl_line');
  44 Irssi::signal_add('redir ppl_end'	=> 'red_ppl_end');
  45 
  46 my @users;
  47 my %ppl;
  48 
  49 sub cmd_ppl {
  50 	my ($pars, $server, $winit) = @_;
  51 
  52 	if (not $winit or $winit->{type} ne 'CHANNEL') {
  53 		Irssi::print('%R>>>%n You have to join channel first :\\',
  54 			MSGLEVEL_CRAP);
  55 		return;
  56 	}
  57 
  58 	$ppl{o} = $ppl{v} = $ppl{l} = $ppl{m} = $ppl{i} = 0;
  59 
  60 	my $ppl = '';
  61 	my @data = split(/ /, $pars);
  62 	while ($_ = shift(@data)) {
  63 		/^-N$/	and	$ppl{SORT} = 'nick', next;
  64 		/^-H$/	and	$ppl{SORT} = 'host', next;
  65 		/^-M$/	and	$ppl{SORT} = 'mode', next;
  66 		/^-D$/	and	$ppl{SORT} = 'distance', next;
  67 		/^-o$/	and $ppl{show_o} = 1, next;
  68 		/^-i$/	and $ppl{show_i} = 1, next;
  69 		/^-v$/	and $ppl{show_v} = 1, next;
  70 		/^-l$/	and $ppl{show_l} = 1, next;
  71 		/^-g$/	and $ppl{only_G} = 1, next;
  72 		/^-h$/	and $ppl{only_H} = 1, next;
  73 		/^-s$/	and $ppl{s} = shift(@data), next;
  74 		/^-p$/	and $ppl{h} = shift(@data), next;
  75 		Irssi::print("Unknown option: $_");
  76 		return;
  77 	}
  78 
  79 	$ppl{show_o} = $ppl{show_i} = $ppl{show_v} = $ppl{show_l} = 1
  80 		unless exists $ppl{show_o} or exists $ppl{show_i}
  81 			or exists $ppl{show_v} or exists $ppl{show_l};
  82 
  83 	$ppl{w} = Irssi::active_win()->{width};
  84 	$ppl{c} = $winit->{name};
  85 
  86 	if (Irssi::settings_get_bool('timestamps')) {
  87 		my $ts_for = Irssi::settings_get_str('timestamp_format');
  88 		$ppl{w} -= (length(strftime($ts_for, localtime)) + 1);
  89 	}
  90 
  91 	$server->redirect_event('who', 1, $ppl{c}, 0, undef, {
  92 		'event 315' => 'redir ppl_end',
  93 		'event 352' => 'redir ppl_line',
  94 	});
  95 	$server->send_raw("WHO :$ppl{c}");
  96 }
  97 
  98 sub red_ppl_line {
  99 	my ($s, $data) = @_;
 100 
 101 	my (undef, undef, $user, $host, $server, $nick, $mode, $hops)
 102 		= split(/ /, $data);
 103 
 104 	return if $mode =~ /^G/ and $ppl{only_H};
 105 	return if $mode =~ /^H/ and $ppl{only_G};
 106 
 107 	if ($ppl{h}) {
 108 		return unless $s->mask_match($ppl{h}, $nick, $user, $host);
 109 	}
 110 	if ($ppl{s}) {
 111 		return unless $server =~ /$ppl{s}/;
 112 	}
 113 
 114 	if ($mode =~ /\*/) {
 115 		return unless $ppl{show_i};
 116 		$ppl{i}++;
 117 	}
 118 	if ($mode =~ /@/) {
 119 		return unless $ppl{show_o};
 120 		$ppl{o}++;
 121 	} elsif ($mode =~ /\+/) {
 122 		return unless $ppl{show_v};
 123 		$ppl{v}++;
 124 	} else {
 125 		return unless $ppl{show_l};
 126 		$ppl{l}++;
 127 	}
 128 	$ppl{m}++;
 129 
 130 	$mode = sprintf('%-2.2s', $mode);
 131 	if (length($nick) + length($user) > $At_Pos - 4) {
 132 		$user = substr($user, 0, 11);
 133 		$nick = substr($nick, 0, $At_Pos - 4 - length $user);
 134 	}
 135 	$server =~ s/$ServerRewrite//o if $ServerRewrite;
 136 	if (length($host) + length($server) > $ppl{w} - $At_Pos - 2) {
 137 		$host = substr($host, 0, $ppl{w} - $At_Pos - 2);
 138 		my $len = $ppl{w} - $At_Pos - 3 - length($host);
 139 		$server = substr($server, 0, $len > 0 ? $len : 0);
 140 	}
 141 	my $filler1 = '.' x ($At_Pos - 3 - length($nick) - length($user));
 142 	my $filler2 = '.' x ($ppl{w} - $At_Pos - 2
 143 		- length($host) - length($server));
 144 	$hops =~ s/^://;
 145 
 146 	if ($ppl{SORT}) {
 147 		push(@users,
 148 			[$mode, $nick, $filler1, $user, $host, $filler2, $server, $hops]);
 149 	} else {
 150 		$s->printformat($ppl{c}, MSGLEVEL_CLIENTCRAP, 'ppl_line',
 151 			$mode, $nick, $filler1, $user, $host, $filler2, $server, $hops);
 152 	}
 153 }
 154 
 155 sub red_ppl_end {
 156 	my ($server, $data) = @_;
 157 
 158 	if ($ppl{SORT}) {
 159 		if ($ppl{SORT} eq 'host') {
 160 			@users = sort sort_domain @users;
 161 		} elsif ($ppl{SORT} eq 'mode') {
 162 			@users = sort sort_mode @users;
 163 		} elsif ($ppl{SORT} eq 'nick') {
 164 			@users = sort { lc $a->[1] cmp lc $b->[1] } @users;
 165 		} elsif ($ppl{SORT} eq 'distance') {
 166 			@users = sort { lc $a->[7] cmp lc $b->[7] } @users;
 167 		}
 168 
 169 		foreach (@users) {
 170 			$server->printformat($ppl{c}, MSGLEVEL_CLIENTCRAP, 'ppl_line', @$_);
 171 		}
 172 		undef @users;
 173 	}
 174 	$server->printformat($ppl{c}, MSGLEVEL_CLIENTCRAP, 'ppl_end',
 175 		$ppl{c}, $ppl{m}, $ppl{i}, $ppl{l}, $ppl{v}, $ppl{o});
 176 	undef %ppl;
 177 }
 178 
 179 sub sort_domain {
 180 	my @doma = split(/\./, lc $a->[4]);
 181 	my @domb = split(/\./, lc $b->[4]);
 182 
 183 	# sort IP addresses
 184 	if ($doma[$#doma] =~ /^\d+$/ and $domb[$#domb] =~ /^\d+$/) {
 185 		return $doma[0] <=> $domb[0] || $doma[1] <=> $domb[1]
 186 			|| $doma[2] <=> $domb[2] || $doma[3] <=> $domb[3];
 187 	}
 188 
 189 		$doma[$#doma] cmp $domb[$#domb]
 190 					||
 191 	$doma[$#doma - 1] cmp $domb[$#domb - 1]
 192 					||
 193 	$doma[$#doma - 2] cmp $domb[$#domb - 2]
 194 }
 195 
 196 sub sort_mode {
 197 	return; # FIXME unfinished
 198 	my ($sa, $ma) = split(//, $a->[0]);
 199 	my ($sb, $mb) = split(//, $b->[0]);
 200 
 201 #	Irssi::print("=== <$sa> <$ma>");
 202 
 203 #	if ($sa eq $sb) {
 204 #		return ?
 205 #	}
 206 	return -1 if $sa eq 'G';
 207 	return 1 if $sb eq 'G';
 208 }
 209 
 210 # vim: set tabstop=4