1# $Id: len.pl 4 2006-03-11 18:30:09Z ch $
2
3use Irssi 20020324;
4use 5.005_62;
5use strict;
6use vars qw($VERSION %IRSSI);
7
8$VERSION = '1.0.0';
9#$VERSION = '1.0.0 SVN ($LastChangedRevision: 4 $)';
10%IRSSI = (
11          authors     => 'Clemens Heidinger',
12          changed     => '$LastChangedDate: 2006-03-11 19:30:09 +0100 (Sat, 11 Mar 2006) $',
13          commands    => 'len',
14          contact     => 'heidinger@dau.pl',
15          description => 'If you try to get a nick with 11 characters but only ' .
16                         '9 are allowed, this script will prevent the '          .
17                         'nickchange. The same for too long topics, kickmsgs, '  .
18                         'partmsgs and quitmsgs.',
19          license     => 'BSD',
20          name        => 'len',
21         );
22
23################################################################################
24#                                                                              #
25# CHANGELOG                                                                    #
26#                                                                              #
27# 2006-03-11    release 1.0.0                                                  #
28#               No big changes. As the script is stable for quite a while,     #
29#               this is the 1.0.0 release.                                     #
30#                                                                              #
31# 2005-01-28    release 0.4.0                                                  #
32#               Splitted up 005 event messages will cause no trouble anymore   #
33#                                                                              #
34# 2004-04-26    release 0.3.2                                                  #
35#               minor changes                                                  #
36#                                                                              #
37# 2003-01-18    release 0.3.1                                                  #
38#               - revised help-message                                         #
39#               - minor changes                                                #
40#                                                                              #
41# 2003-01-18    release 0.3.0                                                  #
42#               %data-hash moved to extern file specified in setting           #
43#               len_data_file                                                  #
44#                                                                              #
45# 2002-10-02    release 0.2.1                                                  #
46#               Changed output format of /len                                  #
47#                                                                              #
48# 2002-09-27    release 0.2.0                                                  #
49#               Added command /len with a table containing the values for      #
50#               NICKLEN etc. and tips if these values haven't been received    #
51#               from the server yet                                            #
52#                                                                              #
53# 2002-09-26    release 0.1.0                                                  #
54#               initial release                                                #
55#                                                                              #
56################################################################################
57
58################################################################################
59# Register commands
60################################################################################
61
62Irssi::command_bind('len', \&command_len);
63
64################################################################################
65# Register settings
66################################################################################
67
68# String
69Irssi::settings_add_str('misc', 'len_data_file', "$ENV{HOME}/.len");
70
71################################################################################
72# Register signals
73################################################################################
74
75Irssi::signal_add_first('command kick', \&signal_command_kick);
76Irssi::signal_add_first('command nick', \&signal_command_nick);
77Irssi::signal_add_first('command part', \&signal_command_part);
78Irssi::signal_add_first('command quit', \&signal_command_quit);
79Irssi::signal_add_first('command topic', \&signal_command_topic);
80Irssi::signal_add_last('event 005', \&signal_event_005);
81
82################################################################################
83# Register themes
84################################################################################
85
86Irssi::theme_register(['len_print', '[$0] {line_start} $1']);
87
88################################################################################
89# Global Variables
90################################################################################
91
92# Put values of the settings in %option-hash
93
94our %option;
95
96# Most IRC-Server send a message containing the values for NICKLEN, TOPICLEN
97# and KICKLEN.
98# Well, some server do not send this message. Get these values from %data-hash
99# stored in file specified in setting len_data_file.
100
101our %data;
102
103################################################################################
104# Code run once at start
105################################################################################
106
107print CLIENTCRAP "len.pl $VERSION loaded. For further information type %9/len%9";
108
109################################################################################
110# Subroutines (commands)
111################################################################################
112
113sub command_len {
114	my ($data, $server, $witem) = @_;
115	my $output;
116
117	unless ($server and defined($server)) {
118		print_out("First connect to a server...");
119		return;
120	}
121
122	read_file();
123
124	my $kicklen  = sprintf "%-8s", $data{$server->{tag}}{kicklen};
125	my $nicklen  = sprintf "%-8s", $data{$server->{tag}}{nicklen};
126	my $partlen  = sprintf "%-8s", $data{$server->{tag}}{partlen};
127	my $quitlen  = sprintf "%-8s", $data{$server->{tag}}{quitlen};
128	my $topiclen = sprintf "%-9s", $data{$server->{tag}}{topiclen};
129
130	$output = &fix(<<"	END");
131	|=========|=================|
132	|         | max. characters |
133	|=========|=================|
134	| kickmsg | $kicklen        |
135	|---------|-----------------|
136	| nick    | $nicklen        |
137	|---------|-----------------|
138	| partmsg | $partlen        |
139	|---------|-----------------|
140	| quitmsg | $quitlen        |
141	|---------|-----------------|
142	| topic   | $topiclen       |
143	|---------|-----------------|
144	END
145
146	unless ($kicklen   =~ /\d/ &&
147	        $nicklen   =~ /\d/ &&
148	        $partlen   =~ /\d/ &&
149	        $quitlen   =~ /\d/ &&
150	        $topiclen  =~ /\d/)
151	{
152		$output .= &fix(<<"		END");
153
154		Obviously there are some values missing.
155		When you connect to a server most send you a message (numeric 005)
156		with the proper values for the maximal nick length, topic length etc.
157		If you loaded this script after connecting to "$server->{tag}"
158		you should reconnect.
159		If this doesn't help, the server is not sending the message with these
160		values.
161		The following alternatives remain:
162		  * Use another server of the same network and cross your fingers
163		    that it'll send the message.
164		  * Find out the values and adjust the data hash in the file
165		    specified in the setting len_data_file.
166		    The file might look like this:
167
168		    %{ \$data{$server->{tag}} } = (
169		        'kicklen'  => <value>,
170		        'nicklen'  => <value>,
171		        'partlen'  => <value>,
172		        'quitlen'  => <value>,
173		        'topiclen' => <value>,
174		    );
175
176		    %{ \$data{someOtherNetwork} } = (
177		        'kicklen'  => 160,
178		        'nicklen'  => 9,
179		        'partlen'  => 160,
180		        'quitlen'  => 160,
181		        'topiclen' => 160,
182		    );
183		END
184	}
185
186	foreach my $line (split /\n/, $output) {
187		Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'len_print', $server->{tag}, $line);
188	}
189}
190
191################################################################################
192# Subroutines (signals)
193################################################################################
194
195sub signal_command_kick {
196	my ($command, $server, $witem) = @_;
197
198	return unless ($server and defined($server));
199
200	read_file();
201
202	# Syntax for /kick:
203	# KICK [<channel>] <nicks> [<reason>]
204	# We want to isolate <reason> to know how long it is
205
206	# delete [<channel>] <nicks>
207	$command =~ s/^\s*           # Start of String and optional some whitespace
208	              (?:            # Grouping
209	              \#\S+          # This is <channel>
210	              )?             # End of Grouping, <channel> is optional
211	              [ ]?           # Maybe a single space
212	              \S+            # Everything not whitespace. These are the nicks.
213	              [ ]?           # Maybe a single space
214	             //x;            # Delete everything
215
216	# The rest of $command is the kickmsg
217	my $kickmsg = $command;
218
219	my $len = length($kickmsg);
220	my $maxlen = $data{$server->{tag}}{kicklen};
221
222	if ($maxlen > 0 && $len > $maxlen) {
223		print_out("kickmsg too long! ($len/$maxlen)");
224		Irssi::signal_stop();
225	}
226}
227
228sub signal_command_nick {
229	my ($nick, $server, $witem) = @_;
230
231	return unless ($server and defined($server));
232
233	read_file();
234
235	my $len = length($nick);
236	my $maxlen = $data{$server->{tag}}{nicklen};
237
238	if ($maxlen > 0 && $len > $maxlen) {
239		print_out("Nick too long! ($len/$maxlen)");
240		Irssi::signal_stop();
241	}
242}
243
244sub signal_command_part {
245	my ($command, $server, $witem) = @_;
246
247	return unless ($server and defined($server));
248
249	read_file();
250
251	# Syntax for /part:
252	# PART [<channels>] [<message>]
253	# So we want to get rid of the channels to isolate the partmsg
254
255	# Delete [<channels>]
256	$command =~ s/^#\S+ //;
257
258	# The rest of $command is the partmsg
259	my $partmsg = $command;
260
261	my $len = length($partmsg);
262	my $maxlen = $data{$server->{tag}}{partlen};
263
264	if ($maxlen > 0 && $len > $maxlen) {
265		print_out("partmsg too long! ($len/$maxlen)");
266		Irssi::signal_stop();
267	}
268}
269
270sub signal_command_quit {
271	my ($quitmsg, $server, $witem) = @_;
272
273	return unless ($server and defined($server));
274
275	read_file();
276
277	my $len = length($quitmsg);
278	my $maxlen = $data{$server->{tag}}{quitlen};
279
280	if ($maxlen > 0 && $len > $maxlen) {
281		print_out("quitmsg too long! ($len/$maxlen)");
282		Irssi::signal_stop();
283	}
284}
285
286sub signal_command_topic {
287	my ($command, $server, $witem) = @_;
288
289	return unless ($server and defined($server));
290
291	read_file();
292
293	# Syntax for /topic:
294	# TOPIC [-delete] [<channel>] [<topic>]
295	# We want to isolate <reason> to know how long it is
296
297	# Delete <channel>
298	$command =~ s/^#\S+ //;
299
300	# The rest of $command is the topic
301	my $topic = $command;
302
303	my $len = length($topic);
304	my $maxlen = $data{$server->{tag}}{topiclen};
305
306	if ($maxlen > 0 && $len > $maxlen) {
307		print_out("Topic too long! ($len/$maxlen)");
308		Irssi::signal_stop();
309	}
310}
311
312# Most server send this message containig the values for NICKLEN etc. on
313# connect (event 005).
314
315sub signal_event_005 {
316	my ($server, $string) = @_;
317
318	if ($string =~ /KICKLEN=(\d+)/) {
319		$data{$server->{tag}}{kicklen} = $1;
320		$data{$server->{tag}}{partlen} = $1;
321		$data{$server->{tag}}{quitlen} = $1;
322	}
323	if ($string =~ /NICKLEN=(\d+)/) {
324		$data{$server->{tag}}{nicklen} = $1;
325	}
326	if ($string =~ /TOPICLEN=(\d+)/) {
327		$data{$server->{tag}}{topiclen} = $1;
328	}
329}
330
331################################################################################
332# Helper subroutines
333################################################################################
334
335sub fix {
336	my $string = shift;
337	$string =~ s/^\t+//gm;
338	return $string;
339}
340
341sub print_err {
342	my $text = shift;
343
344	print CLIENTCRAP '%Rlen.pl error%n: ' . $text;
345}
346
347sub print_out {
348	my $text = shift;
349
350	print CLIENTCRAP '%9len.pl%9: ' . $text;
351}
352
353sub read_file {
354	set_settings();
355
356	my $file = $option{len_data_file};
357
358	unless (-e $file && -r $file) {
359		return;
360	}
361	unless (my $return = do $file) {
362		if ($@) {
363			print_err("parsing $file failed: $@");
364		}
365		unless (defined($return)) {
366			print_err("'do $file' failed");
367		}
368	}
369}
370
371sub set_settings {
372	# String
373	$option{len_data_file} = Irssi::settings_get_str('len_data_file');
374}
375