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
16use Irssi;
17use POSIX qw(strftime);
18use strict;
19
20use 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
32my $ServerRewrite = '\.openprojects\.net$';
33my $At_Pos = 30;
34
35Irssi::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
42Irssi::command_bind('ppl' => 'cmd_ppl');
43Irssi::signal_add('redir ppl_line'	=> 'red_ppl_line');
44Irssi::signal_add('redir ppl_end'	=> 'red_ppl_end');
45
46my @users;
47my %ppl;
48
49sub 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
98sub 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
155sub 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
179sub 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
196sub 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
211