/var/www/www.irssi.org-old/scripts/html/len.pl
1 # $Id: len.pl 4 2006-03-11 18:30:09Z ch $
2
3 use Irssi 20020324;
4 use 5.005_62;
5 use strict;
6 use 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
62 Irssi::command_bind('len', \&command_len);
63
64 ################################################################################
65 # Register settings
66 ################################################################################
67
68 # String
69 Irssi::settings_add_str('misc', 'len_data_file', "$ENV{HOME}/.len");
70
71 ################################################################################
72 # Register signals
73 ################################################################################
74
75 Irssi::signal_add_first('command kick', \&signal_command_kick);
76 Irssi::signal_add_first('command nick', \&signal_command_nick);
77 Irssi::signal_add_first('command part', \&signal_command_part);
78 Irssi::signal_add_first('command quit', \&signal_command_quit);
79 Irssi::signal_add_first('command topic', \&signal_command_topic);
80 Irssi::signal_add_last('event 005', \&signal_event_005);
81
82 ################################################################################
83 # Register themes
84 ################################################################################
85
86 Irssi::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
94 our %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
101 our %data;
102
103 ################################################################################
104 # Code run once at start
105 ################################################################################
106
107 print CLIENTCRAP "len.pl $VERSION loaded. For further information type %9/len%9";
108
109 ################################################################################
110 # Subroutines (commands)
111 ################################################################################
112
113 sub 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
195 sub 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
228 sub 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
244 sub 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
270 sub 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
286 sub 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
315 sub 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
335 sub fix {
336 my $string = shift;
337 $string =~ s/^\t+//gm;
338 return $string;
339 }
340
341 sub print_err {
342 my $text = shift;
343
344 print CLIENTCRAP '%Rlen.pl error%n: ' . $text;
345 }
346
347 sub print_out {
348 my $text = shift;
349
350 print CLIENTCRAP '%9len.pl%9: ' . $text;
351 }
352
353 sub 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
371 sub set_settings {
372 # String
373 $option{len_data_file} = Irssi::settings_get_str('len_data_file');
374 }