html/dau.pl
1 ################################################################################
2 # $Id: dau.pl 273 2008-02-03 15:27:25Z heidinger $
3 ################################################################################
4 #
5 # dau.pl - write like an idiot
6 #
7 ################################################################################
8 # Author
9 ################################################################################
10 #
11 # Clemens Heidinger <heidinger@dau.pl>
12 #
13 ################################################################################
14 # Changelog
15 ################################################################################
16 #
17 # dau.pl has a built-in changelog (--changelog switch)
18 #
19 ################################################################################
20 # Credits
21 ################################################################################
22 #
23 # - Robert Hennig: For the original dau shell script. Out of this script,
24 # merged with some other small Perl and shell scripts and aliases arised the
25 # first version of dau.pl for irssi.
26 #
27 ################################################################################
28 # Documentation
29 ################################################################################
30 #
31 # dau.pl has a built-in documentation (--help switch)
32 #
33 ################################################################################
34 # License
35 ################################################################################
36 #
37 # Licensed under the BSD license
38 #
39 ################################################################################
40 # Website
41 ################################################################################
42 #
43 # http://dau.pl/
44 #
45 # Additional information, DAU.pm, the dauomat and the dauproxy
46 #
47 ################################################################################
48
49 use 5.6.0;
50 use File::Basename;
51 use File::Path;
52 use IPC::Open3;
53 use Irssi 20021107.0841;
54 use Irssi::TextUI;
55 use locale;
56 use POSIX;
57 use re 'eval';
58 use strict;
59 use Tie::File;
60 use vars qw($VERSION %IRSSI);
61
62 $VERSION = '2.4.3';
63 #$VERSION = '2.4.3 SVN ($LastChangedRevision: 273 $)';
64 %IRSSI = (
65 authors => 'Clemens Heidinger',
66 changed => '$LastChangedDate: 2008-02-03 16:27:25 +0100 (Sun, 03 Feb 2008) $',
67 commands => 'dau',
68 contact => 'heidinger@dau.pl',
69 description => 'write like an idiot',
70 license => 'BSD',
71 modules => 'File::Basename File::Path IPC::Open3 POSIX Tie::File',
72 name => 'DAU',
73 sbitems => 'daumode',
74 url => 'http://dau.pl/',
75 );
76
77 ################################################################################
78 # Register commands
79 ################################################################################
80
81 Irssi::command_bind('dau', \&command_dau);
82
83 ################################################################################
84 # Register settings
85 # setting changed/added => change/add it here
86 ################################################################################
87
88 # boolean
89 Irssi::settings_add_bool('misc', 'dau_away_quote_reason', 1);
90 Irssi::settings_add_bool('misc', 'dau_away_reminder', 0);
91 Irssi::settings_add_bool('misc', 'dau_babble_verbose', 1);
92 Irssi::settings_add_bool('misc', 'dau_color_choose_colors_randomly', 1);
93 Irssi::settings_add_bool('misc', 'dau_cowsay_print_cow', 0);
94 Irssi::settings_add_bool('misc', 'dau_figlet_print_font', 0);
95 Irssi::settings_add_bool('misc', 'dau_silence', 0);
96 Irssi::settings_add_bool('misc', 'dau_statusbar_daumode_hide_when_off', 0);
97 Irssi::settings_add_bool('misc', 'dau_tab_completion', 1);
98
99 # Integer
100 Irssi::settings_add_int('misc', 'dau_babble_history_size', 10);
101 Irssi::settings_add_int('misc', 'dau_babble_verbose_minimum_lines', 2);
102 Irssi::settings_add_int('misc', 'dau_cool_maximum_line', 2);
103 Irssi::settings_add_int('misc', 'dau_cool_probability_eol', 20);
104 Irssi::settings_add_int('misc', 'dau_cool_probability_word', 20);
105 Irssi::settings_add_int('misc', 'dau_remote_babble_interval_accuracy', 90);
106
107 # String
108 Irssi::settings_add_str('misc', 'dau_away_away_text', '$N is away now: [ $reason ]. Away since: $Z. I am currently not available at $T @ $chatnet (sry 4 amsg)!');
109 Irssi::settings_add_str('misc', 'dau_away_back_text', '$N is back: [ $reason ]. Away time: [ $time ]. I am available again at $T @ $chatnet (sry 4 amsg)!');
110 Irssi::settings_add_str('misc', 'dau_away_options',
111 "--parse_special --bracket -left '!---?[' -right ']?---!' --color -split capitals -random off -codes 'light red; yellow'," .
112 "--parse_special --bracket -left '--==||{{' -right '}}||==--' --color -split capitals -random off -codes 'light red; light cyan'," .
113 "--parse_special --bracket -left '--==||[[' -right ']]||==--' --color -split capitals -random off -codes 'yellow; light green'"
114 );
115 Irssi::settings_add_str('misc', 'dau_away_reminder_interval', '1 hour');
116 Irssi::settings_add_str('misc', 'dau_away_reminder_text', '$N is still away: [ $reason ]. Away time: [ $time ] (sry 4 amsg)');
117 Irssi::settings_add_str('misc', 'dau_babble_options_line_by_line', '--nothing');
118 Irssi::settings_add_str('misc', 'dau_babble_options_preprocessing', '');
119 Irssi::settings_add_str('misc', 'dau_color_codes', 'blue; green; red; magenta; yellow; cyan');
120 Irssi::settings_add_str('misc', 'dau_cool_eol_style', 'random');
121 Irssi::settings_add_str('misc', 'dau_cowsay_cowlist', '');
122 Irssi::settings_add_str('misc', 'dau_cowsay_cowpath', &def_dau_cowsay_cowpath);
123 Irssi::settings_add_str('misc', 'dau_cowsay_cowpolicy', 'allow');
124 Irssi::settings_add_str('misc', 'dau_cowsay_cowsay_path', &def_dau_cowsay_cowsay_path);
125 Irssi::settings_add_str('misc', 'dau_cowsay_cowthink_path', &def_dau_cowsay_cowthink_path);
126 Irssi::settings_add_str('misc', 'dau_daumode_channels', '');
127 Irssi::settings_add_str('misc', 'dau_delimiter_string', ' ');
128 Irssi::settings_add_str('misc', 'dau_figlet_fontlist', 'mnemonic,term,ivrit');
129 Irssi::settings_add_str('misc', 'dau_figlet_fontpath', &def_dau_figlet_fontpath);
130 Irssi::settings_add_str('misc', 'dau_figlet_fontpolicy', 'allow');
131 Irssi::settings_add_str('misc', 'dau_figlet_path', &def_dau_figlet_path);
132 Irssi::settings_add_str('misc', 'dau_files_away', '.away');
133 Irssi::settings_add_str('misc', 'dau_files_babble_messages', 'babble_messages');
134 Irssi::settings_add_str('misc', 'dau_files_cool_suffixes', 'cool_suffixes');
135 Irssi::settings_add_str('misc', 'dau_files_root_directory', "$ENV{HOME}/.dau");
136 Irssi::settings_add_str('misc', 'dau_files_substitute', 'substitute.pl');
137 Irssi::settings_add_str('misc', 'dau_language', 'en');
138 Irssi::settings_add_str('misc', 'dau_moron_eol_style', 'random');
139 Irssi::settings_add_str('misc', 'dau_parse_special_list_delimiter', ' ');
140 Irssi::settings_add_str('misc', 'dau_random_options',
141 '--substitute --boxes --uppercase,' .
142 "--substitute --color -split capitals -random off -codes 'light red; yellow'," .
143 "--substitute --color -split capitals -random off -codes 'light red; light cyan'," .
144 "--substitute --color -split capitals -random off -codes 'yellow; light green'," .
145 '--substitute --color --uppercase,' .
146 '--substitute --cool,' .
147 '--substitute --delimiter,' .
148 '--substitute --dots --moron,' .
149 '--substitute --leet,' .
150 '--substitute --mix,' .
151 '--substitute --mixedcase --bracket,' .
152 '--substitute --moron --stutter --uppercase,' .
153 '--substitute --moron -omega on,' .
154 '--substitute --moron,' .
155 '--substitute --uppercase --underline,' .
156 '--substitute --words --mixedcase'
157 );
158 Irssi::settings_add_str('misc', 'dau_remote_babble_channellist', '');
159 Irssi::settings_add_str('misc', 'dau_remote_babble_channelpolicy', 'deny');
160 Irssi::settings_add_str('misc', 'dau_remote_babble_interval', '1 hour');
161 Irssi::settings_add_str('misc', 'dau_remote_channellist', '');
162 Irssi::settings_add_str('misc', 'dau_remote_channelpolicy', 'deny');
163 Irssi::settings_add_str('misc', 'dau_remote_deop_reply', 'you are on my shitlist now @ $nick');
164 Irssi::settings_add_str('misc', 'dau_remote_devoice_reply', 'you are on my shitlist now @ $nick');
165 Irssi::settings_add_str('misc', 'dau_remote_op_reply', 'thx 4 op @ $nick');
166 Irssi::settings_add_str('misc', 'dau_remote_permissions', '000000');
167 Irssi::settings_add_str('misc', 'dau_remote_question_regexp', '%%%DISABLED%%%');
168 Irssi::settings_add_str('misc', 'dau_remote_question_reply', 'EDIT_THIS_ONE');
169 Irssi::settings_add_str('misc', 'dau_remote_voice_reply', 'thx 4 voice @ $nick');
170 Irssi::settings_add_str('misc', 'dau_standard_messages', 'hi @ all');
171 Irssi::settings_add_str('misc', 'dau_standard_options', '--random');
172 Irssi::settings_add_str('misc', 'dau_words_range', '1-4');
173
174 ################################################################################
175 # Register signals
176 # (Note that most signals are set dynamical in the subroutine signal_handling)
177 ################################################################################
178
179 Irssi::signal_add_last('setup changed', \&signal_setup_changed);
180 Irssi::signal_add_last('window changed' => sub { Irssi::statusbar_items_redraw('daumode') });
181 Irssi::signal_add_last('window item changed' => sub { Irssi::statusbar_items_redraw('daumode') });
182
183 ################################################################################
184 # Register statusbar items
185 ################################################################################
186
187 Irssi::statusbar_item_register('daumode', '', 'statusbar_daumode');
188
189 ################################################################################
190 # Global variables
191 ################################################################################
192
193 # Timer used by --away
194
195 our %away_timer;
196
197 # babble
198
199 our %babble;
200
201 # --command -in
202
203 our $command_in;
204
205 # The command to use for the output (MSG f.e.)
206
207 our $command_out;
208
209 # '--command -out' used?
210
211 our $command_out_activated;
212
213 # Counter for the subroutines entered
214
215 our $counter_subroutines;
216
217 # Counter for the switches
218 # --me --moron: --me would be 0, --moron 1
219
220 our $counter_switches;
221
222 # daumode
223
224 our %daumode;
225
226 # daumode activated?
227
228 our $daumode_activated;
229
230 # Help text
231
232 our %help;
233 $help{options} = <<END;
234 %9--away%9
235 Toggle away mode
236
237 %9-channels%9 %U'#channel1/network1, #channel2/network2, ...'%U:
238 Say away message in all those %Uchannels%U
239
240 %9-interval%9 %Utime%U:
241 Remind channel now and then that you're away
242
243 %9-reminder%9 %Uon|off%U:
244 Turn reminder on or off
245
246 %9--babble%9
247 Babble a message.
248
249 %9-at%9 %Unicks%U:
250 Comma separated list of nicks to babble at.
251 \$nick1, \$nick2 and so forth of the babble line will be replaced
252 by those nicks.
253
254 %9-cancel%9 %Uon|off%U:
255 Cancel active babble
256
257 %9-filter%9 %Uregular expression%U:
258 Only let through if the babble matches the %Uregular expression%U
259
260 %9-history_size%9 %Un%U:
261 Set the size of the history for this one babble to %Un%U
262
263 %9--boxes%9
264 Put words in boxes
265
266 %9--bracket%9
267 Bracket the text
268
269 %9-left%9 %Ustring%U:
270 Left bracket
271
272 %9-right%9 %Ustring%U:
273 Right bracket
274
275 %9--changelog%9
276 Print the changelog
277
278 %9--chars%9
279 Only one character each line
280
281 %9--color%9
282 Write in colors
283
284 %9-codes%9 %Ucodes%U:
285 Overrides setting dau_color_codes
286
287 %9-random%9 %Uon|off%U:
288 Choose color randomly from setting dau_color_codes resp.
289 %9--color -codes%9 or take one by one in the exact order given.
290
291 %9-split%9
292 %Ucapitals%U: Split by capitals
293 %Uchars%U: Every character another color
294 %Ulines%U: Every line another color
295 %Uparagraph%U: The whole paragraph in one color
296 %Urchars%U: Some characters one color
297 %Uwords%U: Every word another color
298
299 %9--command%9
300 %9-in%9 %Ucommand%U:
301 Feed dau.pl with the output (the public message)
302 that %Ucommand%U produces
303
304 %9-out%9 %Ucommand%U:
305 %Utopic%U for example will set a dauified topic
306
307 %9--cool%9
308 Be \$cool[tm]!!!!11one
309
310 %9-eol_style%9 %Ustring%U:
311 Override setting dau_cool_eol_style
312
313 %9-max%9 %Un%U:
314 \$Trademarke[tm] only %Un%U words per line tops
315
316 %9-prob_eol%9 %U0-100%U:
317 Probability that "!!!11one" or something like that will be put at EOL.
318 Set it to 100 and every line will be.
319 Set it to 0 and no line will be.
320
321 %9-prob_word%9 %U0-100%U:
322 Probability that a word will be \$trademarked[tm].
323 Set it to 100 and every word will be.
324 Set it to 0 and no word will be.
325
326 %9--cowsay%9
327 Use cowsay to write
328
329 %9-arguments%9 %Uarguments%U:
330 Pass any option to cowsay, f.e. %U'-b'%U or %U'-e XX'%U.
331 Look in the cowsay manualpage for details.
332
333 %9-cow%9 %Ucow%U:
334 The cow to use
335
336 %9-think%9 %Uon|off%U:
337 Thinking instead of speaking
338
339 %9--create_files%9
340 Create files and directories of all dau_files_* settings
341
342 %9--daumode%9
343 Toggle daumode.
344 Works on a per channel basis!
345
346 %9-modes_in%9 %Umodes%U:
347 All incoming messages will be dauified and the
348 specified modes are used by dau.pl.
349
350 %9-modes_out%9 %Umodes%U:
351 All outgoing messages will be dauified and the
352 specified modes are used by dau.pl.
353
354 %9-perm%9 %U[01][01]%U:
355 Dauify incoming/outgoing messages?
356
357 %9--delimiter%9
358 Insert a delimiter-string after each character
359
360 %9-string%9 %Ustring%U:
361 Override setting dau_delimiter_string. If this string
362 contains whitespace, you should quote the string with
363 single quotes.
364
365 %9--dots%9
366 Put dots... after words...
367
368 %9--figlet%9
369 Use figlet to write
370
371 %9-font%9 %Ufont%U:
372 The font to use
373
374 %9--help%9
375 Print help
376
377 %9-setting%9 %Usetting%U:
378 More information about a specific setting
379
380 %9--leet%9
381 Write in leet speech
382
383 %9--long_help%9
384 Long help, i.e. examples, more about some features, ...
385
386 %9--me%9
387 Send a CTCP ACTION instead of a PRIVMSG
388
389 %9--mix%9
390 Mix all the characters in a word except for the first and last
391
392 %9--mixedcase%9
393 Write in mixed case
394
395 %9--moron%9
396 Write in uppercase, mix in some typos, perform some
397 substitutions on the text, ... Just write like a
398 moron
399
400 %9-eol_style%9 %Ustring%U:
401 Override setting dau_moron_eol_style
402
403 %9-level%9 %Un%U:
404 %Un%U gives the level of stupidity applied to text,
405 the higher the stupider.
406 %U0%U is the minimum, %U1%U currently only implemented for dau_language = de.
407
408 %9-omega%9 %Uon|off%U:
409 The fantastic omega mode
410
411 %9-typo%9 %Uon|off%U:
412 Mix in random typos
413
414 %9-uppercase%9 %Uon|off%U:
415 Uppercase text
416
417 %9--nothing%9
418 Do nothing
419
420 %9--parse_special%9
421 Parse for special metasequences and substitute them.
422
423 %9-irssi_variables%9 %Uon|off%U:
424 Parse irssi special variables like \$N
425
426 %9-list_delimiter%9 %Ustring%U:
427 Set the list delimiter used for \@nicks and \@opnicks to %Ustring%U.
428
429 The special metasequences are:
430
431 - \\n:
432 real newline
433 - \$nick1 .. \$nickN:
434 N different randomly selected nicks
435 - \@nicks:
436 All nicks in channel
437 - \$opnick1 .. \$opnickN:
438 N different randomly selected opnicks
439 - \@opnicks:
440 All nicks in channel with operator status
441 - \$?{ code }:
442 the (perl)code will be evaluated and the last expression
443 returned will replace that metasequence
444 - irssis special variables like \$C for the current
445 channel and \$N for your current nick
446
447 Quoting:
448
449 - \\\$: literal \$
450 - \\\\: literal \\
451
452 %9--random%9
453 Let dau.pl choose the options randomly. Get these options from the setting
454 dau_random_options.
455
456 %9-verbose%9 %Uon|off%U:
457 Print what options --random has chosen
458
459 %9--reverse%9
460 Reverse the input string
461
462 %9--stutter%9
463 Stutter a bit
464
465 %9--substitute%9
466 Apply own substitutions from file
467
468 %9--underline%9
469 Underline text
470
471 %9--uppercase%9
472 Write in upper case
473
474 %9--words%9
475 Only a few words each line
476 END
477
478 # Containing irssi's 'cmdchars'
479
480 our $k = Irssi::parse_special('$k');
481
482 # Remember your nick mode
483
484 our %nick_mode;
485
486 # All the options
487
488 our %option;
489
490 # print() the message or not?
491
492 our $print_message;
493
494 # Queue holding the switches
495
496 our %queue;
497
498 # Remember the last switches used by --random so that they don't repeat
499
500 our $random_last;
501
502 # Signals
503
504 our %signal = (
505 'complete word' => 0,
506 'daumode in' => 0,
507 'event 404' => 0,
508 'event privmsg' => 0,
509 'nick mode changed' => 0,
510 'send text' => 0,
511 );
512
513 # All switches that may be given at commandline
514
515 our %switches = (
516
517 # These switches may be combined
518
519 combo => {
520 boxes => { 'sub' => \&switch_boxes },
521 bracket => {
522 'sub' => \&switch_bracket,
523 left => { '*' => 1 },
524 right => { '*' => 1 },
525 },
526 chars => { 'sub' => \&switch_chars },
527 color => {
528 'sub' => \&switch_color,
529 codes => { '*' => 1 },
530 random => {
531 off => 1,
532 on => 1,
533 },
534 'split' => {
535 capitals => 1,
536 chars => 1,
537 lines => 1,
538 paragraph => 1,
539 rchars => 1,
540 words => 1,
541 },
542 },
543 command => {
544 'sub' => \&switch_command,
545 in => { '*' => 1 },
546 out => { '*' => 1 },
547 },
548 cool => {
549 'sub' => \&switch_cool,
550 eol_style => {
551 suffixes => 1,
552 exclamation_marks => 1,
553 random => 1,
554 },
555 max => { '*' => 1 },
556 prob_eol => { '*' => 1 },
557 prob_word => { '*' => 1 },
558 },
559 cowsay => {
560 'sub' => \&switch_cowsay,
561 arguments => { '*' => 1 },
562 think => {
563 off => 1,
564 on => 1,
565 },
566 },
567 delimiter => {
568 'sub' => \&switch_delimiter,
569 string => { '*' => 1 },
570 },
571 dots => { 'sub' => \&switch_dots },
572 figlet => { 'sub' => \&switch_figlet },
573 me => { 'sub' => \&switch_me },
574 mix => { 'sub' => \&switch_mix },
575 moron => {
576 'sub' => \&switch_moron,
577 eol_style => {
578 nothing => 1,
579 random => 1,
580 },
581 level => { '*' => 1 },
582 omega => {
583 off => 1,
584 on => 1,
585 },
586 typo => {
587 off => 1,
588 on => 1,
589 },
590 uppercase => {
591 off => 1,
592 on => 1,
593 },
594 },
595 leet => { 'sub' => \&switch_leet },
596 mixedcase => { 'sub' => \&switch_mixedcase },
597 nothing => { 'sub' => \&switch_nothing },
598 parse_special => {
599 'sub' => \&switch_parse_special,
600 irssi_variables => {
601 off => 1,
602 on => 1,
603 },
604 list_delimiter => { '*' => 1 },
605 },
606 'reverse' => { 'sub' => \&switch_reverse },
607 stutter => { 'sub' => \&switch_stutter },
608 substitute => { 'sub' => \&switch_substitute },
609 underline => { 'sub' => \&switch_underline },
610 uppercase => { 'sub' => \&switch_uppercase },
611 words => { 'sub' => \&switch_words },
612 },
613
614 # The following switches must not be combined
615
616 nocombo => {
617 away => {
618 'sub' => \&switch_away,
619 channels => { '*' => 1 },
620 interval => { '*' => 1 },
621 reminder => {
622 on => 1,
623 off => 1,
624 },
625 },
626 babble => {
627 'sub' => \&switch_babble,
628 at => { '*' => 1 },
629 cancel => {
630 on => 1,
631 off => 1,
632 },
633 filter => { '*' => 1 },
634 history_size => { '*' => 1 },
635 },
636 changelog => { 'sub' => \&switch_changelog },
637 create_files => { 'sub' => \&switch_create_files },
638 daumode => {
639 'sub' => \&switch_daumode,
640 modes_in => { '*' => 1 },
641 modes_out => { '*' => 1 },
642 perm => {
643 '00' => 1,
644 '01' => 1,
645 '10' => 1,
646 '11' => 1,
647 },
648 },
649 help => {
650 'sub' => \&switch_help,
651
652 # setting changed/added => change/add it here
653
654 setting => {
655 # boolean
656 dau_away_quote_reason => 1,
657 dau_away_reminder => 1,
658 dau_babble_verbose => 1,
659 dau_color_choose_colors_randomly => 1,
660 dau_cowsay_print_cow => 1,
661 dau_figlet_print_font => 1,
662 dau_silence => 1,
663 dau_statusbar_daumode_hide_when_off => 1,
664 dau_tab_completion => 1,
665
666 # Integer
667 dau_babble_history_size => 1,
668 dau_babble_verbose_minimum_lines => 1,
669 dau_cool_maximum_line => 1,
670 dau_cool_probability_eol => 1,
671 dau_cool_probability_word => 1,
672 dau_remote_babble_interval_accuracy => 1,
673
674 # String
675 dau_away_away_text => 1,
676 dau_away_back_text => 1,
677 dau_away_options => 1,
678 dau_away_reminder_interval => 1,
679 dau_away_reminder_text => 1,
680 dau_babble_options_line_by_line => 1,
681 dau_babble_options_preprocessing => 1,
682 dau_color_codes => 1,
683 dau_cool_eol_style => 1,
684 dau_cowsay_cowlist => 1,
685 dau_cowsay_cowpath => 1,
686 dau_cowsay_cowpolicy => 1,
687 dau_cowsay_cowsay_path => 1,
688 dau_cowsay_cowthink_path => 1,
689 dau_daumode_channels => 1,
690 dau_delimiter_string => 1,
691 dau_figlet_fontlist => 1,
692 dau_figlet_fontpath => 1,
693 dau_figlet_fontpolicy => 1,
694 dau_figlet_path => 1,
695 dau_files_away => 1,
696 dau_files_babble_messages => 1,
697 dau_files_cool_suffixes => 1,
698 dau_files_root_directory => 1,
699 dau_files_substitute => 1,
700 dau_language => 1,
701 dau_moron_eol_style => 1,
702 dau_parse_special_list_delimiter => 1,
703 dau_random_options => 1,
704 dau_remote_babble_channellist => 1,
705 dau_remote_babble_channelpolicy => 1,
706 dau_remote_babble_interval => 1,
707 dau_remote_channellist => 1,
708 dau_remote_channelpolicy => 1,
709 dau_remote_deop_reply => 1,
710 dau_remote_devoice_reply => 1,
711 dau_remote_op_reply => 1,
712 dau_remote_permissions => 1,
713 dau_remote_question_regexp => 1,
714 dau_remote_question_reply => 1,
715 dau_remote_voice_reply => 1,
716 dau_standard_messages => 1,
717 dau_standard_options => 1,
718 dau_words_range => 1,
719 },
720 },
721 long_help => { 'sub' => \&switch_long_help },
722 random => { 'sub' => \&switch_random,
723 verbose => {
724 off => 1,
725 on => 1,
726 },
727 },
728 },
729 );
730
731 ################################################################################
732 # Code run once at start
733 ################################################################################
734
735 print CLIENTCRAP "dau.pl $VERSION loaded. For help type %9${k}dau --help%9 or %9${k}dau --long_help%9";
736
737 signal_setup_changed();
738 build_nick_mode_struct();
739 signal_handling();
740
741 ################################################################################
742 # Subroutines (commands)
743 ################################################################################
744
745 sub command_dau {
746 my ($data, $server, $witem) = @_;
747 my $output;
748
749 $output = parse_text($data, $witem);
750
751 unless (defined($server) && $server && $server->{connected}) {
752 $print_message = 1;
753 }
754 unless ((defined($witem) && $witem &&
755 ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')))
756 {
757 $print_message = 1;
758 }
759
760 if ($daumode_activated) {
761
762 if (defined($witem) && $witem &&
763 ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'))
764 {
765 my $modes_set = 0;
766
767 # daumode set with parameters (modes_in)
768
769 if ($queue{0}{daumode}{modes_in}) {
770 $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1;
771 $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} =
772 $queue{0}{daumode}{modes_in};
773 $modes_set = 1;
774 }
775
776 # daumode set with parameters (modes_out)
777
778 if ($queue{0}{daumode}{modes_out}) {
779 $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1;
780 $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} =
781 $queue{0}{daumode}{modes_out};
782 $modes_set = 1;
783 }
784
785 # daumode set without parameters
786
787 if (!$daumode{channels_in}{$server->{tag}}{$witem->{name}} &&
788 !$daumode{channels_out}{$server->{tag}}{$witem->{name}} &&
789 !$modes_set)
790 {
791 $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1;
792 $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1;
793 $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = '';
794 $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = '';
795 }
796
797 # daumode unset
798
799 elsif (($daumode{channels_in}{$server->{tag}}{$witem->{name}} ||
800 $daumode{channels_out}{$server->{tag}}{$witem->{name}}) &&
801 !$modes_set)
802 {
803 $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 0;
804 $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 0;
805 $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = '';
806 $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = '';
807 }
808
809
810 # the perm-option overrides everything
811
812 # perm: 00
813
814 if ($queue{0}{daumode}{perm} eq '00') {
815 $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 0;
816 $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 0;
817 $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = '';
818 $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = '';
819 }
820
821 # perm: 01
822
823 if ($queue{0}{daumode}{perm} eq '01') {
824 $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 0;
825 $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1;
826 $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = '';
827 }
828
829 # perm: 10
830
831 if ($queue{0}{daumode}{perm} eq '10') {
832 $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1;
833 $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 0;
834 $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = '';
835 }
836
837 # perm: 11
838
839 if ($queue{0}{daumode}{perm} eq '11') {
840 $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1;
841 $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1;
842 }
843
844 Irssi::statusbar_items_redraw('daumode');
845 }
846
847 # Signal handling (for daumode and signal 'send text')
848
849 signal_handling();
850
851 return;
852 }
853
854 # MSG (or CTCP ACTION) $output to active channel/query-window
855
856 {
857 no strict 'refs';
858
859 $output = $output || '';
860 output_text($witem, $witem->{name}, $output);
861 }
862 }
863
864 ################################################################################
865 # Subroutines (switches, must not be combined)
866 ################################################################################
867
868 sub switch_away {
869 my ($reason, $channel_rec, $reminder, $interval) = @_;
870 my $output;
871 my $time;
872 my $status = 'away';
873
874 ################################################################################
875 ################################################################################
876 # Get and handle options
877 ################################################################################
878 ################################################################################
879
880 ################################################################################
881 # "/dau --away -interval <interval>" resp. dau_away_reminder_interval setting
882 ################################################################################
883
884 # If called from command line, i.e. not by the
885 # "/dau --away -channels '<channels>'" workaround, $interval will be defined
886 # here
887 if (!defined($interval)) {
888 $interval = time_parse(return_option('away', 'interval', $option{dau_away_reminder_interval}));
889 }
890 if ($interval < 10 || $interval > 1000000000) {
891 print_err('Invalid value for away timer!');
892 return;
893 }
894
895 ################################################################################
896 # setting dau_away_options
897 ################################################################################
898
899 my $options = return_random_list_item($option{dau_away_options});
900
901 ################################################################################
902 # "/dau --away -reminder <on|off>" resp. dau_away_reminder setting
903 ################################################################################
904
905 # If called from command line, i.e. not by "/dau --away -channels '<channels>'"
906 # workaround, $reminder will be defined here
907 if (!defined($reminder)) {
908 $reminder = return_option('away', 'reminder', $option{dau_away_reminder});
909 }
910
911 # on -> 1, off -> 0
912 if ($reminder eq 'on' || $reminder == 1) {
913 $reminder = 1;
914 } else {
915 $reminder = 0;
916 }
917
918 ################################################################################
919 # "/dau --away -channels '<channels>'"
920 ################################################################################
921
922 # Go through all channels and for each call this subroutine again with
923 # $reminder and $interval as additional parameter as those otherwise would be
924 # lost. Sad world.
925
926 my $channels = return_option('away', 'channels');
927 # If not deleted, the program may loop here.
928 undef($queue{0}{away}{channels});
929 while ($channels =~ m{([^/]+)/([^,]+),?\s*}g) {
930 my $channel = $1;
931 my $network = $2;
932
933 my $server_rec = Irssi::server_find_tag($network);
934 my $channel_rec = $server_rec->channel_find($channel);
935
936 if (defined($channel_rec) && $channel_rec &&
937 ($channel_rec->{type} eq 'CHANNEL' || $channel_rec->{type} eq 'QUERY'))
938 {
939 switch_away($reason, $channel_rec, $reminder, $interval);
940 }
941
942 }
943 # "/dau --away -channels '<channels>'" first run => exit
944 return if ($channels);
945
946 ################################################################################
947 # Now we are clear (from -channels)...
948 ################################################################################
949
950 # Normal "/dau --away" (i.e. no -channels), but called from non
951 # channel/query window => exit
952 unless (defined($channel_rec) && $channel_rec &&
953 ($channel_rec->{type} eq 'CHANNEL' || $channel_rec->{type} eq 'QUERY'))
954 {
955 return;
956 }
957
958 my $channel = $channel_rec->{name};
959 my $network = $channel_rec->{server}->{tag};
960 my $id = "$channel/$network";
961
962 ################################################################################
963 # Open file
964 ################################################################################
965
966 my $file = "$option{dau_files_root_directory}/$option{dau_files_away}";
967 my @file;
968 unless (tie(@file, 'Tie::File', $file)) {
969 print_err("Cannot tie $file!");
970 return;
971 }
972
973 ################################################################################
974 # Go through/edit file
975 ################################################################################
976
977 # Format:
978 # channel | network | time | options | reminder | interval | reason
979 my $i = 0;
980 foreach my $line (@file) {
981 if ($line =~ m{^\Q$channel\E\x02\Q$network\E\x02(\d+)\x02([^\x02]*)\x02(?:\d)\x02(?:\d+)\x02(.*)}) {
982 $time = $1;
983 $options = $2;
984 $reason = $3;
985 $status = 'back';
986 last;
987 }
988 $i++;
989 }
990
991 if ($status eq 'away' && $reason eq '') {
992 print_out('Please set reason for your being away!');
993 return;
994 }
995
996 if ($status eq 'away') {
997 push(@file, "$channel\x02$network\x02" . time . "\x02$options\x02$reminder\x02$interval\x02$reason");
998 $output = $option{dau_away_away_text};
999 }
1000
1001 if ($status eq 'back') {
1002 splice(@file, $i, 1);
1003 $output = $option{dau_away_back_text};
1004 }
1005
1006 ################################################################################
1007 # Special variables
1008 ################################################################################
1009
1010 # $time
1011
1012 if ($status eq 'back') {
1013 my $difference = time_diff_verbose(time, $time);
1014 $output =~ s/\$time/$difference/g;
1015 }
1016
1017 # $reason
1018
1019 if ($option{dau_away_quote_reason}) {
1020 $reason =~ s/\\/\\\\/g;
1021 $reason =~ s/\$/\\\$/g;
1022 }
1023 $output =~ s/\$reason/$reason/g;
1024
1025 ################################################################################
1026 # Write changes back to file
1027 ################################################################################
1028
1029 untie(@file);
1030
1031 ################################################################################
1032 # The reminder timer
1033 ################################################################################
1034
1035 if ($status eq 'away' && $reminder) {
1036 $away_timer{$id} = Irssi::timeout_add($interval, \&timer_away_reminder, $id);
1037 } else {
1038 Irssi::timeout_remove($away_timer{$id});
1039 }
1040
1041 ################################################################################
1042 # Print message to channel
1043 ################################################################################
1044
1045 $output = parse_text("$options $output", $channel_rec);
1046 output_text($channel_rec, $channel_rec->{name}, $output);
1047
1048 return;
1049 }
1050
1051 sub switch_babble {
1052 my ($data, $channel) = @_;
1053 my $text;
1054
1055 # Cancel babble?
1056
1057 if (lc(return_option('babble', 'cancel')) eq 'on') {
1058 if (defined($babble{timer_writing})) {
1059 Irssi::timeout_remove($babble{timer_writing});
1060 undef($babble{timer_writing});
1061
1062 if ($babble{remote}) {
1063 timer_remote_babble_reset();
1064 }
1065
1066 print_out("Babble cancelled.");
1067 }
1068 return;
1069 }
1070
1071 # Filters
1072
1073 my @filter = ();
1074 my $option_babble_at = return_option('babble', 'at');
1075 my $option_babble_filter = return_option('babble', 'filter');
1076 my $option_babble_history_size = return_option('babble', 'history_size', $option{dau_babble_history_size});
1077
1078 if ($option_babble_filter) {
1079 push(@filter, $option_babble_filter);
1080 }
1081
1082 # If something is babbling right now, exit
1083
1084 if (defined($babble{timer_writing})) {
1085 print_err("You are already babbling something!");
1086 return;
1087 }
1088
1089 # get text from file
1090
1091 if ($option_babble_at) {
1092 my @nicks;
1093 foreach my $nick (split(/\s*,\s*/, $option_babble_at)) {
1094 push(@nicks, $nick);
1095 }
1096 if (@nicks > 0) {
1097 for (my $i = 1; $i <= $#nicks + 1; $i++) {
1098 push(@filter, '\$nick' . $i);
1099 }
1100 }
1101
1102 $text = &babble_get_text($channel, \@filter, \@nicks, $option_babble_history_size);
1103 } else {
1104 $text = &babble_get_text($channel, \@filter, undef, $option_babble_history_size);
1105 }
1106
1107 # babble only in channels
1108
1109 unless (defined($channel) && $channel && $channel->{type} eq 'CHANNEL') {
1110 print_out('%9--babble%9 will only work in channel windows!');
1111 return;
1112 }
1113
1114 # Start the babbling
1115
1116 babble_start($channel, $text, 0);
1117
1118 return;
1119 }
1120
1121 sub switch_changelog {
1122 my $output;
1123 $print_message = 1;
1124
1125 $output = &fix(<<" END");
1126 CHANGELOG
1127
1128 2002-05-05 release 0.1.0
1129 initial release
1130
1131 2002-05-06 release 0.1.1
1132 maintenance release
1133
1134 2002-05-11 release 0.2.0
1135 new feature: %9--delimiter%9
1136
1137 2002-05-12 release 0.3.0
1138 new feature: %9--mixedcase%9
1139
1140 2002-05-17 release 0.4.0
1141 %9--delimiter%9 revised
1142
1143 2002-05-20 release 0.4.1
1144 some nice new substitutions for %9--moron%9
1145
1146 2002-05-24 release 0.5.0
1147 new settings for %9--figlet%9
1148
1149 2002-06-15 release 0.6.0
1150 new settings for %9--figlet%9
1151
1152 2002-06-16 release 0.6.1
1153 maintenance release
1154
1155 2002-06-16 release 0.6.2
1156 maintenance release
1157
1158 2002-06-17 release 0.7.0
1159 new stuff for %9--moron%9
1160
1161 2002-06-19 release 0.8.0
1162 new feature: %9--dots%9
1163
1164 2002-06-23 release 0.9.0
1165 new "reply to question" remote feature
1166
1167 2002-06-23 release 0.9.1
1168 maintenance release
1169
1170 2002-06-29 release 0.9.2
1171 maintenance release
1172
1173 2002-07-23 release 0.9.3
1174 maintenance release
1175
1176 2002-07-28 release 1.0.0
1177 - Tabcompletion for the switches
1178 - new feature: %9--changelog%9
1179 - new feature: %9--help%9
1180 - new feature: %9--leet%9
1181 - new feature: %9--reverse%9
1182
1183 2002-07-28 release 1.0.1
1184 maintenance release
1185
1186 2002-09-01 release 1.0.2
1187 maintenance release
1188
1189 2002-09-03 release 1.0.3
1190 new switch for %9--figlet%9: %9-font%9
1191
1192 2002-09-03 release 1.0.4
1193 maintenance release
1194
1195 2002-09-03 release 1.0.5
1196 maintenance release
1197
1198 2002-09-09 release 1.1.0
1199 You can combine switches now!
1200
1201 2002-11-22 release 1.2.0
1202 - new setting: %9dau_moron_eol_style%9
1203 - new setting: %9dau_standard_messages%9
1204 - new setting: %9dau_standard_options%9
1205 - new remote features: Say something on (de)op/(de)voice
1206 - new switch for %9--delimiter%9: %9-string%9
1207 - new switch for %9--moron%9: %9-eol_style%9
1208 - new feature: %9--color%9
1209 - new feature: %9--daumode%9
1210 - new feature: %9--random%9
1211 - new feature: %9--stutter%9
1212 - new feature: %9--uppercase%9
1213 - new statusbar item: %9daumode%9
1214
1215 2002-11-27 release 1.2.1
1216 maintenance release
1217
1218 2002-12-15 release 1.2.2
1219 maintenance release
1220
1221 2003-01-12 release 1.3.0
1222 - new setting: %9dau_files_root_directory%9
1223 - %9--moron%9: randomly transpose letters with letters
1224 next to them at the keyboard
1225 - new switch for %9--moron%9: %9-uppercase%9
1226 - new feature: %9--create_files%9
1227
1228 2003-01-17 release 1.4.0
1229 - %9--color%9 revised
1230 - new remote feature: babble
1231
1232 2003-01-18 release 1.4.1
1233 maintenance release
1234
1235 2003-01-20 release 1.4.2
1236 new setting: %9dau_statusbar_daumode_hide_when_off%9
1237
1238 2003-02-01 release 1.4.3
1239 maintenance release
1240
1241 2003-02-09 release 1.4.4
1242 maintenance release
1243
1244 2003-02-16 release 1.4.5
1245 maintenance release
1246
1247 2003-03-16 release 1.4.6
1248 maintenance release
1249
1250 2003-05-01 release 1.5.0
1251 - new setting: %9dau_tab_completion%9
1252 - new feature: %9--bracket%9
1253
1254 2003-06-13 release 1.5.1
1255 new feature: %9--underline%9
1256
1257 2003-07-16 release 1.5.2
1258 new feature: %9--boxes%9
1259
1260 2003-08-16 release 1.5.3
1261 maintenance release
1262
1263 2003-09-14 release 1.5.4
1264 maintenance release
1265
1266 2003-11-16 release 1.6.0
1267 - Incoming messages can be dauified now!
1268 - daumode statusbar item revised
1269
1270 2004-03-25 release 1.7.0
1271 - new setting: %9dau_babble_options_line_by_line%9
1272 - new setting: %9dau_files_babble_messages%9
1273 - new switch for %9--color%9: %9-split paragraph%9
1274 - new switch for %9--command%9: %9-in%9
1275 - new switch for %9--moron%9: %9-omega%9
1276 - new feature: %9--cowsay%9
1277 - new feature: %9--mix%9 (by Martin Kihlgren <zond\@troja.ath.cx>)
1278
1279 2004-04-01 release 1.7.1
1280 - new setting: %9dau_remote_babble_channellist%9
1281 - new setting: %9dau_remote_babble_channelpolicy%9
1282 - new setting: %9dau_remote_babble_interval_accuracy%9
1283
1284 2004-04-02 release 1.7.2
1285 maintenance release
1286
1287 2004-04-05 release 1.7.3
1288 maintenance release
1289
1290 2004-05-01 release 1.8.0
1291 - new feature: %9--babble%9
1292 - %9--help%9 revised
1293
1294 2004-06-24 release 1.8.1
1295 - new setting: %9dau_babble_verbose%9
1296 - new setting: %9dau_babble_verbose_minimum_lines%9
1297
1298 2004-07-10 release 1.8.2
1299 maintenance release
1300
1301 2004-07-25 release 1.8.3
1302 maintenance release
1303
1304 2004-09-14 release 1.8.4
1305 maintenance release
1306
1307 2004-10-18 release 1.8.5
1308 maintenance release
1309
1310 2004-11-07 release 1.8.6
1311 maintenance release
1312
1313 2005-01-28 release 1.9.0
1314 - new setting: %9dau_cowsay_cowthink_path%9
1315 - new switch for %9--cowsay%9: %9-arguments%9
1316 - new switch for %9--cowsay%9: %9-think%9
1317
1318 2005-06-05 release 2.0.0
1319 - new setting: %9dau_color_choose_colors_randomly%9
1320 - new setting: %9dau_color_codes%9
1321 - new setting: %9dau_language%9
1322 - new setting: %9dau_remote_question_regexp%9
1323 - new switch for %9--bracket%9: %9-left%9
1324 - new switch for %9--bracket%9: %9-right%9
1325 - new switch for %9--color%9: %9-codes%9
1326 - new switch for %9--color%9: %9-random%9
1327 - new switch for %9--color%9: %9-split capitals%9
1328 - new feature: %9--away%9
1329 - new feature: %9--cool%9
1330 - new feature: %9--long_help%9
1331 - new feature: %9--parse_special%9
1332
1333 2005-07-01 release 2.1.0
1334 - new switch for %9--babble%9: %9-at%9
1335 - %9--color%9: Support for background colors
1336 - %9--color -codes%9: You may use now the color names
1337 instead of the numeric color codes
1338
1339 2005-07-24 release 2.1.1
1340 maintenance release
1341
1342 2005-08-02 release 2.1.2
1343 maintenance release
1344
1345 2005-11-01 release 2.1.3
1346 maintenance release
1347
1348 2006-03-11 release 2.1.4
1349 maintenance release
1350
1351 2006-05-21 release 2.1.5
1352 new switch for %9--babble%9: %9-filter%9
1353
1354 2006-10-25 release 2.1.6
1355 new switch for %9--babble%9: %9-cancel%9
1356
1357 2006-11-25 release 2.2.0
1358 new feature: %9--substitute%9
1359
1360 2007-03-07 release 2.3.0
1361 - new setting: %9dau_daumode_channels%9
1362 - new switch for %9--moron%9: %9-level%9
1363 - new switch for %9--moron%9: %9-typo%9
1364 - new switch for %9--random%9: %9-verbose%9
1365
1366 2007-03-08 release 2.3.1
1367 maintenance release
1368
1369 2007-03-11 release 2.3.2
1370 maintenance release
1371
1372 2007-03-18 release 2.3.3
1373 maintenance release
1374
1375 2007-06-02 release 2.4.0
1376 - new setting: %9dau_babble_history_size%9
1377 - new switch for %9--babble%9: %9-history_size%9
1378
1379 2007-06-26 release 2.4.1
1380 maintenance release
1381
1382 2007-10-11 release 2.4.2
1383 maintenance release
1384
1385 2008-02-03 release 2.4.3
1386 maintenance release
1387 END
1388
1389 return $output;
1390 }
1391
1392 sub switch_create_files {
1393
1394 # create directory dau_files_root_directory if not found
1395
1396 if (-f $option{dau_files_root_directory}) {
1397 print_err("$option{dau_files_root_directory} is a _file_ => aborting");
1398 return;
1399 }
1400 if (-d $option{dau_files_root_directory}) {
1401 print_out('directory dau_files_root_directory already exists - no need to create it');
1402 } else {
1403 if (mkpath([$option{dau_files_root_directory}])) {
1404 print_out("creating directory $option{dau_files_root_directory}/");
1405 } else {
1406 print_err("failed creating directory $option{dau_files_root_directory}/");
1407 }
1408 }
1409
1410 # create file dau_files_substitute if not found
1411
1412 my $file1 = "$option{dau_files_root_directory}/$option{dau_files_substitute}";
1413
1414 if (-e $file1) {
1415
1416 print_out("file $file1 already exists - no need to create it");
1417
1418 } else {
1419
1420 if (open(FH1, "> $file1")) {
1421
1422 print FH1 &fix(<<' END');
1423 # dau.pl - http://dau.pl/
1424 #
1425 # This is the file --moron will use for your own substitutions.
1426 # You can use any perlcode in here.
1427 # $_ contains the text you can work with.
1428 # $_ has to contain the data to be returned to dau.pl at the end.
1429 END
1430
1431 print_out("$file1 created. you should edit it now!");
1432
1433 } else {
1434
1435 print_err("cannot write $file1: $!");
1436
1437 }
1438
1439 if (!close(FH1)) {
1440 print_err("cannot close $file1: $!");
1441 }
1442 }
1443
1444 # create file dau_files_babble_messages if not found
1445
1446 my $file2 = "$option{dau_files_root_directory}/$option{dau_files_babble_messages}";
1447
1448 if (-e $file2) {
1449
1450 print_out("file $file2 already exists - no need to create it");
1451
1452 } else {
1453
1454 if (open(FH1, "> $file2")) {
1455
1456 print FH1 &fix(<<' END');
1457 END
1458
1459 print_out("$file2 created. you should edit it now!");
1460
1461 } else {
1462
1463 print_err("cannot write $file2: $!");
1464
1465 }
1466
1467 if (!close(FH1)) {
1468 print_err("cannot close $file2: $!");
1469 }
1470 }
1471
1472 # create file dau_files_cool_suffixes if not found
1473
1474 my $file3 = "$option{dau_files_root_directory}/$option{dau_files_cool_suffixes}";
1475
1476 if (-e $file3) {
1477
1478 print_out("file $file3 already exists - no need to create it");
1479
1480 } else {
1481
1482 if (open(FH1, "> $file3")) {
1483
1484 print FH1 &fix(<<' END');
1485 END
1486
1487 print_out("$file3 created. you should edit it now!");
1488
1489 } else {
1490
1491 print_err("cannot write $file3: $!");
1492
1493 }
1494
1495 if (!close(FH1)) {
1496 print_err("cannot close $file3: $!");
1497 }
1498 }
1499
1500 return;
1501 }
1502
1503 sub switch_daumode {
1504 $daumode_activated = 1;
1505 }
1506
1507 sub switch_help {
1508 my $output;
1509 my $option_setting = return_option('help', 'setting');
1510 $print_message = 1;
1511
1512 if ($option_setting eq '') {
1513 $output = &fix(<<" END");
1514 %9OPTIONS%9
1515
1516 $help{options}
1517 END
1518 }
1519
1520 # setting changed/added => change/add them below
1521
1522 # boolean
1523
1524 elsif ($option_setting eq 'dau_away_quote_reason') {
1525 $output = &fix(<<" END");
1526 %9dau_away_quote_reason%9 %Ubool
1527
1528 If turned on, %9--parse_special%9 will not be able to replace
1529 variables which probably aren't one anyway.
1530 END
1531 }
1532 elsif ($option_setting eq 'dau_away_reminder') {
1533 $output = &fix(<<" END");
1534 %9dau_away_reminder%9 %Ubool
1535
1536 Turn the reminder message of %9--away%9 on or off.
1537 END
1538 }
1539 elsif ($option_setting eq 'dau_babble_verbose') {
1540 $output = &fix(<<" END");
1541 %9dau_babble_verbose%9 %Ubool
1542
1543 Before babbling print a message how many lines will be babbled and
1544 when finished a notification message.
1545 END
1546 }
1547 elsif ($option_setting eq 'dau_color_choose_colors_randomly') {
1548 $output = &fix(<<" END");
1549 %9dau_color_choose_colors_randomly%9 %Ubool
1550
1551 Choose colors randomly from setting dau_color_codes resp.
1552 %9--color -codes%9 or take one by one in the exact order given.
1553 END
1554 }
1555 elsif ($option_setting eq 'dau_cowsay_print_cow') {
1556 $output = &fix(<<" END");
1557 %9dau_cowsay_print_cow%9 %Ubool
1558
1559 Print a message which cow will be used.
1560 END
1561 }
1562 elsif ($option_setting eq 'dau_figlet_print_font') {
1563 $output = &fix(<<" END");
1564 %9dau_figlet_print_font%9 %Ubool
1565
1566 Print a message which font will be used.
1567 END
1568 }
1569 elsif ($option_setting eq 'dau_silence') {
1570 $output = &fix(<<" END");
1571 %9dau_silence%9 %Ubool
1572
1573 Don't print any information message. This does not include
1574 error messages.
1575 END
1576 }
1577 elsif ($option_setting eq 'dau_statusbar_daumode_hide_when_off') {
1578 $output = &fix(<<" END");
1579 %9dau_statusbar_daumode_hide_when_off%9 %Ubool
1580
1581 Hide statusbar item when daumode is turned off.
1582 END
1583 }
1584 elsif ($option_setting eq 'dau_tab_completion') {
1585 $output = &fix(<<" END");
1586 %9dau_tab_completion%9 %Ubool
1587
1588 Perhaps someone wants to disable TAB completion for the
1589 ${k}dau-command because he/she doesn't like it or wants
1590 to give the CPU a break (don't know whether it has much
1591 influence)
1592 END
1593 }
1594
1595 # Integer
1596
1597 elsif ($option_setting eq 'dau_babble_history_size') {
1598 $output = &fix(<<" END");
1599 %9dau_babble_history_size%9 %Uinteger
1600
1601 Number of lines to store in the babble history.
1602 dau.pl will babble no line the history is holding.
1603 END
1604 }
1605 elsif ($option_setting eq 'dau_babble_verbose_minimum_lines') {
1606 $output = &fix(<<" END");
1607 %9dau_babble_verbose_minimum_lines%9 %Uinteger
1608
1609 Minimum lines necessary to produce the output of the verbose
1610 information.
1611 END
1612 }
1613 elsif ($option_setting eq 'dau_cool_maximum_line') {
1614 $output = &fix(<<" END");
1615 %9dau_cool_maximum_line%9 %Uinteger
1616
1617 Trademarke[tm] or do \$this only %Un%U words per line tops.
1618 END
1619 }
1620 elsif ($option_setting eq 'dau_cool_probability_eol') {
1621 $output = &fix(<<" END");
1622 %9dau_cool_probability_eol%9 %Uinteger
1623
1624 Probability that "!!!11one" or something like that will be put at EOL.
1625 Set it to 100 and every line will be.
1626 Set it to 0 and no line will be.
1627 END
1628 }
1629 elsif ($option_setting eq 'dau_cool_probability_word') {
1630 $output = &fix(<<" END");
1631 %9dau_cool_probability_word%9 %Uinteger
1632
1633 Probability that a word will be trademarked[tm].
1634 Set it to 100 and every word will be.
1635 Set it to 0 and no word will be.
1636 END
1637 }
1638 elsif ($option_setting eq 'dau_remote_babble_interval_accuracy') {
1639 $output = &fix(<<" END");
1640 %9dau_remote_babble_interval_accuracy%9 %Uinteger
1641
1642 Value expressed as a percentage how accurate the timer of
1643 the babble feature should be.
1644
1645 Legal values: 1-100
1646
1647 %U100%U would result in a very accurate timer.
1648 END
1649 }
1650
1651 # String
1652
1653 elsif ($option_setting eq 'dau_away_away_text') {
1654 $output = &fix(<<" END");
1655 %9dau_away_away_text%9 %Ustring
1656
1657 The text to say when using %9--away%9.
1658
1659 Special Variables:
1660
1661 \$reason: Your away reason.
1662 END
1663 }
1664 elsif ($option_setting eq 'dau_away_back_text') {
1665 $output = &fix(<<" END");
1666 %9dau_away_back_text%9 %Ustring
1667
1668 The text to say when you return.
1669
1670 Special Variables:
1671
1672 \$reason: Your away reason.
1673 \$time: The time you've been away.
1674 END
1675 }
1676 elsif ($option_setting eq 'dau_away_reminder_interval') {
1677 $output = &fix(<<" END");
1678 %9dau_away_reminder_interval%9 %Ustring
1679
1680 Remind the channel that you're away! Repeat the message
1681 in the given interval.
1682 END
1683 }
1684 elsif ($option_setting eq 'dau_away_reminder_text') {
1685 $output = &fix(<<" END");
1686 %9dau_away_reminder_text%9 %Ustring
1687
1688 The text to say when you remind the channel that you're away.
1689
1690 Special Variables:
1691
1692 \$reason: Your away reason.
1693 \$time: The time you've been away.
1694 END
1695 }
1696 elsif ($option_setting eq 'dau_away_options') {
1697 $output = &fix(<<" END");
1698 %9dau_away_options%9 %Ustring
1699
1700 Options %9--away%9 will use.
1701 END
1702 }
1703 elsif ($option_setting eq 'dau_babble_options_line_by_line') {
1704 $output = &fix(<<" END");
1705 %9dau_babble_options_line_by_line%9 %Ustring
1706
1707 One single babble may contain several lines. The options
1708 specified in this setting are used for every line.
1709 END
1710 }
1711 elsif ($option_setting eq 'dau_babble_options_preprocessing') {
1712 $output = &fix(<<" END");
1713 %9dau_babble_options_preprocessing%9 %Ustring
1714
1715 The options specified in this setting are applied to the
1716 whole babble before anything else. Later, the options of
1717 the setting %9dau_babble_options_line_by_line%9 are
1718 applied to every line of the babble.
1719 END
1720 }
1721 elsif ($option_setting eq 'dau_color_codes') {
1722 $output = &fix(<<" END");
1723 %9dau_color_codes%9 %Ustring
1724
1725 Specify the color codes to use, seperated by semicolons.
1726 Example: %Ugreen; red; blue%U. You may use the color code (one
1727 or two digits) or the color names. So either
1728 %U2%U or %Ublue%U is ok. You can set a background color too:
1729 %Ured,green%U and you will write with red on a green
1730 background.
1731 For a complete list of the color codes and names look at
1732 formats.txt in the irssi documentation.
1733 END
1734 }
1735 elsif ($option_setting eq 'dau_cool_eol_style') {
1736 $output = &fix(<<" END");
1737 %9dau_cool_eol_style%9 %Ustring
1738
1739 %Uexclamation_marks%U: !!!11one
1740 %Urandom%U: Choose one style randomly
1741 %Usuffixes%U: Suffixes from file
1742 END
1743 }
1744 elsif ($option_setting eq 'dau_cowsay_cowlist') {
1745 $output = &fix(<<" END");
1746 %9dau_cowsay_cowlist%9 %Ustring
1747
1748 Comma separated list of cows. Checkout
1749 %9${k}dau --help -setting dau_cowsay_cowpolicy%9
1750 to see what this setting is good for.
1751 END
1752 }
1753 elsif ($option_setting eq 'dau_cowsay_cowpath') {
1754 $output = &fix(<<" END");
1755 %9dau_cowsay_cowpath%9 %Ustring
1756
1757 Path to the cowsay-cows (*.cow).
1758 END
1759 }
1760 elsif ($option_setting eq 'dau_cowsay_cowpolicy') {
1761 $output = &fix(<<" END");
1762 %9dau_cowsay_cowpolicy%9 %Ustring
1763
1764 Specifies the policy used to handle the cows in
1765 dau_cowsay_cowpath. If set to %Uallow%U, all cows available
1766 will be used by the command. You can exclude some cows by
1767 setting dau_cowsay_cowlist. If set to %Udeny%U, no cows but
1768 the ones listed in dau_cowsay_cowlist will be used by the
1769 command. Useful if you have many annoying cows in your
1770 cowpath and you want to permit only a few of them.
1771 END
1772 }
1773 elsif ($option_setting eq 'dau_cowsay_cowsay_path') {
1774 $output = &fix(<<" END");
1775 %9dau_cowsay_cowsay_path%9 %Ustring
1776
1777 Should point to the cowsay executable.
1778 END
1779 }
1780 elsif ($option_setting eq 'dau_cowsay_cowthink_path') {
1781 $output = &fix(<<" END");
1782 %9dau_cowsay_cowthink_path%9 %Ustring
1783
1784 Should point to the cowthink executable.
1785 END
1786 }
1787 elsif ($option_setting eq 'dau_daumode_channels') {
1788 $output = &fix(<<" END");
1789 %9dau_daumode_channels%9 %U<channel>/<network>:<switches>, ...%U
1790
1791 Automatically enable the daumode for some channels.
1792 %U#foo/bar:-modes_out '--substitute'%U would automatically
1793 set the daumode on #foo in network bar to modify outgoing
1794 messages with --substitute.
1795 END
1796 }
1797 elsif ($option_setting eq 'dau_delimiter_string') {
1798 $output = &fix(<<" END");
1799 %9dau_delimiter_string%9 %Ustring
1800
1801 Tell %9--delimiter%9 which delimiter to use.
1802 END
1803 }
1804 elsif ($option_setting eq 'dau_figlet_fontlist') {
1805 $output = &fix(<<" END");
1806 %9dau_figlet_fontlist%9 %Ustring
1807
1808 Comma separated list of fonts. Checkout
1809 %9${k}dau --help -setting dau_figlet_fontpolicy%9
1810 to see what this setting is good for. Use the program
1811 `showfigfonts` shipped with figlet to find these fonts.
1812 END
1813 }
1814 elsif ($option_setting eq 'dau_figlet_fontpath') {
1815 $output = &fix(<<" END");
1816 %9dau_figlet_fontpath%9 %Ustring
1817
1818 Path to the figlet-fonts (*.flf).
1819 END
1820 }
1821 elsif ($option_setting eq 'dau_figlet_fontpolicy') {
1822 $output = &fix(<<" END");
1823 %9dau_figlet_fontpolicy%9 %Ustring
1824
1825 Specifies the policy used to handle the fonts in
1826 dau_figlet_fontpath. If set to %Uallow%U, all fonts available
1827 will be used by the command. You can exclude some fonts by
1828 setting dau_figlet_fontlist. If set to %Udeny%U, no fonts but
1829 the ones listed in dau_figlet_fontlist will be used by the
1830 command. Useful if you have many annoying fonts in your
1831 fontpath and you want to permit only a few of them.
1832 END
1833 }
1834 elsif ($option_setting eq 'dau_figlet_path') {
1835 $output = &fix(<<" END");
1836 %9dau_figlet_path%9 %Ustring
1837
1838 Should point to the figlet executable.
1839 END
1840 }
1841 elsif ($option_setting eq 'dau_files_away') {
1842 $output = &fix(<<" END");
1843 %9dau_files_away%9 %Ustring
1844
1845 The file with the away messages.
1846 _Must_ be in dau_files_root_directory.
1847 END
1848 }
1849 elsif ($option_setting eq 'dau_files_babble_messages') {
1850 $output = &fix(<<" END");
1851 %9dau_files_babble_messages%9 %Ustring
1852
1853 The file with the babble messages.
1854 _Must_ be in dau_files_root_directory.
1855 %9${k}dau --create_files%9 will create it.
1856
1857 Format of the file: Newline separated plain text.
1858 The text will be sent through %9--parse_special%9 as well.
1859 END
1860 }
1861 elsif ($option_setting eq 'dau_files_cool_suffixes') {
1862 $output = &fix(<<" END");
1863 %9dau_files_cool_suffixes%9 %Ustring
1864
1865 %9--cool%9 takes randomly one line out of this file
1866 and puts it at the end of the line.
1867 This file _must_ be in dau_files_root_directory.
1868 %9${k}dau --create_files%9 will create it.
1869
1870 Format of the file: Newline separated plain text.
1871 END
1872 }
1873 elsif ($option_setting eq 'dau_files_root_directory') {
1874 $output = &fix(<<" END");
1875 %9dau_files_root_directory%9 %Ustring
1876
1877 Directory in which all files for dau.pl will be stored.
1878 %9${k}dau --create_files%9 will create it.
1879 END
1880 }
1881 elsif ($option_setting eq 'dau_files_substitute') {
1882 $output = &fix(<<" END");
1883 %9dau_files_substitute%9 %Ustring
1884
1885 Your own substitutions file. _Must_ be in
1886 dau_files_root_directory.
1887 %9${k}dau --create_files%9 will create it.
1888 END
1889 }
1890 elsif ($option_setting eq 'dau_language') {
1891 $output = &fix(<<" END");
1892 %9dau_language%9 %Ustring
1893
1894 %Ude%U: If you are writing in german
1895 %Uen%U: If you are writing in english
1896 END
1897 }
1898 elsif ($option_setting eq 'dau_moron_eol_style') {
1899 $output = &fix(<<" END");
1900 %9dau_moron_eol_style%9 %Ustring
1901
1902 What to do at End Of Line?
1903
1904 %Urandom%U:
1905 - !!!??!!!!!????!??????????!!!1
1906 - =
1907 ?
1908 - ?¿?
1909 %Unothing%U: do nothing
1910 END
1911 }
1912 elsif ($option_setting eq 'dau_parse_special_list_delimiter') {
1913 $output = &fix(<<" END");
1914 %9dau_parse_special_list_delimiter%9 %Ustring
1915
1916 Set the list delimiter used for \@nicks and \@opnicks to %Ustring%U.
1917 END
1918 }
1919 elsif ($option_setting eq 'dau_random_options') {
1920 $output = &fix(<<" END");
1921 %9dau_random_options%9 %Ustring
1922
1923 Comma separated list of options %9--random%9 will use. It will
1924 take randomly one item of the list. If you set it f.e. to
1925 %U--uppercase --color,--mixedcase%U,
1926 the probability of printing a colored, uppercased string hello
1927 will be 50% as well as the probabilty of printing a mixedcased
1928 string hello when typing %9${k}dau --random hello%9.
1929 END
1930 }
1931 elsif ($option_setting eq 'dau_remote_babble_channellist') {
1932 $output = &fix(<<" END");
1933 %9dau_remote_babble_channellist%9 %Ustring
1934
1935 Comma separated list of channels. You'll have to specify the
1936 ircnet too.
1937 Format: #channel1/IRCNet,#channel2/EFnet
1938 END
1939 }
1940 elsif ($option_setting eq 'dau_remote_babble_channelpolicy') {
1941 $output = &fix(<<" END");
1942 %9dau_remote_babble_channelpolicy%9 %Ustring
1943
1944 Using the default policy %Udeny%U the script won't do anything
1945 except in the channels listed in dau_remote_babble_channellist.
1946 Using the policy %Uallow%U the script will babble in all
1947 channels but the ones listed in dau_remote_babble_channellist.
1948 END
1949 }
1950 elsif ($option_setting eq 'dau_remote_babble_interval') {
1951 $output = &fix(<<" END");
1952 %9dau_remote_babble_interval%9 %Ustring
1953
1954 dau.pl will babble text in the given interval.
1955 END
1956 }
1957 elsif ($option_setting eq 'dau_remote_channellist') {
1958 $output = &fix(<<" END");
1959 %9dau_remote_channellist%9 %Ustring
1960
1961 Comma separated list of channels. You'll have to specify the
1962 ircnet too.
1963 Format: #channel1/IRCNet,#channel2/EFnet
1964 END
1965 }
1966 elsif ($option_setting eq 'dau_remote_channelpolicy') {
1967 $output = &fix(<<" END");
1968 %9dau_remote_channelpolicy%9 %Ustring
1969
1970 Using the default policy %Udeny%U the script won't do anything
1971 except in the channels listed in dau_remote_channellist. Using
1972 the policy %Uallow%U the script will reply to all channels but
1973 the ones listed in dau_remote_channellist.
1974 END
1975 }
1976 elsif ($option_setting eq 'dau_remote_deop_reply') {
1977 $output = &fix(<<" END");
1978 %9dau_remote_deop_reply%9 %Ustring
1979
1980 Comma separated list of messages (it will take randomly one
1981 item of the list) sent to channel if someone deops you (mode
1982 change -o).
1983 The string given will be processed by the same subroutine
1984 parsing the %9${k}dau%9 command.
1985
1986 Special Variables:
1987
1988 \$nick: contains the nick of the one who changed the mode
1989 END
1990 }
1991 elsif ($option_setting eq 'dau_remote_devoice_reply') {
1992 $output = &fix(<<" END");
1993 %9dau_remote_devoice_reply%9 %Ustring
1994
1995 Comma separated list of messages (it will take randomly one
1996 item of the list) sent to channel if someone devoices you (mode
1997 change -v).
1998 The string given will be processed by the same subroutine
1999 parsing the %9${k}dau%9 command.
2000
2001 Special Variables:
2002
2003 \$nick: contains the nick of the one who changed the mode
2004 END
2005 }
2006 elsif ($option_setting eq 'dau_remote_op_reply') {
2007 $output = &fix(<<" END");
2008 %9dau_remote_op_reply%9 %Ustring
2009
2010 Comma separated list of messages (it will take randomly one
2011 item of the list) sent to channel if someone ops you (mode
2012 change +o).
2013 The string given will be processed by the same subroutine
2014 parsing the %9${k}dau%9 command.
2015
2016 Special Variables:
2017
2018 \$nick: contains the nick of the one who changed the mode
2019 END
2020 }
2021 elsif ($option_setting eq 'dau_remote_permissions') {
2022 $output = &fix(<<" END");
2023 %9dau_remote_permissions%9 %U[01][01][01][01][01][01]
2024
2025 Permit or forbid the remote features.
2026
2027 First Bit:
2028 Reply to question
2029
2030 Second Bit:
2031 If someone gives you voice in a channel, thank him!
2032
2033 Third Bit:
2034 If someone gives you op in a channel, thank him!
2035
2036 Fourth Bit:
2037 If devoiced, print message
2038
2039 Fifth Bit:
2040 If deopped, print message
2041
2042 Sixth Bit:
2043 Babble text in certain intervals
2044 END
2045 }
2046 elsif ($option_setting eq 'dau_remote_question_regexp') {
2047 $output = &fix(<<" END");
2048 %9dau_remote_question_regexp%9 %Ustring
2049
2050 If someone says something matching that regular expression,
2051 act accordingly.
2052 The regexp will be sent through %9--parse_special%9.
2053 Because of that you will have to escape some characters, f.e.
2054 \\s to \\\\s for whitespace.
2055 END
2056 }
2057 elsif ($option_setting eq 'dau_remote_question_reply') {
2058 $output = &fix(<<" END");
2059 %9dau_remote_question_reply%9 %Ustring
2060
2061 Comma separated list of reply strings for the question of
2062 setting dau_remote_question_regexp (it will randomly choose one
2063 item of the list).
2064 The string given will be processed by the same subroutine
2065 parsing the %9${k}dau%9 command.
2066
2067 Special Variables:
2068
2069 \$nick: contains the nick of the one who sent the message to which
2070 dau.pl reacts
2071 END
2072 }
2073 elsif ($option_setting eq 'dau_remote_voice_reply') {
2074 $output = &fix(<<" END");
2075 %9dau_remote_voice_reply%9 %Ustring
2076
2077 Comma separated list of messages (it will take randomly one
2078 item of the list) sent to channel if someone voices you (mode
2079 change +v).
2080 The string given will be processed by the same subroutine
2081 parsing the %9${k}dau%9 command.
2082
2083 Special Variables:
2084
2085 \$nick: contains the nick of the one who changed the mode
2086 END
2087 }
2088 elsif ($option_setting eq 'dau_standard_messages') {
2089 $output = &fix(<<" END");
2090 %9dau_standard_messages%9 %Ustring
2091
2092 Comma separated list of strings %9${k}dau%9 will use if the user
2093 omits the text on the commandline.
2094 END
2095 }
2096 elsif ($option_setting eq 'dau_standard_options') {
2097 $output = &fix(<<" END");
2098 %9dau_standard_options%9 %Ustring
2099
2100 Options %9${k}dau%9 will use if the user omits them on the commandline.
2101 END
2102 }
2103 elsif ($option_setting eq 'dau_words_range') {
2104 $output = &fix(<<" END");
2105 %9dau_words_range%9 %Ui-j
2106
2107 Setup the range howmany words the command should write per line.
2108 1 <= i <= j <= 9; i, j element { 1, ... , 9 }. If i == j the command
2109 will write i words to the active window. Else it takes a random
2110 number k (element { i, ... , j }) and writes k words per
2111 line.
2112 END
2113 }
2114
2115 return $output;
2116 }
2117
2118 sub switch_long_help {
2119 my $output;
2120 $print_message = 1;
2121
2122 $output = &fix(<<" END");
2123 %9SYNOPSIS%9
2124
2125 %9${k}dau [%Uoptions%U] [%Utext%U%9]
2126
2127 %9DESCRIPTION%9
2128
2129 dau? What does that mean? It's a german acronym for %9d%9ümmster
2130 %9a%9nzunehmender %9u%9ser. In english: stupidest imaginable user.
2131
2132 With dau.pl every person can write like an idiot on the IRC!
2133
2134 %9OPTIONS%9
2135
2136 $help{options}
2137 %9EXAMPLES%9
2138
2139 %9${k}dau --uppercase --mixedcase %Ufoo bar baz%9
2140 Will write %Ufoo bar baz%U in mixed case.
2141 %Ufoo bar baz%U is sent _first_ to %9--uppercase%9, _then_ to
2142 %9--mixedcase%9.
2143 The order in which you put the options on the commandline is
2144 important!
2145 You can see what output a command produces without sending it to
2146 the active channel/query by sending it to a non-channel/query
2147 window.
2148
2149 %9${k}dau --color --figlet %Ufoo bar baz%9
2150 %9--color%9 is the first to be run and thus color codes will
2151 be inserted.
2152 The string will look like %U\\00302f\\00303o[...]%U when leaving
2153 %9--color%9.
2154 %9--figlet%9 uses then that string as its input.
2155 So you'll have finally an output like
2156 %U02f03o[...]%U in the figlet letters.
2157 You'll probably want to use %9--figlet --color%9 instead.
2158
2159 %9SPECIAL FEATURES%9
2160
2161 %9Combine the options%9
2162 You can combine most of the options! So you can write colored
2163 leet messages f.e.. Look in the EXAMPLES section above.
2164
2165 %9Babble%9
2166 dau.pl will babble text for you. It can do this on its own
2167 in certain intervals or forced by the user using %9--babble%9.
2168
2169 Related settings:
2170
2171 %9dau_babble_options_line_by_line%9
2172 %9dau_files_babble_messages%9
2173 %9dau_files_root_directory%9
2174 %9dau_remote_babble_channellist%9
2175 %9dau_remote_babble_channelpolicy%9
2176 %9dau_remote_babble_interval%9
2177 %9dau_remote_babble_interval_accuracy%9
2178 %9dau_remote_permissions%9
2179
2180 Related switches:
2181
2182 %9--babble%9
2183 %9--create_files%9
2184
2185 %9Daumode%9
2186 Dauify incoming and/or outgoing messages.
2187
2188 There is a statusbar item available displaying the current
2189 status of the daumode. Add it with
2190 %9/statusbar <bar> add [-alignment <left|right>] daumode%9
2191 You may customize the look of the statusbar item in the
2192 theme file:
2193
2194 sb_daumode = "{sb daumode I: \$0 (\$1) O: \$2 (\$3)}";
2195
2196 # \$0: will incoming messages be dauified?
2197 # \$1: modes for incoming messages
2198 # \$2: will outgoing messages be dauified?
2199 # \$3: modes for outgoing messages
2200
2201 %9Remote features%9
2202 Don't worry, dau.pl won't do anything automatically unless you
2203 unlock these features!
2204
2205 %9Babble%9
2206 dau.pl will babble text for you in certain intervals.
2207
2208 %9Reply to a question%9
2209 Answer a question as a moron would.
2210
2211 Related settings:
2212
2213 %9dau_remote_channellist%9
2214 %9dau_remote_channelpolicy%9
2215 %9dau_remote_permissions%9
2216 %9dau_remote_question_regexp%9
2217 %9dau_remote_question_reply%9
2218
2219 %9Say something on (de)op/(de)voice%9
2220 Related settings:
2221
2222 %9dau_remote_channellist%9
2223 %9dau_remote_channelpolicy%9
2224 %9dau_remote_deop_reply%9
2225 %9dau_remote_devoice_reply%9
2226 %9dau_remote_op_reply%9
2227 %9dau_remote_permissions%9
2228 %9dau_remote_voice_reply%9
2229
2230 %9TAB Completion%9
2231 There is a really clever TAB Completion included! Since
2232 commands can get very long you definitely want to use it.
2233 It will only complete syntactically correct commands so the
2234 TAB Completion isn't only a time saver, it's a control
2235 instance too. You'll be suprised to see that it even completes
2236 the figlet fonts and cows for cowsay that are available on
2237 your system.
2238
2239 %9Website%9
2240 $IRSSI{url}:
2241 Additional information, DAU.pm, the dauomat and the dauproxy.
2242 END
2243
2244 return $output;
2245 }
2246
2247 sub switch_random {
2248 my ($data, $channel_rec) = @_;
2249 my $output;
2250 my (@options, $opt, $text);
2251
2252 # Push each item of dau_random_options in the @options array.
2253
2254 while ($option{dau_random_options} =~ /\s*([^,]+)\s*,?/g) {
2255 my $item = $1;
2256 push @options, $item;
2257 }
2258
2259 # More than one item in @options. Choose one randomly but exclude
2260 # the last item chosen.
2261
2262 if (@options > 1) {
2263 @options = grep { $_ ne $random_last } @options;
2264 $opt = @options[rand(@options)];
2265 $random_last = $opt;
2266 }
2267
2268 # Exact one item in @options - take that
2269
2270 elsif (@options == 1) {
2271 $opt = $options[0];
2272 $random_last = $opt;
2273 }
2274
2275
2276 # No item in @options - call switch_moron()
2277
2278 else {
2279 $opt = '--moron';
2280 }
2281
2282 # dauify it!
2283
2284 unless (lc(return_option('random', 'verbose')) eq 'off') {
2285 print_out("%9--random%9 has chosen %9$opt%9", $channel_rec);
2286 }
2287 $text .= $opt . ' ' . $data;
2288 $output = parse_text($text, $channel_rec);
2289
2290 return $output;
2291 }
2292
2293 ################################################################################
2294 # Subroutines (switches, may be combined)
2295 ################################################################################
2296
2297 sub switch_boxes {
2298 my $data = shift;
2299
2300 # handling punctuation marks:
2301 # they will be put in their own box later
2302
2303 $data =~ s%(\w+)([,.?!;:]+)%
2304 $1 . ' ' . join(' ', split(//, $2))
2305 %egx;
2306
2307 # separate words (by whitespace) and put them in a box
2308
2309 $data =~ s/(\s*)(\S+)(\s*)/$1\[$2\]$3/g;
2310
2311 return $data;
2312 }
2313
2314 sub switch_bracket {
2315 my $data = shift;
2316 my $output;
2317
2318 my $option_left = return_option('bracket', 'left');
2319 my $option_right = return_option('bracket', 'right');
2320
2321 my %brackets = (
2322 '((' => '))',
2323 '-=(' => ')=-',
2324 '-=[' => ']=-',
2325 '-={' => '}=-',
2326 '-=|(' => ')|=-',
2327 '-=|[' => ']|=-',
2328 '-=|{' => '}|=-',
2329 '.:>' => '<:.',
2330 );
2331
2332 foreach (keys %brackets) {
2333 for my $times (2 .. 3) {
2334 my $pre = $_;
2335 my $post = $brackets{$_};
2336 $pre =~ s/(.)/$1 x $times/eg;
2337 $post =~ s/(.)/$1 x $times/eg;
2338
2339 $brackets{$pre} = $post;
2340 }
2341 }
2342
2343 $brackets{'!---?['} = ']?---!';
2344 $brackets{'(qp=>'} = '<=qp)';
2345 $brackets{'----->'} = '<-----';
2346
2347 my ($left, $right);
2348 if ($option_left && $option_right) {
2349 $left = $option_left;
2350 $right = $option_right;
2351 } else {
2352 $left = (keys(%brackets))[int(rand(keys(%brackets)))];
2353 $right = $brackets{$left};
2354 }
2355
2356 $output = "$left $data $right";
2357
2358 return $output;
2359 }
2360
2361 sub switch_chars {
2362 my $data = shift;
2363 my $output;
2364
2365 foreach my $char (split //, $data) {
2366 $output .= "$char\n";
2367 }
2368 return $output;
2369 }
2370
2371 sub switch_command {
2372 my ($data, $channel_rec) = @_;
2373
2374 # -out <command>
2375
2376 $command_out = return_option('command', 'out');
2377 $command_out_activated = 1;
2378
2379 # -in <command>
2380
2381 $command_in = '';
2382 my $option_command_in = return_option('command', 'in');
2383
2384 if ($option_command_in) {
2385 return unless (defined($channel_rec) && $channel_rec);
2386
2387 # Deactivate daumode for a brief moment
2388 $signal{'send text'} = 0;
2389 Irssi::signal_remove('send text', 'signal_send_text');
2390
2391 # Capture the output
2392 Irssi::signal_add_first('command msg', 'signal_command_msg');
2393 $channel_rec->command("$option_command_in $data");
2394 Irssi::signal_remove('command msg', 'signal_command_msg');
2395
2396 # Reactivate daumode
2397 signal_handling();
2398
2399 return $command_in;
2400 }
2401
2402 return $data;
2403 }
2404
2405 sub switch_color {
2406 my $data = shift;
2407 my (@all_colors, @colors, $output, $split);
2408
2409 ################################################################################
2410 # Hack to support UTF-8
2411 ################################################################################
2412
2413 if (Irssi::settings_get_str('term_charset') =~ /utf-?8/i) {
2414 eval {
2415 require Encode;
2416 $data = Encode::decode("utf-8", $data);
2417 };
2418 }
2419
2420 ################################################################################
2421 # Get options
2422 ################################################################################
2423
2424 my $option_color_split = return_option('color', 'split', 'words');
2425 my $option_color_codes = return_option('color', 'codes', $option{dau_color_codes});
2426 my $option_color_random = return_option('color', 'random', $option{dau_color_choose_colors_randomly});
2427 if ($option_color_random eq 'on' || $option_color_random == 1) {
2428 $option_color_random = 1;
2429 } else {
2430 $option_color_random = 0;
2431 }
2432
2433 ################################################################################
2434 # color name -> color code
2435 ################################################################################
2436
2437 $option_color_codes =~ s/\blight green\b/09/gi;
2438 $option_color_codes =~ s/\bgreen\b/03/gi;
2439 $option_color_codes =~ s/\blight red\b/04/gi;
2440 $option_color_codes =~ s/\bred\b/05/gi;
2441 $option_color_codes =~ s/\blight cyan\b/11/gi;
2442 $option_color_codes =~ s/\bcyan\b/10/gi;
2443 $option_color_codes =~ s/\blight blue\b/12/gi;
2444 $option_color_codes =~ s/\bblue\b/02/gi;
2445 $option_color_codes =~ s/\blight magenta\b/13/gi;
2446 $option_color_codes =~ s/\bmagenta\b/06/gi;
2447 $option_color_codes =~ s/\blight grey\b/15/gi;
2448 $option_color_codes =~ s/\bgrey\b/14/gi;
2449
2450 $option_color_codes =~ s/\bwhite\b/00/gi;
2451 $option_color_codes =~ s/\bblack\b/01/gi;
2452 $option_color_codes =~ s/\borange\b/07/gi;
2453 $option_color_codes =~ s/\byellow\b/08/gi;
2454
2455 ################################################################################
2456 # Produce @all_colors
2457 ################################################################################
2458
2459 # <color code>5 shall be a colored 5
2460
2461 $option_color_codes =~ s/(\d+)/sprintf('%02d', $1)/eg;
2462
2463 # Fill @all_colors and do error checking
2464
2465 my @all_colors = split(/\s*;\s*/, $option_color_codes);
2466 foreach my $code (@all_colors) {
2467 if ($code !~ /^\d+(,\d+)?$/) {
2468 print_err("Incorrect color code '$code'!");
2469 return $data;
2470 }
2471 }
2472 if (@all_colors == 0) {
2473 print_err('No color code found.');
2474 return $data;
2475 }
2476 @colors = @all_colors;
2477
2478 ################################################################################
2479 # "-split capitals"
2480 ################################################################################
2481
2482 if ($option_color_split eq 'capitals') {
2483 $output = $data;
2484 my ($color1, $color2);
2485 if ($option_color_random) {
2486 $color1 = $colors[rand(@colors)];
2487 @colors = grep { $_ ne $color1 } @colors unless (@colors == 1);
2488 $color2 = $colors[rand(@colors)];
2489 } else {
2490 if (@colors == 1) {
2491 $color1 = $color2 = $colors[0];
2492 } else {
2493 $color1 = $colors[0];
2494 $color2 = $colors[1];
2495 }
2496 }
2497
2498 $output =~ s/([[:upper:][:punct:]]+|\b\S)/\003${color1}${1}\003${color2}/g;
2499
2500 # Remove needless color codes
2501 $output =~ s/\003(?:$color1|$color2)( *)\003(?:$color1|$color2)/$1/g;
2502 $output =~ s/\003(?:$color1|$color2)$//;
2503 }
2504
2505 ################################################################################
2506 # Not "-split capitals"
2507 ################################################################################
2508
2509 else {
2510 if ($option_color_split eq 'chars') {
2511 $split = '';
2512 } elsif ($option_color_split eq 'lines') {
2513 $split = "\n";
2514 } elsif ($option_color_split eq 'words') {
2515 $split = '\s+';
2516 } elsif ($option_color_split eq 'rchars') {
2517 $split = '.' x rand(10);
2518 } elsif ($option_color_split eq 'paragraph') {
2519 $split = "\n";
2520 } else {
2521 $split = '\s+';
2522 }
2523
2524 my $i = 0;
2525 my $background = 0;
2526 my $color;
2527 for (split /($split)/, $data) {
2528 if (/^\s*$/) {
2529 $output .= $_;
2530 next;
2531 }
2532 if ($option_color_random) {
2533 $color = $colors[rand(@colors)];
2534
2535 $output .= "\017" if ($background && $color !~ /,/);
2536 $output .= "\003" . $color . $_;
2537
2538 if ($color =~ /,/) {
2539 $background = 1;
2540 } else {
2541 $background = 0;
2542 }
2543
2544 if ($option_color_split eq 'paragraph') {
2545 @colors = ($color);
2546 } else {
2547 @colors = grep { $_ ne $color } @all_colors unless (@all_colors == 1);
2548 }
2549 } else {
2550 $color = $colors[($i++ % ($#colors + 1))];
2551
2552 if ($option_color_split eq 'paragraph') {
2553 $color = $colors[0];
2554 }
2555
2556 $output .= "\017" if ($background && $color !~ /,/);
2557 $output .= "\003" . $color . $_;
2558
2559 if ($color =~ /,/) {
2560 $background = 1;
2561 } else {
2562 $background = 0;
2563 }
2564 }
2565 }
2566 }
2567
2568 return $output;
2569 }
2570
2571 sub switch_cool {
2572 my ($data, $channel) = @_;
2573 my $output;
2574
2575 ################################################################################
2576 # Get the options
2577 ################################################################################
2578
2579 my $option_eol_style = return_option('cool', 'eol_style', $option{dau_cool_eol_style});
2580
2581 my $option_max = return_option('cool', 'max', $option{dau_cool_maximum_line});
2582 if (!defined($option_max) || int($option_max) < 0) {
2583 $option_max = INT_MAX;
2584 }
2585
2586 my $option_prob_eol = return_option('cool', 'prob_eol', $option{dau_cool_probability_eol});
2587 if (!defined($option_prob_eol) || int($option_prob_eol) < 0 || int($option_prob_eol) > 100) {
2588 $option_prob_eol = 20;
2589 }
2590
2591 my $option_prob_word = return_option('cool', 'prob_word', $option{dau_cool_probability_word});
2592 if (!defined($option_prob_word) || int($option_prob_word) < 0 || int($option_prob_word) > 100) {
2593 $option_prob_word = 20;
2594 }
2595
2596 ################################################################################
2597 # Insert the trademarks and dollar signs
2598 ################################################################################
2599
2600 my $max = $option_max;
2601 foreach my $line (split /(\n)/, $data) {
2602 foreach my $word (split /(\s)/, $line) {
2603 if ($max > 0 && (rand(100) <= $option_prob_word) && $word =~ /^(\w+)([[:punct:]])?$/) {
2604 $word = "${1}[tm]${2}";
2605 $max--;
2606 }
2607 if ($max > 0 && (rand(100) <= $option_prob_word) && $word =~ /^(\w+(?:\[tm\])?)([[:punct:]])?$/) {
2608 $word = "\$${1}${2}";
2609 $max--;
2610 }
2611 $output .= $word;
2612 }
2613 $max = $option_max;
2614 }
2615
2616 ################################################################################
2617 # Reversed smileys
2618 ################################################################################
2619
2620 my $hat = '[(<]';
2621 my $eyes = '[:;%]';
2622 my $nose = '[-]';
2623 my $mouth = '[)(><\[\]{}|]';
2624
2625 $output =~ s{($hat?$eyes$nose?$mouth+)}{
2626 # Supposed to be read from the right to the left.
2627 # Therefore reverse all parenthesis characters:
2628
2629 my $tr = $1;
2630 $tr =~ tr/()<>[]\{\}/)(><][\}\{/;
2631
2632 # Reverse the rest
2633
2634 reverse($tr);
2635 }egox;
2636
2637 ################################################################################
2638 # EOL modifications
2639 ################################################################################
2640
2641 my $style = $option_eol_style;
2642 if ($option_eol_style eq 'random') {
2643 if (int(rand(2)) && $output !~ /[?!]$/) {
2644 $style = 'exclamation_marks';
2645 } else {
2646 $style = 'suffixes';
2647 }
2648 }
2649
2650 # If there is no suffixes file, go for the exclamation marks
2651
2652 my $file = "$option{dau_files_root_directory}/$option{dau_files_cool_suffixes}";
2653 unless (-e $file && -r $file && !(-z $file)) {
2654 $style = 'exclamation_marks';
2655 }
2656
2657 # Skip EOL modifications?
2658
2659 if (int(rand(100)) > $option_prob_eol) {
2660 $style = 'none';
2661 }
2662
2663 # Style determined. Act accordingly:
2664
2665 if ($style eq 'exclamation_marks') {
2666 my @eol;
2667 if ($option{dau_language} eq 'de') {
2668 @eol = ("eins", "shifteins", "elf", "hundertelf", "tausendeinhundertundelf");
2669 for (1 .. 5) {
2670 push(@eol, "eins");
2671 push(@eol, "elf");
2672 }
2673 } else {
2674 @eol = ("one", "shiftone", "eleven");
2675 for (1 .. 5) {
2676 push(@eol, "one");
2677 push(@eol, "eleven");
2678 }
2679 }
2680
2681 $output =~ s/\s*([,.?!])*\s*$//;
2682 $output .= '!' x (3 + int(rand(3)));
2683 $output .= '1' x (3 + int(rand(3)));
2684 $output .= $eol[rand(@eol)] x (1 + int(rand(1)));
2685 $output .= $eol[rand(@eol)] x (int(rand(2)));
2686 } elsif ($style eq 'suffixes') {
2687 my $suffix;
2688 if (-e $file && -r $file) {
2689 $/ = "\n";
2690 @ARGV = ($file);
2691 srand;
2692 rand($.) < 1 && ($suffix = switch_parse_special($_, $channel)) while <>;
2693 }
2694 $output =~ s/\s*$//;
2695
2696 if ($output =~ /^\s*$/) {
2697 $output = $suffix;
2698 } else {
2699 $output .= " " . $suffix;
2700 }
2701 }
2702
2703 return $output;
2704 }
2705
2706 sub switch_cowsay {
2707 my $data = shift;
2708 my ($binarypath, $output, @cows, %cow, $cow, @cache1, @cache2);
2709 my $skip = 1;
2710 my $think = return_option('cowsay', 'think');
2711
2712 my $executable_name;
2713 if ($think eq 'on') {
2714 $binarypath = $option{dau_cowsay_cowthink_path};
2715 $executable_name = 'cowthink';
2716 } else {
2717 $binarypath = $option{dau_cowsay_cowsay_path};
2718 $executable_name = 'cowsay';
2719 }
2720
2721 if (-e $binarypath && !(-f $binarypath)) {
2722 print_err("dau_cowsay_${executable_name}_path has to point to the $executable_name executable.");
2723 return;
2724 } elsif (!(-e $binarypath)) {
2725 print_err("$executable_name not found. Install it and set dau_cowsay_${executable_name}_path.");
2726 return;
2727 }
2728
2729 if (return_option('cowsay', 'cow')) {
2730 $cow = return_option('cowsay', 'cow');
2731 } else {
2732 while ($option{dau_cowsay_cowlist} =~ /\s*([^,\s]+)\s*,?/g) {
2733 $cow{$1} = 1;
2734 }
2735 foreach my $cow (keys %{ $switches{combo}{cowsay}{cow} }) {
2736 if (lc($option{dau_cowsay_cowpolicy}) eq 'allow') {
2737 push(@cows, $cow)
2738 unless ($cow{$cow});
2739 } elsif (lc($option{dau_cowsay_cowpolicy}) eq 'deny') {
2740 push(@cows, $cow)
2741 if ($cow{$cow});
2742 } else {
2743 print_err('Invalid value for dau_cowsay_cowpolicy');
2744 return;
2745 }
2746 }
2747 if (@cows == 0) {
2748 print_err('Cannot find any cowsay cow.');
2749 return;
2750 }
2751 $cow = $cows[rand(@cows)];
2752 }
2753
2754 # Run cowsay or cowthink
2755
2756 local(*HIS_IN, *HIS_OUT, *HIS_ERR);
2757 my @arguments;
2758 my $option_arguments = return_option('cowsay', 'arguments');
2759 if ($option_arguments) {
2760 @arguments = split(/ /, $option_arguments);
2761 }
2762 my $childpid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $binarypath, '-f', $cow, @arguments);
2763
2764 print HIS_IN $data or return;
2765 close(HIS_IN) or return;
2766
2767 my @errlines = <HIS_ERR>;
2768 my @outlines = <HIS_OUT>;
2769 close(HIS_ERR) or return;
2770 close(HIS_OUT) or return;
2771
2772 waitpid($childpid, 0);
2773 if ($?) {
2774 print_err("That child exited with wait status of $?");
2775 }
2776
2777 # Error during execution? Print errors and return
2778
2779 unless (@errlines == 0) {
2780 print_err('Error during execution of cowsay');
2781 foreach my $line (@errlines) {
2782 print_err($line);
2783 }
2784 return;
2785 }
2786
2787 if ($option{dau_cowsay_print_cow}) {
2788 print_out("Using cowsay cow $cow");
2789 }
2790
2791 foreach (@outlines) {
2792 chomp;
2793 if (/^\s*$/ && $skip) {
2794 next;
2795 } else {
2796 $skip = 0;
2797 }
2798 push(@cache1, $_);
2799 }
2800 $skip = 1;
2801 foreach (reverse @cache1) {
2802 chomp;
2803 if (/^\s*$/ && $skip) {
2804 next;
2805 } else {
2806 $skip = 0;
2807 }
2808 push(@cache2, $_);
2809 }
2810 foreach (reverse @cache2) {
2811 $output .= "$_\n";
2812 }
2813
2814 return $output;
2815 }
2816
2817 sub switch_delimiter {
2818 my $data = shift;
2819 my $output;
2820 my $option_delimiter_string = return_option('delimiter', 'string', $option{dau_delimiter_string});
2821
2822 foreach my $char (split //, $data) {
2823 $output .= $char . $option_delimiter_string;
2824 }
2825 return $output;
2826 }
2827
2828 sub switch_dots {
2829 my $data = shift;
2830
2831 $data =~ s/[.]*\s+/
2832 if (rand(10) < 3) {
2833 (rand(10) >= 5 ? ' ' : '')
2834 .
2835 ('...' . '.' x rand(5))
2836 .
2837 (rand(10) >= 5 ? ' ' : '')
2838 } else { ' ' }
2839 /egox;
2840 rand(10) >= 5 ? $data .= ' ' : 0;
2841 $data .= ('...' . '.' x rand(10));
2842
2843 return $data;
2844 }
2845
2846 sub switch_figlet {
2847 my $data = shift;
2848 my $skip = 1;
2849 my ($output, @fonts, %font, $font, @cache1, @cache2);
2850
2851 if (-e $option{dau_figlet_path} && !(-f $option{dau_figlet_path})) {
2852 print_err('dau_figlet_path has to point to the figlet executable.');
2853 return;
2854 } elsif (!(-e $option{dau_figlet_path})) {
2855 print_err('figlet not found. Install it and set dau_figlet_path.');
2856 return;
2857 }
2858
2859 if (return_option('figlet', 'font')) {
2860 $font = return_option('figlet', 'font');
2861 } else {
2862 while ($option{dau_figlet_fontlist} =~ /\s*([^,\s]+)\s*,?/g) {
2863 $font{$1} = 1;
2864 }
2865 foreach my $font (keys %{ $switches{combo}{figlet}{font} }) {
2866 if (lc($option{dau_figlet_fontpolicy}) eq 'allow') {
2867 push(@fonts, $font)
2868 unless ($font{$font});
2869 } elsif (lc($option{dau_figlet_fontpolicy}) eq 'deny') {
2870 push(@fonts, $font)
2871 if ($font{$font});
2872 } else {
2873 print_err('Invalid value for dau_figlet_fontpolicy.');
2874 return;
2875 }
2876 }
2877 if (@fonts == 0) {
2878 print_err('Cannot find figlet fonts.');
2879 return;
2880 }
2881 $font = $fonts[rand(@fonts)];
2882 }
2883
2884 # Run figlet
2885
2886 local(*HIS_IN, *HIS_OUT, *HIS_ERR);
2887
2888 my $childpid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $option{dau_figlet_path}, '-f', $font);
2889
2890 print HIS_IN $data or return;
2891 close(HIS_IN) or return;
2892
2893 my @errlines = <HIS_ERR>;
2894 my @outlines = <HIS_OUT>;
2895 close(HIS_ERR) or return;
2896 close(HIS_OUT) or return;
2897
2898 waitpid($childpid, 0);
2899 if ($?) {
2900 print_err("That child exited with wait status of $?");
2901 }
2902
2903 # Error during execution? Print errors and return
2904
2905 unless (@errlines == 0) {
2906 print_err('Error during execution of figlet');
2907 foreach my $line (@errlines) {
2908 print_err($line);
2909 }
2910 return;
2911 }
2912
2913 if ($option{dau_figlet_print_font}) {
2914 print_out("Using figlet font $font");
2915 }
2916
2917 foreach (@outlines) {
2918 chomp;
2919 if (/^\s*$/ && $skip) {
2920 next;
2921 } else {
2922 $skip = 0;
2923 }
2924 push(@cache1, $_);
2925 }
2926 $skip = 1;
2927 foreach (reverse @cache1) {
2928 chomp;
2929 if (/^\s*$/ && $skip) {
2930 next;
2931 } else {
2932 $skip = 0;
2933 }
2934 push(@cache2, $_);
2935 }
2936 foreach (reverse @cache2) {
2937 $output .= "$_\n";
2938 }
2939
2940 return $output;
2941 }
2942
2943 sub switch_leet {
2944 my $data = shift;
2945
2946 $_ = $data;
2947
2948 s'fucker'f@#$er'gi;
2949 s/hacker/h4x0r/gi;
2950 s/sucker/sux0r/gi;
2951 s/fear/ph34r/gi;
2952
2953 s/\b(\w+)ude\b/${1}00d/gi;
2954 s/\b(\w+)um\b/${1}00m/gi;
2955 s/\b(\w{3,})er\b/${1}0r/gi;
2956 s/\bdo\b/d00/gi;
2957 s/\bthe\b/d4/gi;
2958 s/\byou\b/j00/gi;
2959
2960 tr/lLzZeEaAsSgGtTbBqQoOiIcC/11223344556677889900||((/;
2961 s/(\w)/rand(100) < 50 ? "\u$1" : "\l$1"/ge;
2962
2963 return $_;
2964 }
2965
2966 sub switch_me {
2967 my $data = shift;
2968
2969 $command_out = 'ACTION';
2970
2971 return $data;
2972 }
2973
2974 # &switch_mix by Martin Kihlgren <zond@troja.ath.cx>
2975 # slightly modified by myself
2976
2977 sub switch_mix {
2978 my $data = shift;
2979 my $output;
2980
2981 while ($data =~ s/(\s*)([^\w]*)([\w]+)([^\w]*)(\s+[^\w]*\w+[^\w]*\s*)*/$5/) {
2982 my $prespace = $1;
2983 my $prechars = $2;
2984 my $w = $3;
2985 my $postchars = $4;
2986 $output = $output . $prespace . $prechars . substr($w,0,1);
2987 my $middle = substr($w,1,length($w) - 2);
2988 while ($middle =~ s/(.)(.*)/$2/) {
2989 if (rand() > 0.1) {
2990 $middle = $middle . $1;
2991 } else {
2992 $output = $output . $1;
2993 }
2994 }
2995 if (length($w) > 1) {
2996 $output = $output . substr($w, length($w) - 1, 1);
2997 }
2998 $output = $output . $postchars;
2999 }
3000
3001 return $output;
3002 }
3003
3004 sub switch_mixedcase {
3005 my $data = shift;
3006
3007 $data =~ s/([[:alpha:]])/rand(100) < 50 ? uc($1) : lc($1)/ge;
3008
3009 return $data;
3010 }
3011
3012 sub switch_moron {
3013 my ($data, $channel_rec) = @_;
3014 my $output;
3015 my $option_eol_style = return_option('moron', 'eol_style', $option{dau_moron_eol_style});
3016 my $option_language = $option{dau_language};
3017
3018 ################################################################################
3019 # -omega on
3020 ################################################################################
3021
3022 my $omega;
3023
3024 if (return_option('moron', 'omega') eq 'on') {
3025 my @words = qw(omfg lol wtf);
3026
3027 foreach (split / (?=\w+\b)/, $data) {
3028 if (rand(100) < 20) {
3029 $omega .= ' ' . $words[rand(@words)] . " $_";
3030 } else {
3031 $omega .= ' ' . $_;
3032 }
3033 }
3034
3035 $omega =~ s/\s*,\s+\@/ @/g;
3036 $omega =~ s/^\s+//;
3037 }
3038
3039 $_ = $omega || $data;
3040
3041 ################################################################################
3042 # 'nick: text' -> 'text @ nick'
3043 ################################################################################
3044
3045 my $old_list_delimiter = $option{dau_parse_special_list_delimiter};
3046 $option{dau_parse_special_list_delimiter} = ' ';
3047 my @nicks = split(/ /, switch_parse_special('@nicks', $channel_rec));
3048 $option{dau_parse_special_list_delimiter} = $old_list_delimiter;
3049 @nicks = map { quotemeta($_) } @nicks;
3050
3051 {
3052 local $" = '|';
3053 eval { # Catch strange error
3054 s/^(@nicks): (.+)/$2 @ $1/;
3055 };
3056 }
3057
3058 ################################################################################
3059 # Preparations for "EOL modifications" later
3060 ################################################################################
3061
3062 # Remove puntuation marks at EOL and ensure there is a single space at EOL.
3063 # This is necessary because the EOL-styles 'new' and 'classic' put them at
3064 # EOL. If EOL-style is set to 'nothing' don't do this.
3065
3066 s/\s*([,;.:?!])*\s*$// unless ($option_eol_style eq 'nothing');
3067 my $lastchar = $1;
3068
3069 # Only whitespace? Remove it.
3070
3071 s/^\s+$//;
3072
3073 ################################################################################
3074 # Substitutions for every language
3075 ################################################################################
3076
3077 tr/'/`/;
3078
3079 # Dauify smileys
3080
3081 {
3082 # Use of uninitialized value in concatenation (.) or string at...
3083 # (the optional dash ($1) in the regular expressions).
3084 # Thus turn off warnings
3085
3086 no warnings;
3087
3088 if ($option{dau_language} eq 'de') {
3089 if (int(rand(2))) {
3090 s/:(-)?\)/^^/go;
3091 } else {
3092 s/:(-)?\)/':' . $1 . ')))' . (')' x rand(10)) . ('9' x rand(4))/ego;
3093 }
3094
3095 s/;(-)?\)/';' . $1 . ')))' . (')' x rand(10)) . ('9' x rand(4))/ego;
3096 s/:(-)?\(/':' . $1 . '(((' . ('(' x rand(10)) . ('8' x rand(4))/ego;
3097 s#(^|\s):(-)?/(\s|$)#$1 . ':' . $2 . '///' . ('/' x rand(10)) . ('7' x rand(4)) . $3#ego;
3098 } else {
3099 if (int(rand(2))) {
3100 s/:(-)?\)/^^/go;
3101 } else {
3102 s/:(-)?\)/':' . $1 . ')))' . (')' x rand(10)) . ('0' x rand(4))/ego;
3103 }
3104
3105 s/;(-)?\)/';' . $1 . ')))' . (')' x rand(10)) . ('0' x rand(4))/ego;
3106 s/:(-)?\(/':' . $1 . '(((' . ('(' x rand(10)) . ('9' x rand(4))/ego;
3107 }
3108 }
3109
3110 ################################################################################
3111 # English text
3112 ################################################################################
3113
3114 if ($option_language eq 'en') {
3115 s/\bthe\b/teh/go;
3116 }
3117
3118 ################################################################################
3119 # German text
3120 ################################################################################
3121
3122 if ($option_language eq 'de') {
3123
3124 # '*GG*' -> 'ÜGGÜ'
3125 {
3126 my @a = ('*', 'Ü');
3127 my $a = $a[int(rand(@a))];
3128 s/\*g\*/$a . 'ggg' . ('g' x rand(10)) . $a/egio;
3129 }
3130
3131 # verbs
3132
3133 s/\b(f)reuen\b/$1roien/gio;
3134 s/\b(f)reue\b/$1roie/gio;
3135 s/\b(f)reust\b/$1roist/gio;
3136 s/\b(f)reut\b/$1roit/gio;
3137
3138 s/\b(f)unktionieren\b/$1unzen/gio;
3139 s/\b(f)unktioniere\b/$1unze/gio;
3140 s/\b(f)unktionierst\b/$1unzt/gio;
3141 s/\b(f)unktioniert\b/$1unzt/gio;
3142
3143 s/\b(h)olen\b/$1ohlen/gio;
3144 s/\b(h)ole\b/$1ohle/gio;
3145 s/\b(h)olst\b/$1ohlst/gio;
3146 s/\b(h)olt\b/$1ohlt/gio;
3147
3148 s/\b(k)onfigurieren\b/$1 eq 'k' ? 'confen' : 'Confen'/egio;
3149 s/\b(k)onfiguriere\b/$1 eq 'k' ? 'confe' : 'Confe'/egio;
3150 s/\b(k)onfigurierst\b/$1 eq 'k' ? 'confst' : 'Confst'/egio;
3151 s/\b(k)onfiguriert\b/$1 eq 'k' ? 'conft' : 'Conft'/egio;
3152
3153 s/\b(l)achen\b/$1ölen/gio;
3154 s/\b(l)ache\b/$1öle/gio;
3155 s/\b(l)achst\b/$1ölst/gio;
3156 s/\b(l)acht\b/$1ölt/gio;
3157
3158 s/\b(m)achen\b/$1 eq 'm' ? 'tun' : 'Tun'/egio;
3159 s/\b(m)ache\b/$1 eq 'm' ? 'tu' : 'Tu'/egio;
3160 s/\b(m)achst\b/$1 eq 'm' ? 'tust' : 'Tust'/egio;
3161
3162 s/\b(n)erven\b/$1erfen/gio;
3163 s/\b(n)erve\b/$1erfe/gio;
3164 s/\b(n)ervst\b/$1erfst/gio;
3165 s/\b(n)ervt\b/$1erft/gio;
3166
3167 s/\b(p)rojizieren\b/$1rojezieren/gio;
3168 s/\b(p)rojiziere\b/$1rojeziere/gio;
3169 s/\b(p)rojizierst\b/$1rojezierst/gio;
3170 s/\b(p)rojiziert\b/$1rojeziert/gio;
3171
3172 s/\b(r)egistrieren\b/$1egestrieren/gio;
3173 s/\b(r)egistriere\b/$1egestriere/gio;
3174 s/\b(r)egistrierst\b/$1egestrierst/gio;
3175 s/\b(r)egistriert\b/$1egestriert/gio;
3176
3177 s/\b(s)pazieren\b/$1patzieren/gio;
3178 s/\b(s)paziere\b/$1patziere/gio;
3179 s/\b(s)pazierst\b/$1patzierst/gio;
3180 s/\b(s)paziert\b/$1patziert/gio;
3181
3182 # other
3183
3184 s/\bdanke\b/
3185 if (int(rand(2)) == 0) {
3186 'thx'
3187 } else {
3188 'danks'
3189 }
3190 /ego;
3191 s/\bDanke\b/
3192 if (int(rand(2)) == 0) {
3193 'Thx'
3194 } else {
3195 'Danks'
3196 }
3197 /ego;
3198
3199 s/\blol\b/
3200 if (int(rand(2)) == 0) {
3201 'löl'
3202 } else {
3203 'löllens'
3204 }
3205 /ego;
3206 s/\bLOL\b/
3207 if (int(rand(2)) == 0) {
3208 'LÖL'
3209 } else {
3210 'LÖLLENS'
3211 }
3212 /ego;
3213
3214 s/\br(?:ü|ue)ckgrat\b/
3215 if (int(rand(3)) == 0) {
3216 'rückgrad'
3217 } elsif (int(rand(3)) == 1) {
3218 'rückrad'
3219 } else {
3220 'rückrat'
3221 }
3222 /ego;
3223 s/\bR(?:ü|ue)ckgrat\b/
3224 if (int(rand(3)) == 0) {
3225 'Rückgrad'
3226 } elsif (int(rand(3)) == 1) {
3227 'Rückrad'
3228 } else {
3229 'Rückrat'
3230 }
3231 /ego;
3232
3233 s/\b(i)st er\b/$1ssa/gio;
3234 s/\bist\b/int(rand(2)) ? 'is' : 'iss'/ego;
3235 s/\bIst\b/int(rand(2)) ? 'Is' : 'Iss'/ego;
3236
3237 s/\b(d)a(?:ss|ß) du\b/$1asu/gio;
3238 s/\b(d)a(?:ss|ß)\b/$1as/gio;
3239
3240 s/\b(s)ag mal\b/$1amma/gio;
3241 s/\b(n)ochmal\b/$1omma/gio;
3242 s/(m)al\b/$1a/gio;
3243
3244 s/\b(u)nd nun\b/$1nnu/gio;
3245 s/\b(n)un\b/$1u/gio;
3246
3247 s/\b(s)oll denn\b/$1olln/gio;
3248 s/\b(d)enn\b/$1en/gio;
3249
3250 s/\b(s)o eine\b/$1onne/gio;
3251 s/\b(e)ine\b/$1 eq 'e' ? 'ne' : 'Ne'/egio;
3252
3253 s/\bkein problem\b/NP/gio;
3254 s/\b(p)roblem\b/$1rob/gio;
3255 s/\b(p)robleme\b/$1robs/gio;
3256
3257 s/\b(a)ber\b/$1bba/gio;
3258 s/\b(a)chso\b/$1xo/gio;
3259 s/\b(a)dresse\b/$1ddresse/gio;
3260 s/\b(a)ggressiv\b/$1gressiv/gio;
3261 s/\b([[:alpha:]]{2,})st du\b/${1}su/gio;
3262 s/\b(a)nf(?:ä|ae)nger\b/$1 eq 'a' ? 'n00b' : 'N00b'/egio;
3263 s/\b(a)sozial\b/$1ssozial/gio;
3264 s/\b(a)u(?:ss|ß)er\b/$1user/gio;
3265 s/\b(a)utor/$1uthor/gio;
3266 s/\b(b)asta\b/$1 eq 'b' ? 'pasta' : 'Pasta'/egio;
3267 s/\b(b)illard\b/$1illiard/gio;
3268 s/\b(b)i(?:ss|ß)chen\b/$1ischen/gio;
3269 s/\b(b)ist\b/$1is/gio;
3270 s/\b(b)itte\b/$1 eq 'b' ? 'plz' : 'Plz'/egio;
3271 s/\b(b)lo(?:ss|ß)\b/$1los/gio;
3272 s/\b(b)(?:ox|(?:ü|ue)chse)\b/$1yxe/gio;
3273 s/\b(b)rillant\b/$1rilliant/gio;
3274 s/\b(c)hannel\b/$1 eq 'c' ? 'kanal' : 'Kanal'/egio;
3275 s/\b(c)hat\b/$1hatt/gio;
3276 s/\b(c)ool\b/$1 eq 'c' ? 'kewl' : 'Kewl'/egio;
3277 s/\b(d)(?:ä|ae)mlich\b/$1ähmlich/gio;
3278 s/\b(d)etailliert\b/$1etailiert/gio;
3279 s/\b(d)ilettantisch\b/$1illetantisch/gio;
3280 s/\b(d)irekt\b/$1ireckt/gio;
3281 s/\b(d)iskussion\b/$1isskusion/gio;
3282 s/\b(d)istribution/$1ystrubution/gio;
3283 s/\b(e)igentlich\b/$1igendlich/gio;
3284 s/\b(e)inzige\b/$1inzigste/gio;
3285 s/\b(e)nd/$1nt/gio;
3286 s/\b(e)ntschuldigung\b/$1 eq 'e' ? 'sry' : 'Sry'/egio;
3287 s/\b(f)ilm\b/$1 eq 'f' ? 'movie' : 'Movie'/egio;
3288 s/\b(f)lachbettscanner\b/$1lachbrettscanner/gio;
3289 s/\b(f)reu\b/$1roi/gio;
3290 s/\b(g)alerie\b/$1allerie/gio;
3291 s/\b(g)ay\b/$1hey/gio;
3292 s/\b(g)ebaren\b/$1ebahren/gio;
3293 s/\b(g)elatine\b/$1elantine/gio;
3294 s/\b(g)eratewohl\b/$1eradewohl/gio;
3295 s/\b(g)ibt es\b/$1ibbet/gio;
3296 s/\bgra([dt])/$1 eq 'd' ? 'grat' : 'grad'/ego;
3297 s/\bGra([dt])/$1 eq 'd' ? 'Grat' : 'Grad'/ego;
3298 s/\b(h)(?:ä|ae)ltst\b/$1älst/gio;
3299 s/\b(h)(?:ä|ae)sslich/$1äslich/gio;
3300 s/\b(h)aneb(?:ü|ue)chen\b/$1ahneb$2chen/gio;
3301 s/\b(i)mmobilie/$1mobilie/gio;
3302 s/\b(i)nteressant\b/$1nterressant/gio;
3303 s/\b(i)ntolerant\b/$1ntollerant/gio;
3304 s/\b(i)rgend/$1rgent/gio;
3305 s/\b(j)a\b/$1oh/gio;
3306 s/\b(j)etzt\b/$1ez/gio;
3307 s/\b(k)affee\b/$1affe/gio;
3308 s/\b(k)aputt\b/$1aput/gio;
3309 s/\b(k)arussell\b/$1arussel/gio;
3310 s/\b(k)iste\b/$1 eq 'k' ? 'byxe' : 'Byxe'/egio;
3311 s/\b(k)lempner\b/$1lemptner/gio;
3312 s/\b(k)r(?:ä|ae)nker\b/$1ranker/gio;
3313 s/\b(k)rise\b/$1riese/gio;
3314 s/\b(l)etal\b/$1ethal/gio;
3315 s/\b(l)eute\b/$1 eq 'l' ? 'ppl' : 'Ppl'/egio;
3316 s/\b(l)ibyen\b/$1ybien/gio;
3317 s/\b(l)izenz\b/$1izens/gio;
3318 s/\b(l)oser\b/$1ooser/gio;
3319 s/\b(l)ustig/$1ölig/gio;
3320 s/\b(m)aschine\b/$1aschiene/gio;
3321 s/\b(m)illennium\b/$1illenium/gio;
3322 s/\b(m)iserabel\b/$1ieserabel/gio;
3323 s/\b(m)it dem\b/$1im/gio;
3324 s/\b(m)orgendlich\b/$1orgentlich/gio;
3325 s/\b(n)(?:ä|ae)mlich\b/$1ähmlich/gio;
3326 s/\b(n)ein\b/$1eh/gio;
3327 s/\bnett\b/n1/gio;
3328 s/\b(n)ewbie\b/$100b/gio;
3329 s/\bnicht\b/int(rand(2)) ? 'net' : 'ned'/ego;
3330 s/\bNicht\b/int(rand(2)) ? 'Net' : 'Ned'/ego;
3331 s/\b(n)iveau/$1iwo/gio;
3332 s/\bok(?:ay)?\b/K/gio;
3333 s/\b(o)riginal\b/$1rginal/gio;
3334 s/\b(p)aket\b/$1acket/gio;
3335 s/\b(p)l(?:ö|oe)tzlich\b/$1lözlich/gio;
3336 s/\b(p)ogrom\b/$1rogrom/gio;
3337 s/\b(p)rogramm\b/$1roggie/gio;
3338 s/\b(p)rogramme\b/$1roggies/gio;
3339 s/\b(p)sychiater\b/$1sychater/gio;
3340 s/\b(p)ubert(?:ä|ae)t\b/$1upertät/gio;
3341 s/\b(q)uarz\b/$1uartz/gio;
3342 s/\b(q)uery\b/$1uerry/gio;
3343 s/\b(r)eferenz\b/$1efferenz/gio;
3344 s/\b(r)eparatur\b/$1eperatur/gio;
3345 s/\b(r)eply\b/$1eplay/gio;
3346 s/\b(r)essource\b/$1esource/gio;
3347 s/\b(r)(o)(t?fl)\b/$1 . ($2 eq 'o' ? 'ö' : 'Ö') . $3/egio;
3348 s/\b(r)(o)(t?fl)(o)(l)\b/$1 . ($2 eq 'o' ? 'ö' : 'Ö') . $3 . ($4 eq 'o' ? 'ö' : 'Ö') . $5/egio;
3349 s/\b(s)atellit\b/$1attelit/gio;
3350 s/\b(s)cherz\b/$1chertz/gio;
3351 s/\bsei([dt])\b/$1 eq 'd' ? 'seit' : 'seid'/ego;
3352 s/\bSei([dt])\b/$1 eq 'd' ? 'Seit' : 'Seid'/ego;
3353 s/\b(s)elig\b/$1eelig/gio;
3354 s/\b(s)eparat\b/$1eperat/gio;
3355 s/\b(s)eriosit(?:ä|ae)t\b/$1erösität/gio;
3356 s/\b(s)onst\b/$1onnst/gio;
3357 s/\b(s)orry\b/$1ry/gio;
3358 s/\b(s)pelunke\b/$1ilunke/gio;
3359 s/\b(s)piel\b/$1 eq 's' ? 'game' : 'Game'/egio;
3360 s/\b(s)tabil\b/$1tabiel/gio;
3361 s/\b(s)tandard\b/$1tandart/gio;
3362 s/\b(s)tegreif\b/$1tehgreif/gio;
3363 s/\b(s)ympathisch\b/$1ymphatisch/gio;
3364 s/\b(s)yntax\b/$1ynthax/gio;
3365 s/\b(t)era/$1erra/gio;
3366 s/\b(t)oler/$1oller/gio;
3367 s/\bto([td])/$1 eq 't' ? 'tod' : 'tot'/ego;
3368 s/\bTo([td])/$1 eq 't' ? 'Tod' : 'Tot'/ego;
3369 s/\b(u)ngef(?:ä|ae)hr\b/$1ngefär/gio;
3370 s/\bviel gl(?:ü|ue)ck\b/GL/gio;
3371 s/\b(v)ielleicht\b/$1ileicht/gio;
3372 s/\b(v)oraus/$1orraus/gio;
3373 s/\b(w)(?:ä|ae)re\b/$1ähre/gio;
3374 s/\bwa(h)?r/$1 eq 'h' ? 'war' : 'wahr'/ego;
3375 s/\bWa(h)?r/$1 eq 'h' ? 'War' : 'Wahr'/ego;
3376 s/\b(w)as du\b/$1asu/gio;
3377 s/\b(w)eil du\b/$1eilu/gio;
3378 s/\bweis(s)?/$1 eq 's' ? 'weis' : 'weiss'/ego;
3379 s/\bWeis(s)?/$1 eq 's' ? 'Weis' : 'Weiss'/ego;
3380 s/\b(w)enn du\b/$1ennu/gio;
3381 s/\b(w)ider/$1ieder/gio;
3382 s/\b(w)ieso\b/$1iso/gio;
3383 s/\b(z)iemlich\b/$1iehmlich/gio;
3384 s/\b(z)umindest\b/$1umindestens/gio;
3385
3386 tr/üÜ/yY/;
3387 s/ei(?:ss?|ß)e?/ice/go;
3388 s/eife?/ive/go;
3389
3390 if(return_option('moron', 'level') >= 1) {
3391 s/\b(u)nd\b/$1nt/gio;
3392 s/\b(h)at\b/$1att/gio;
3393 s/\b(n)ur\b/$1uhr/gio;
3394 s/\b(v)er(\w+)/$1 eq 'V' ? "Fa$2" : "fa$2"/egio;
3395 s/\b([[:alpha:]]+[b-np-tv-z])er\b/${1}a/go;
3396 s/\b([[:alpha:]]+)ck/${1}q/go;
3397
3398 s/\b([fv])(?=[[:alpha:]]{2,})/
3399 if (rand(10) <= 4) {
3400 if ($1 eq 'f') {
3401 'v'
3402 }
3403 else {
3404 'f'
3405 }
3406 } else {
3407 $1
3408 }
3409 /egox;
3410 s/\b([FV])(?=[[:alpha:]]{2,})/
3411 if (rand(10) <= 4) {
3412 if ($1 eq 'F') {
3413 'V'
3414 }
3415 else {
3416 'F'
3417 }
3418 } else {
3419 $1
3420 }
3421 /egox;
3422 s#\b([[:alpha:]]{2,})([td])\b#
3423 my $begin = $1;
3424 my $end = $2;
3425 if (rand(10) <= 4) {
3426 if ($end eq 't' && $begin !~ /t$/) {
3427 "${begin}d"
3428 } elsif ($end eq 'd' && $begin !~ /d$/) {
3429 "${begin}t"
3430 } else {
3431 "${begin}${end}"
3432 }
3433 } else {
3434 "${begin}${end}"
3435 }
3436 #egox;
3437 s/\b([[:alpha:]]{2,})ie/
3438 if (rand(10) <= 4) {
3439 "$1i"
3440 } else {
3441 "$1ie"
3442 }
3443 /egox;
3444 }
3445 }
3446
3447 $data = $_;
3448
3449 ################################################################################
3450 # Swap characters with characters near at the keyboard
3451 ################################################################################
3452
3453 my %mark;
3454 my %chars;
3455 if ($option{dau_language} eq 'de') {
3456 %chars = (
3457 'a' => [ 's' ],
3458 'b' => [ 'v', 'n' ],
3459 'c' => [ 'x', 'v' ],
3460 'd' => [ 's', 'f' ],
3461 'e' => [ 'w', 'r' ],
3462 'f' => [ 'd', 'g' ],
3463 'g' => [ 'f', 'h' ],
3464 'h' => [ 'g', 'j' ],
3465 'i' => [ 'u', 'o' ],
3466 'j' => [ 'h', 'k' ],
3467 'k' => [ 'j', 'l' ],
3468 'l' => [ 'k', 'ö' ],
3469 'm' => [ 'n' ],
3470 'n' => [ 'b', 'm' ],
3471 'o' => [ 'i', 'p' ],
3472 'p' => [ 'o', 'ü' ],
3473 'q' => [ 'w' ],
3474 'r' => [ 'e', 't' ],
3475 's' => [ 'a', 'd' ],
3476 't' => [ 'r', 'z' ],
3477 'u' => [ 'z', 'i' ],
3478 'v' => [ 'c', 'b' ],
3479 'w' => [ 'q', 'e' ],
3480 'x' => [ 'y', 'c' ],
3481 'y' => [ 'x' ],
3482 'z' => [ 't', 'u' ],
3483 );
3484 } else {
3485 %chars = (
3486 'a' => [ 's' ],
3487 'b' => [ 'v', 'n' ],
3488 'c' => [ 'x', 'v' ],
3489 'd' => [ 's', 'f' ],
3490 'e' => [ 'w', 'r' ],
3491 'f' => [ 'd', 'g' ],
3492 'g' => [ 'f', 'h' ],
3493 'h' => [ 'g', 'j' ],
3494 'i' => [ 'u', 'o' ],
3495 'j' => [ 'h', 'k' ],
3496 'k' => [ 'j', 'l' ],
3497 'l' => [ 'k', 'ö' ],
3498 'm' => [ 'n' ],
3499 'n' => [ 'b', 'm' ],
3500 'o' => [ 'i', 'p' ],
3501 'p' => [ 'o', 'ü' ],
3502 'q' => [ 'w' ],
3503 'r' => [ 'e', 't' ],
3504 's' => [ 'a', 'd' ],
3505 't' => [ 'r', 'z' ],
3506 'u' => [ 'z', 'i' ],
3507 'v' => [ 'c', 'b' ],
3508 'w' => [ 'q', 'e' ],
3509 'x' => [ 'y', 'c' ],
3510 'y' => [ 't', 'u' ],
3511 'z' => [ 'x' ],
3512 );
3513 }
3514
3515 # Do not replace one character twice
3516 # Therefore every replace-position will be marked
3517
3518 unless (lc(return_option('moron', 'typo')) eq 'off') {
3519 for (0 .. length($data)) {
3520 $mark{$_} = 0;
3521 }
3522
3523 for (0 .. rand(length($data))/20) {
3524 my $pos = int(rand(length($data)));
3525 pos $data = $pos;
3526 unless ($mark{$pos} == 1) {
3527 no locale;
3528 if ($data =~ /\G([A-Za-z])/g) {
3529 my $matched = $1;
3530 my $replacement;
3531 if ($matched eq lc($matched)) {
3532 $replacement = $chars{$matched}[int(rand(@{ $chars{$matched} }))];
3533 } else {
3534 $replacement = uc($chars{$matched}[int(rand(@{ $chars{$matched} }))]);
3535 }
3536 if ($replacement !~ /^\s*$/) {
3537 substr($data, $pos, 1, $replacement);
3538 $mark{$pos} = 1;
3539 }
3540 }
3541 }
3542 }
3543 }
3544
3545 ################################################################################
3546 # Mix in some typos (swapping characters)
3547 ################################################################################
3548
3549 unless (lc(return_option('moron', 'typo')) eq 'off') {
3550 foreach my $word (split /([\s\n])/, $data) {
3551 if ((rand(100) <= 20) && length($word) > 1) {
3552 my $position_swap = int(rand(length($word)));
3553 if ($position_swap == 0) {
3554 $position_swap = 1;
3555 } elsif ($position_swap == length($word)) {
3556 $position_swap = length($word) - 1;
3557 }
3558 if (substr($word, $position_swap - 1, 1) eq uc(substr($word, $position_swap - 1, 1)) &&
3559 substr($word, $position_swap, 1) eq lc(substr($word, $position_swap, 1)))
3560 {
3561 (substr($word, $position_swap, 1), substr($word, $position_swap - 1, 1)) =
3562 (lc(substr($word, $position_swap - 1, 1)), uc(substr($word, $position_swap, 1)));
3563 } else {
3564 (substr($word, $position_swap, 1), substr($word, $position_swap - 1, 1)) =
3565 (substr($word, $position_swap - 1, 1), substr($word, $position_swap, 1));
3566 }
3567 }
3568 $output .= $word;
3569 }
3570 } else {
3571 $output = $_;
3572 }
3573
3574 ################################################################################
3575 # plenk
3576 ################################################################################
3577
3578 $output =~ s/(\w+)([,;.:?!]+)(\s+|$)/
3579 if (rand(10) <= 8 || $3 eq '') {
3580 "$1 $2$3"
3581 } else {
3582 "$1$2"
3583 }
3584 /egox;
3585
3586 ################################################################################
3587 # default behaviour: uppercase text
3588 ################################################################################
3589
3590 $output = uc($output) unless (return_option('moron', 'uppercase') eq 'off');
3591
3592 ################################################################################
3593 # do something at EOL
3594 ################################################################################
3595
3596 if ($option_eol_style ne 'nothing') {
3597 my $random = int(rand(100));
3598
3599 $output .= ' ' unless ($output =~ /^\s*$/);
3600
3601 # !!!!!!??????????!!!!!!!!!!11111
3602
3603 if ($random <= 70 || $lastchar eq '!') {
3604 my @punct = qw(? !);
3605 $output .= $punct[rand(@punct)] x int(rand(5))
3606 for (1..15);
3607
3608 if ($lastchar eq '?') {
3609 $output .= '?' x (int(rand(4))+1);
3610 } elsif ($lastchar eq '!') {
3611 $output .= '!' x (int(rand(4))+1);
3612 }
3613
3614 if ($output =~ /\?$/) {
3615 if ($option{dau_language} eq 'de') {
3616 $output .= "ß" x int(rand(10));
3617 } else {
3618 $output .= "/" x int(rand(10));
3619 }
3620 } elsif ($output =~ /!$/) {
3621 $output .= "1" x int(rand(10));
3622 }
3623 }
3624
3625 # ?¿?
3626
3627 elsif ($random <= 85) {
3628 $output .= '?¿?';
3629 }
3630
3631 # "=\n?"
3632
3633 else {
3634 $output .= "=\n?";
3635 }
3636 }
3637
3638 return $output;
3639 }
3640
3641 sub switch_nothing {
3642 my $data = shift;
3643
3644 return $data;
3645 }
3646
3647 sub switch_parse_special {
3648 my ($text, $channel) = @_;
3649
3650 local $" = return_option('parse_special', 'list_delimiter', $option{dau_parse_special_list_delimiter});
3651
3652 # Build nick array with every nick in channel and
3653 # opnick array with every op in the channel
3654
3655 my @nicks = ();
3656 my @opnicks = ();
3657 if (defined($channel) && $channel && $channel->{type} eq 'CHANNEL') {
3658 foreach my $nick ($channel->nicks()) {
3659 next if ($channel->{server}->{nick} eq $nick->{nick});
3660 push(@nicks, $nick->{nick});
3661 push(@opnicks, $nick->{nick}) if ($nick->{op});
3662 }
3663 }
3664 @nicks = sort { lc($a) cmp lc($b) } @nicks;
3665 @opnicks = sort { lc($a) cmp lc($b) } @opnicks;
3666
3667 # Substitution: \n to a real newline
3668
3669 $text =~ s/(?<![\\])\\n/\n/g;
3670
3671 # Substitution: @nicks to all nicks of channel
3672
3673 $text =~ s/(?<![\\])\@nicks/@nicks/gc;
3674
3675 # Substitution: @opnicks to all nicks of channel
3676
3677 $text =~ s/(?<![\\])\@opnicks/@opnicks/gc;
3678
3679 # Substitution: $nick1..$nickn
3680
3681 while ($text =~ /(?<![\\])\$nick(\d+)/g) {
3682 my $substitution = $nicks[rand(@nicks)];
3683 $text =~ s/(?<![\\])\$nick$1([^\d]|$)/${substitution}$1/g;
3684 @nicks = grep { $_ ne $substitution } @nicks;
3685 last if (@nicks == 0);
3686 }
3687
3688 # Substitution: $opnick1..$opnickn
3689
3690 while ($text =~ /(?<![\\])\$opnick(\d+)/g) {
3691 my $substitution = $opnicks[rand(@opnicks)];
3692 $text =~ s/(?<![\\])\$opnick$1([^\d]|$)/${substitution}$1/g;
3693 @opnicks = grep { $_ ne $substitution } @opnicks;
3694 last if (@opnicks == 0);
3695 }
3696
3697 # Substitution: $?{ code }
3698
3699 my $np; # (nested pattern)
3700 $np = qr{
3701 {
3702 (?:
3703 (?> [^{}]+ ) # Non-capture group w/o backtracking
3704 |
3705 (??{ $np }) # Group with matching parens
3706 )*
3707 }
3708 }x;
3709
3710 while ($text =~ /(?<![\\])\$\?($np)/g) {
3711 {
3712 no strict;
3713 my $replacement = eval $1;
3714 if ($@) {
3715 print_err('Invalid code used in construct $?{ code }. Details:');
3716 print_err($@);
3717 return;
3718 } else {
3719 chomp($replacement);
3720 $text =~ s/(?<![\\])\$\?($np)/$replacement/;
3721 }
3722 }
3723 }
3724
3725 # Substitution: irssi's special variables
3726
3727 if ((defined($channel) && $channel &&
3728 ($channel->{type} eq 'CHANNEL' || $channel->{type} eq 'QUERY')) &&
3729 !(lc(return_option('parse_special', 'irssi_variables')) eq 'off'))
3730 {
3731 $text = $channel->parse_special($text);
3732 }
3733
3734 return $text;
3735 }
3736
3737 sub switch_reverse {
3738 my $data = shift;
3739
3740 $data = reverse($data);
3741
3742 return $data;
3743 }
3744
3745 sub switch_stutter {
3746 my $data = shift;
3747 my $output;
3748 my @words = qw(eeeh oeeeh aeeeh);
3749
3750 foreach (split / (?=\w+\b)/, $data) {
3751 if (rand(100) < 20) {
3752 $output .= ' ' . $words[rand(@words)] . ", $_";
3753 } else {
3754 $output .= ' ' . $_;
3755 }
3756 }
3757
3758 $output =~ s/\s*,\s+\@/ @/g;
3759
3760 for (1 .. rand(length($output)/5)) {
3761 pos $output = rand(length($output));
3762 $output =~ s/\G ([[:alpha:]]+)\b/ $1, $1/;
3763 }
3764 for (1 .. rand(length($output)/10)) {
3765 pos $output = rand(length($output));
3766 $output =~ s/\G([[:alpha:]])/$1 . ($1 x rand(3))/e;
3767 }
3768
3769 $output =~ s/^\s+//;
3770
3771 return $output;
3772 }
3773
3774 sub switch_substitute {
3775 $_ = shift;
3776
3777 my $file = "$option{dau_files_root_directory}/$option{dau_files_substitute}";
3778
3779 if (-e $file && -r $file) {
3780 my $return = do $file;
3781
3782 if ($@) {
3783 print_err("parsing $file failed: $@");
3784 }
3785 unless (defined($return)) {
3786 print_err("'do $file' failed");
3787 }
3788 }
3789
3790 return $_;
3791 }
3792
3793 sub switch_underline {
3794 my $data = shift;
3795
3796 $data = "\037$data\037";
3797
3798 return $data;
3799 }
3800
3801 sub switch_uppercase {
3802 my $data = shift;
3803
3804 $data = uc($data);
3805
3806 return $data;
3807 }
3808
3809 sub switch_words {
3810 my $data = shift;
3811 my $output;
3812 my @numbers;
3813
3814 if ($option{dau_words_range} =~ /^([1-9])-([1-9])$/) {
3815 my $x = $1;
3816 my $y = $2;
3817 unless ($x <= $y) {
3818 print_err('Invalid value for setting dau_words_range.');
3819 return;
3820 }
3821 if ($x == $y) {
3822 push(@numbers, $x);
3823 } elsif ($x < $y) {
3824 for (my $i = $x; $i <= $y; $i++) {
3825 push(@numbers, $i);
3826 }
3827 }
3828 } else {
3829 print_err('Invalid value for dau_words_range.');
3830 return;
3831 }
3832 my $random = $numbers[rand(@numbers)];
3833 while ($data =~ /((?:.*?(?:\s+|$)){1,$random})/g) {
3834 $output .= "$1\n"
3835 unless (length($1) == 0);
3836 $random = $numbers[rand(@numbers)];
3837 }
3838
3839 $output =~ s/\s*$//;
3840
3841 return $output;
3842 }
3843
3844 ################################################################################
3845 # Subroutines (signals)
3846 ################################################################################
3847
3848 sub signal_channel_destroyed {
3849 my ($channel) = @_;
3850
3851 my $channel_name = $channel->{name};
3852 my $network_name = $channel->{server}->{tag};
3853
3854 $daumode{channels_in}{$network_name}{$channel_name} = 0;
3855 $daumode{channels_out}{$network_name}{$channel_name} = 0;
3856 $daumode{channels_in_modes}{$network_name}{$channel_name} = '';
3857 $daumode{channels_out_modes}{$network_name}{$channel_name} = '';
3858 }
3859
3860 sub signal_channel_joined {
3861 my ($channel) = @_;
3862
3863 # Resume babbles
3864
3865 if (defined($babble{timer_writing})) {
3866 if ($babble{channel}->{name} eq $channel->{name} &&
3867 $babble{channel}->{server}->{tag} eq $channel->{server}->{tag})
3868 {
3869 $channel->print('%9dau.pl:%9 Continuing babble...');
3870 timer_babble_writing();
3871 }
3872 }
3873
3874 # Automatically set daumode
3875
3876 daumode_channels();
3877 }
3878
3879 sub signal_command_msg {
3880 my ($args, $server, $witem) = @_;
3881
3882 $args =~ /^(?:-\S+\s)?(?:\S*)\s(.*)/;
3883 my $data = $1;
3884
3885 $command_in .= "$data\n";
3886
3887 Irssi::signal_stop();
3888 }
3889
3890 sub signal_complete_word {
3891 my ($list, $window, $word, $linestart, $want_space) = @_;
3892
3893 # Parsing the commandline for dau.pl is relatively complicated.
3894 # TAB completion depends on commandline parsing in dau.pl.
3895 # Script autors looking for a simple example for irssi's
3896 # TAB completion are wrong here.
3897
3898 my $server = Irssi::active_server();
3899 my $channel = $window->{active};
3900 my @switches_combo = map { $_ = "--$_" } keys %{ $switches{combo} };
3901 my @switches_nocombo = map { $_ = "--$_" } keys %{ $switches{nocombo} };
3902 my @nicks = ();
3903
3904 # Only complete when the commandline starts with '${k}dau'.
3905 # If not, let irssi do the work
3906
3907 return unless ($linestart =~ /^\Q${k}\Edau/i);
3908
3909 # Remove everything syntactically correct thing of $linestart.
3910 # If there is anything else but whitespace at the end of
3911 # commandline parsing, we have an syntax error.
3912 # If we have a syntax error, complete only nicks.
3913
3914 $linestart =~ s/^\Q${k}\Edau ?//i;
3915
3916 # Generate list of nicks in current channel for later use
3917
3918 if (defined($channel->{type}) && $channel->{type} eq 'CHANNEL') {
3919 foreach my $nick ($channel->nicks()) {
3920 if ($nick->{nick} =~ /^\Q$word\E/i &&
3921 $window->{active_server}->{nick} ne $nick->{nick})
3922 {
3923 push(@nicks, $nick->{nick});
3924 }
3925 }
3926 }
3927
3928 # Variables
3929
3930 my $combo = 0; # Boolean: True if last switch was one of keys %{ $switches{combo} }
3931 my $syntax_error = 0; # Boolean: True if syntax error found
3932 my $counter = 0; # Integer: Counts first level options
3933 my $first_level_option = ''; # String: Last first level option
3934 my $second_level_option = ''; # String: Last second level option
3935 my $third_level_option = 0; # Boolean: True if found a third level option
3936
3937 # Parsing commandline now. Set variables accordingly.
3938
3939 OUTER: while ($linestart =~ /^--(\w+) ?/g) {
3940
3941 $second_level_option = '';
3942 $third_level_option = 0;
3943
3944 # Found a first level option (combo)
3945
3946 if (ref($switches{combo}{$1}{'sub'})) {
3947 $first_level_option = $1;
3948 $combo = 1;
3949 }
3950
3951 # Found a first level option (nocombo)
3952
3953 elsif (ref($switches{nocombo}{$1}{'sub'}) && $counter == 0) {
3954 $first_level_option = $1;
3955 $combo = 0;
3956 }
3957
3958 # Not a first level option => Syntax error
3959
3960 else {
3961 $syntax_error = 1;
3962 last OUTER;
3963 }
3964
3965 # Syntactically correct => remove it
3966
3967 $linestart =~ s/^--\w+ ?//;
3968
3969 # Checkout if there are Second- or third level options
3970
3971 INNER: while ($linestart =~ /^-(\w+)(?: ('.*?(?<![\\])'|\S+))? ?/g) {
3972
3973 my $second_level = $1;
3974 my $third_level = $2 || '';
3975
3976 $third_level =~ s/^'//;
3977 $third_level =~ s/'$//;
3978 $third_level =~ s/\\'/'/g;
3979
3980 # Do the same for combo and nocombo-options. They have to be
3981 # handled separately anyway.
3982
3983 # combo...
3984
3985 if ($combo) {
3986
3987 # Found a second level option
3988
3989 if ($switches{combo}{$first_level_option}{$second_level}) {
3990 $second_level_option = $second_level;
3991 }
3992
3993 # Not a second level option => Syntax error
3994
3995 else {
3996 $syntax_error = 1;
3997 last OUTER;
3998 }
3999
4000 # Syntactically correct => remove it
4001
4002 $linestart =~ s/^-\w+//;
4003
4004 # Found something in the regexp of the INNER-while-loop-condition,
4005 # which is perhaps a third level option
4006
4007 if ($third_level) {
4008
4009 # Found a third level option
4010
4011 if ($switches{combo}{$first_level_option}{$second_level_option}{$third_level} ||
4012 $switches{combo}{$first_level_option}{$second_level_option}{'*'})
4013 {
4014 $third_level_option = 1;
4015
4016 # Syntactically correct => remove it
4017
4018 $linestart =~ s/^(?: ('.*?(?<![\\])'|\S+))? ?//;
4019 }
4020
4021 # Not a third level option => Syntax error
4022
4023 else {
4024 $syntax_error = 1;
4025 last OUTER;
4026 }
4027
4028 # Nothing found which comes into question for a third level option.
4029 # The commandline has to be empty now (remember: everything
4030 # syntactically correct has been removed) or we have a syntax error.
4031
4032 } else {
4033
4034 # Empty! Later we will complete to third level options
4035
4036 if ($linestart =~ /^\s*$/) {
4037 $third_level_option = 0;
4038 }
4039
4040 # Not empty => Syntax error
4041
4042 else {
4043 $syntax_error = 1;
4044 last OUTER;
4045 }
4046 }
4047
4048 # nocombo...
4049
4050 } else {
4051
4052 # Found a second level option
4053
4054 if ($switches{nocombo}{$first_level_option}{$second_level}) {
4055 $second_level_option = $second_level;
4056 }
4057
4058 # Not a second level option => Syntax error
4059
4060 else {
4061 $syntax_error = 1;
4062 last OUTER;
4063 }
4064
4065 # Syntactically correct => remove it
4066
4067 $linestart =~ s/^-\w+//;
4068
4069 # Found something in the regexp of the INNER while loop condition,
4070 # which is perhaps a third level option
4071
4072 if ($third_level) {
4073
4074 # Found a third level option
4075
4076 if ($switches{nocombo}{$first_level_option}{$second_level_option}{$third_level} ||
4077 $switches{nocombo}{$first_level_option}{$second_level_option}{'*'})
4078 {
4079 $third_level_option = 1;
4080
4081 # Syntactically correct => remove it
4082
4083 $linestart =~ s/^(?: ('.*?(?<![\\])'|\S+))? ?//;
4084 }
4085
4086 # Not a third level option => Syntax error
4087
4088 else {
4089 $syntax_error = 1;
4090 last OUTER;
4091 }
4092
4093 # Nothing found which comes into question for a third level option.
4094 # The commandline has to be empty now (remember: everything
4095 # syntactically correct has been removed) or we have a syntax error.
4096
4097 } else {
4098
4099 # Empty! Later we will complete to third level options
4100
4101 if ($linestart =~ /^\s*$/) {
4102 $third_level_option = 0;
4103 }
4104
4105 # Not empty => Syntax error
4106
4107 else {
4108 $syntax_error = 1;
4109 last OUTER;
4110 }
4111 }
4112 }
4113 }
4114 } continue {
4115 $counter++;
4116 }
4117
4118 # End of commandline-parsing.
4119 # Everything syntactically correct removed.
4120 # If commandline is not empty now, we have a syntax error.
4121
4122 if ($linestart !~ /^\s*$/) {
4123 $syntax_error = 1;
4124 }
4125
4126 # Do the TAB completion
4127
4128 @$list = ();
4129
4130 if ($syntax_error) {
4131 foreach my $x (sort @nicks) {
4132 if($x =~ /^$word/i) {
4133 push(@$list, $x);
4134 }
4135 }
4136 }
4137 elsif ($counter == 0) {
4138 foreach my $x ((sort(@switches_combo, @switches_nocombo), sort(@nicks))) {
4139 if($x =~ /^$word/i) {
4140 push(@$list, $x);
4141 }
4142 }
4143 }
4144 elsif (($combo && $first_level_option && $second_level_option && $third_level_option) ||
4145 ($combo && $first_level_option && !$second_level_option && !$third_level_option))
4146 {
4147 my @switches_second_level = grep !/^-sub$/, map { $_ = "-$_" }
4148 keys %{ $switches{combo}{$first_level_option} };
4149
4150 foreach my $x ((sort(@switches_second_level), sort(@switches_combo), sort(@nicks))) {
4151 if($x =~ /^$word/i) {
4152 push(@$list, $x);
4153 }
4154 }
4155 }
4156 elsif ((!$combo && $counter == 1 && $first_level_option && $second_level_option && $third_level_option) ||
4157 (!$combo && $counter == 1 && $first_level_option && !$second_level_option && !$third_level_option))
4158 {
4159 my @switches_second_level = grep !/^-sub$/, map { $_ = "-$_" }
4160 keys %{ $switches{nocombo}{$first_level_option} };
4161
4162 foreach my $x (sort(@switches_second_level)) {
4163 if($x =~ /^$word/i) {
4164 push(@$list, $x);
4165 }
4166 }
4167 }
4168 elsif ($combo && $first_level_option && $second_level_option && !$third_level_option) {
4169 my @switches_third_level = grep !/^\*$/,
4170 keys %{ $switches{combo}{$first_level_option}{$second_level_option} };
4171
4172 foreach my $x (sort(@switches_third_level)) {
4173 if($x =~ /^$word/i) {
4174 push(@$list, $x);
4175 }
4176 }
4177 }
4178 elsif (!$combo && $counter == 1 && $first_level_option && $second_level_option && !$third_level_option) {
4179 my @switches_third_level = grep !/^\*$/,
4180 keys %{ $switches{nocombo}{$first_level_option}{$second_level_option} };
4181
4182 foreach my $x ((sort(@switches_third_level), sort(@nicks))) {
4183 if($x =~ /^$word/i) {
4184 push(@$list, $x);
4185 }
4186 }
4187 }
4188
4189 Irssi::signal_stop();
4190 }
4191
4192 sub signal_event_404 {
4193 my ($server, $message, $network_name) = @_;
4194
4195 if ($message =~ /^(?:\S+) (\S+) :Cannot send to channel$/) {
4196 my $channel_name = $1;
4197
4198 if ($server->{tag} eq $babble{channel}->{server}->{tag} &&
4199 $babble{channel}->{name} eq $channel_name &&
4200 defined($babble{timer_writing}))
4201 {
4202 Irssi::timeout_remove($babble{timer_writing});
4203 undef($babble{timer_writing});
4204 print_out("%9dau.pl:%9 Could not send message to $babble{channel}->{name}/$babble{channel}->{server}->{tag}. Cancelling babble.");
4205 return;
4206 }
4207 }
4208
4209 if ($message =~ /^(?:\S+) (\S+) :(.*)/) {
4210 Irssi::print("$1 $2");
4211 } else {
4212 Irssi::print($message);
4213 }
4214 }
4215
4216 sub signal_event_privmsg {
4217 my ($server, $data, $nick, $hostmask) = @_;
4218 my ($channel_name, $text) = split / :/, $data, 2;
4219 my $channel_rec = $server->channel_find($channel_name);
4220 $channel_name = lc($channel_name);
4221 my $server_name = lc($server->{tag});
4222 my %lookup;
4223
4224 while ($option{dau_remote_channellist} =~ /\s*([^\/]+)\/([^,]+)\s*,?/g) {
4225 my $channel = $1;
4226 $channel = lc($channel);
4227 my $ircnet = $2;
4228 $ircnet = lc($ircnet);
4229 $lookup{$ircnet}{$channel} = 1;
4230 }
4231 if (lc($option{dau_remote_channelpolicy}) eq 'allow') {
4232 return if ($lookup{$server_name}{$channel_name});
4233 } elsif (lc($option{dau_remote_channelpolicy}) eq 'deny') {
4234 return unless ($lookup{$server_name}{$channel_name});
4235 } else {
4236 return;
4237 }
4238
4239 # Remove formatting so dau.pl can reply to a colored, underlined, ...
4240 # question
4241
4242 $text =~ s/\003\d?\d?(?:,\d?\d?)?|\002|\006|\007|\016|\01f|\037//g;
4243
4244 my $regexp = switch_parse_special($option{dau_remote_question_regexp}, $channel_rec);
4245 if ($text =~ /$regexp/) {
4246 my $reply = return_random_list_item($option{dau_remote_question_reply});
4247 $reply =~ s/(?<![\\])\$nick/$nick/g;
4248 $reply = parse_text($reply, $channel_rec);
4249
4250 output_text($server, $channel_name, $reply);
4251 }
4252 }
4253
4254 sub signal_nick_mode_changed {
4255 my ($channel, $nick, $setby, $mode, $type) = @_;
4256 my ($reply, %lookup);
4257 my $channel_name = lc($channel->{name});
4258 my $network_name = lc($channel->{server}->{tag});
4259 my $op = $nick_mode{$network_name}{$channel_name}{op}; # mode before nick change
4260 my $voice = $nick_mode{$network_name}{$channel_name}{voice}; # mode before nick change
4261
4262 return if ($channel->{server}->{nick} ne $nick->{nick});
4263 if ($nick->{nick} eq $setby || $setby eq 'irc.psychoid.net') {
4264 build_nick_mode_struct();
4265 return;
4266 }
4267
4268 # Only act in channels where the user wants dau.pl to act
4269
4270 while ($option{dau_remote_channellist} =~ /\s*([^\/]+)\/([^,]+)\s*,?/g) {
4271 my $channel = $1;
4272 $channel = lc($channel);
4273 my $ircnet = $2;
4274 $ircnet = lc($ircnet);
4275 $lookup{$ircnet}{$channel} = 1;
4276 }
4277 if (lc($option{dau_remote_channelpolicy}) eq 'allow') {
4278 if ($lookup{$network_name}{$channel_name}) {
4279 build_nick_mode_struct();
4280 return;
4281 }
4282 } elsif (lc($option{dau_remote_channelpolicy}) eq 'deny') {
4283 unless ($lookup{$network_name}{$channel_name}) {
4284 build_nick_mode_struct();
4285 return;
4286 }
4287 } else {
4288 build_nick_mode_struct();
4289 return;
4290 }
4291
4292 # Now we are in the right channel
4293
4294 if ($option{dau_remote_permissions} =~ /^[01]1[01][01][01][01]$/) {
4295 if ($mode eq '+' && $type eq '+' && (!$voice && !$op)) {
4296 $reply = return_random_list_item($option{dau_remote_voice_reply});
4297 $reply =~ s/(?<![\\])\$nick/$setby/g;
4298 $reply = parse_text($reply, $channel);
4299 }
4300 }
4301 if ($option{dau_remote_permissions} =~ /^[01][01]1[01][01][01]$/) {
4302 if ($mode eq '@' && $type eq '+' && !$op) {
4303 $reply = return_random_list_item($option{dau_remote_op_reply});
4304 $reply =~ s/(?<![\\])\$nick/$setby/g;
4305 $reply = parse_text($reply, $channel);
4306 }
4307 }
4308 if ($option{dau_remote_permissions} =~ /^[01][01][01]1[01][01]$/) {
4309 if ($mode eq '+' && $type eq '-' && ($voice && !$op)) {
4310 $reply = return_random_list_item($option{dau_remote_devoice_reply});
4311 $reply =~ s/(?<![\\])\$nick/$setby/g;
4312 $reply = parse_text($reply, $channel);
4313 }
4314 }
4315 if ($option{dau_remote_permissions} =~ /^[01][01][01][01]1[01]$/) {
4316 if ($mode eq '@' && $type eq '-' && $op) {
4317 $reply = return_random_list_item($option{dau_remote_deop_reply});
4318 $reply =~ s/(?<![\\])\$nick/$setby/g;
4319 $reply = parse_text($reply, $channel);
4320 }
4321 }
4322
4323 # rebuild nick mode struct and print out the reply
4324
4325 build_nick_mode_struct();
4326 output_text($channel, $channel->{name}, $reply);
4327 }
4328
4329 sub signal_send_text {
4330 my ($data, $server, $witem) = @_;
4331 my $output;
4332
4333 return unless (defined($server) && $server && $server->{connected});
4334 return unless (defined($witem) && $witem &&
4335 ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'));
4336
4337 if ($daumode{channels_out}{$server->{tag}}{$witem->{name}} == 1) {
4338 if ($daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} eq '') {
4339 $output = parse_text($daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} . $data, $witem);
4340 } else {
4341 $output = parse_text($daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} . ' ' . $data, $witem);
4342 }
4343
4344 output_text($witem, $witem->{name}, $output);
4345
4346 Irssi::signal_stop();
4347 }
4348 }
4349
4350 sub signal_setup_changed {
4351 set_settings();
4352
4353 # setting changed/added => change/add it here
4354
4355 # setting cmdchars
4356
4357 $k = Irssi::parse_special('$k');
4358
4359 # babble history
4360
4361 if (defined($babble{history}) && ref($babble{history}) eq 'ARRAY') {
4362 my @history;
4363 my $i = 1;
4364 foreach (@{ $babble{history} } ) {
4365 if ($i++ <= $option{dau_babble_history_size}) {
4366 push(@history, $_);
4367 }
4368 }
4369 @{ $babble{history} } = @history;
4370 }
4371
4372 # setting dau_cowsay_cowpath
4373
4374 cowsay_cowlist($option{dau_cowsay_cowpath});
4375
4376 # setting dau_figlet_fontpath
4377
4378 figlet_fontlist($option{dau_figlet_fontpath});
4379
4380 # setting dau_daumode_channels
4381
4382 daumode_channels();
4383
4384 # setting dau_statusbar_daumode_hide_when_off
4385
4386 Irssi::statusbar_items_redraw('daumode');
4387
4388 # timer for the babble feature
4389
4390 timer_remote_babble_reset();
4391
4392 # signal handling
4393
4394 signal_handling();
4395 }
4396
4397 sub signals_daumode_in {
4398 my ($server, $data, $nick, $hostmask, $target) = @_;
4399 my $channel_rec = $server->channel_find($target);
4400 my $i_channel = $daumode{channels_in}{$server->{tag}}{$target};
4401 my $i_modes = $daumode{channels_in_modes}{$server->{tag}}{$target};
4402 my $modified_msg;
4403
4404 return unless (defined($server) && $server && $server->{connected});
4405
4406 # Not one of the channels where daumode for incoming messages is turned on.
4407 # In those channels print out the message as it is and leave the subroutine
4408
4409 if (!$i_channel) {
4410 return;
4411 }
4412
4413 # Evil Hack?
4414 # I had to dauify every incoming messages. Using &signal_continue was
4415 # not possible because --words f.e. generates output over multiple lines. So I
4416 # had to create multiple messages using &signal_emit. Those just created
4417 # messages shouldn't be dauified again when entering this subroutine. I
4418 # couldn't prevent irssi from entering this subroutine again after
4419 # dauifying the text so the messages had to be 'marked'. Marked
4420 # messages will not be dauified again. I think \x02 at the beginning of the
4421 # message is ok for that.
4422
4423 if ($data =~ s/^\x02//) {
4424 Irssi::signal_continue($server, $data, $nick, $hostmask, $target);
4425 } else {
4426 if ($i_modes ne '') {
4427 $modified_msg = parse_text($i_modes . ' ' . $data, $channel_rec);
4428 } else {
4429 $modified_msg = parse_text($data, $channel_rec);
4430 }
4431
4432 if ($modified_msg =~ /\n/) {
4433 for my $line (split /\n/, $modified_msg) {
4434 Irssi::signal_emit(Irssi::signal_get_emitted(), $server, "\x02$line", $nick, $hostmask, $target);
4435 Irssi::signal_stop();
4436 }
4437 } else {
4438 Irssi::signal_emit(Irssi::signal_get_emitted(), $server, "\x02$modified_msg", $nick, $hostmask, $target);
4439 Irssi::signal_stop();
4440 }
4441 }
4442 }
4443
4444 ################################################################################
4445 # Subroutines (statusbar)
4446 ################################################################################
4447
4448 sub statusbar_daumode {
4449 my ($item, $get_size_only) = @_;
4450 my ($status_in, $status_out, $modes_in, $modes_out);
4451 my $server = Irssi::active_server();
4452 my $witem = Irssi::active_win()->{active};
4453 my $theme = Irssi::current_theme();
4454 my $format = $theme->format_expand('{sb_daumode}');
4455
4456 if ($witem && ref($witem) &&
4457 $server && ref($server) &&
4458 ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'))
4459 {
4460 if (defined($daumode{channels_in}{$server->{tag}}{$witem->{name}}) &&
4461 $daumode{channels_in}{$server->{tag}}{$witem->{name}} == 1)
4462 {
4463 $status_in = 'ON';
4464 } else {
4465 $status_in = 'OFF';
4466 }
4467
4468 if (defined($daumode{channels_out}{$server->{tag}}{$witem->{name}}) &&
4469 $daumode{channels_out}{$server->{tag}}{$witem->{name}} == 1)
4470 {
4471 $status_out = 'ON';
4472 } else {
4473 $status_out = 'OFF';
4474 }
4475
4476 # Hide statusbaritem if setting dau_statusbar_daumode_hide_when_off
4477 # is turned on and daumode is turned off
4478
4479 if ($status_in eq 'OFF' && $status_out eq 'OFF' && $option{dau_statusbar_daumode_hide_when_off}) {
4480 $item->{min_size} = $item->{max_size} = 0;
4481 return;
4482 }
4483
4484 if ($status_in eq 'ON') {
4485 $modes_in = $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} || $option{dau_standard_options};
4486 } else {
4487 $modes_in = '';
4488 }
4489 if ($status_out eq 'ON') {
4490 $modes_out = $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} || $option{dau_standard_options};
4491 } else {
4492 $modes_out = '';
4493 }
4494
4495 if ($format) {
4496 $format = $theme->format_expand("{sb_daumode $status_out $modes_out $status_in $modes_in}");
4497 } else {
4498 if ($status_in eq 'OFF' && $status_out eq 'OFF') {
4499 $format = $theme->format_expand("{sb daumode: <- $status_in | -> $status_out}");
4500 }
4501 elsif ($status_in eq 'OFF' && $status_out eq 'ON') {
4502 $format = $theme->format_expand("{sb daumode: <- $status_in | -> $status_out ($modes_out)}");
4503 }
4504 elsif ($status_in eq 'ON' && $status_out eq 'OFF') {
4505 $format = $theme->format_expand("{sb daumode: <- $status_in ($modes_in) | -> $status_out}");
4506 }
4507 elsif ($status_in eq 'ON' && $status_out eq 'ON') {
4508 $format = $theme->format_expand("{sb daumode: <- $status_in ($modes_in) | -> $status_out ($modes_out)}");
4509 }
4510 }
4511 } else {
4512 $item->{min_size} = $item->{max_size} = 0;
4513 return;
4514 }
4515
4516 $item->default_handler($get_size_only, $format, '', 1);
4517 }
4518
4519 ################################################################################
4520 # Subroutines (timer)
4521 ################################################################################
4522
4523 # for the babble remote feature
4524
4525 sub timer_away_reminder {
4526 my $id = shift;
4527 $id =~ m{^([^/]+)/(.+)};
4528 my $channel = $1;
4529 my $network = $2;
4530
4531 my $server_rec = Irssi::server_find_tag($network);
4532
4533 unless (defined($server_rec) && $server_rec) {
4534 return;
4535 }
4536
4537 my $channel_rec = $server_rec->channel_find($channel);
4538
4539 unless (defined($channel_rec) && $channel_rec &&
4540 ($channel_rec->{type} eq 'CHANNEL' || $channel_rec->{type} eq 'QUERY'))
4541 {
4542 return;
4543 }
4544
4545 ################################################################################
4546 # Open file
4547 ################################################################################
4548
4549 my $file = "$option{dau_files_root_directory}/$option{dau_files_away}";
4550 my @file;
4551 unless (tie(@file, 'Tie::File', $file)) {
4552 print_err("Cannot tie $file!");
4553 return;
4554 }
4555
4556 ################################################################################
4557 # Go through file
4558 ################################################################################
4559
4560 # Format:
4561 # channel | network | time | options | reminder | interval | reason
4562
4563 my ($time, $options, $reminder, $interval, $reason);
4564 foreach my $line (@file) {
4565 if ($line =~ m{^$channel\x02$network\x02(\d+)\x02([^\x02]*)\x02(\d)\x02(\d+)\x02(.*)}) {
4566 $time = $1;
4567 $options = $2;
4568 $reminder = $3;
4569 $interval = $4;
4570 $reason = $5;
4571 last;
4572 }
4573 }
4574
4575 ################################################################################
4576 # Special variables
4577 ################################################################################
4578
4579 my $output = $option{dau_away_reminder_text};
4580
4581 # $time
4582
4583 my $difference = time_diff_verbose(time, $time);
4584 $output =~ s/\$time/$difference/g;
4585
4586 # $reason
4587
4588 if ($option{dau_away_quote_reason}) {
4589 $reason =~ s/\\/\\\\/g;
4590 $reason =~ s/\$/\\\$/g;
4591 }
4592 $output =~ s/\$reason/$reason/g;
4593
4594 ################################################################################
4595 # Write text to channels. Write changes back to file
4596 ################################################################################
4597
4598 untie(@file);
4599
4600 $output = parse_text("$options $output", $channel_rec);
4601
4602 output_text($channel_rec, $channel_rec->{name}, $output);
4603 }
4604
4605 # all babbles: the writing to the channel
4606
4607 sub timer_babble_writing {
4608
4609 # check if we are still on the channel
4610
4611 my $onChannel = 0;
4612 foreach my $server (Irssi::servers()) {
4613 if ($server->{tag} eq $babble{channel}->{server}->{tag}) {
4614 foreach my $channel ($server->channels()) {
4615 if ($babble{channel}->{name} eq $channel->{name}) {
4616 if ($babble{channel} != $channel) {
4617 $babble{channel} = $channel;
4618 }
4619 $onChannel = 1;
4620 }
4621 }
4622 }
4623 }
4624 if (!$onChannel) {
4625 Irssi::timeout_remove($babble{timer_writing});
4626 print_out("%9dau.pl:%9 You are not on $babble{channel}->{name}/$babble{channel}->{server}->{tag}. Stalling babble.");
4627 return;
4628 }
4629
4630 # restore the variables
4631
4632 $command_out = $babble{command_out_history}{$babble{counter}};
4633 $command_out_activated = $babble{command_out_history_switch}{$babble{counter}};
4634
4635 # then output text
4636
4637 output_text($babble{channel}, $babble{channel}->{name}, $babble{line});
4638
4639 # And go to the "managing" subroutine...
4640
4641 timer_babble_writing_reset();
4642 }
4643
4644 # all babbles: the timer for the next writing
4645
4646 sub timer_babble_writing_reset {
4647 my $interval = 0;
4648
4649 # Remove used writing timer, if existent (at the first run we don't have any timer)
4650
4651 Irssi::timeout_remove($babble{timer_writing}) if (defined($babble{timer_writing}));
4652
4653 # At each run of this managing subroutine remove one line of text
4654
4655 $babble{text} =~ s/^(.*?)\n//;
4656 $babble{line} = $1;
4657
4658 if ($babble{line} =~ s/^BABBLE_INTERVAL=(\d+)\x02//) {
4659 $interval = $1;
4660 $babble{line} = parse_text("$option{dau_babble_options_line_by_line} $babble{line}");
4661 my $counter = $babble{counter} + 1;
4662 $babble{command_out_history}{$counter} = $command_out;
4663 $babble{command_out_history_switch}{$counter} = $command_out_activated;
4664 }
4665
4666 # If there is still some text left, add a new timer for the next line
4667
4668 if (length($babble{text}) != 0 || length($babble{line}) != 0) {
4669
4670 if ($babble{counter}++ == 0) {
4671 if ($option{dau_babble_verbose} && $babble{numberoflines} >= $option{dau_babble_verbose_minimum_lines}) {
4672 $babble{channel}->print("%9dau.pl:%9 Babbling $babble{numberoflines} line" . ($babble{numberoflines} > 1 ? 's' : '') . ' now:');
4673 }
4674 $interval = 50;
4675 }
4676
4677 if ($interval < 10) {
4678 # Calculate the writing breaks
4679 # The longer the next line is the longer the break will be
4680
4681 $interval = 1000 + rand(2000) +
4682 50 * length($babble{line}) +
4683 rand(25 * length($babble{line}));
4684
4685 # Some characters need more time to write
4686
4687 while ($babble{line} =~ /[^a-z ]/gio) {
4688 $interval += (75 + rand(25));
4689 }
4690
4691 $interval = int($interval);
4692 }
4693
4694 # Set timer
4695
4696 $babble{timer_writing} = Irssi::timeout_add($interval, \&timer_babble_writing, '');
4697 }
4698
4699 # No text left?
4700
4701 else {
4702 if ($option{dau_babble_verbose} && $babble{numberoflines} >= $option{dau_babble_verbose_minimum_lines}) {
4703 $babble{channel}->print('%9dau.pl:%9 Finished babbling.');
4704 }
4705
4706 # remove the timer
4707
4708 undef($babble{timer_writing});
4709
4710 if ($babble{remote}) {
4711 timer_remote_babble_reset();
4712 }
4713 }
4714 }
4715
4716 # remote babble: initialize
4717
4718 sub timer_remote_babble {
4719 my $text;
4720
4721 # Push all channels where it's ok to babble text in @channels
4722
4723 my %lookup;
4724 while ($option{dau_remote_babble_channellist} =~ /\s*([^\/]+)\/([^,]+)\s*,?/g) {
4725 my $channel = $1;
4726 $channel = lc($channel);
4727 my $ircnet = $2;
4728 $ircnet = lc($ircnet);
4729 $lookup{$ircnet}{$channel} = 1;
4730 }
4731
4732 my @channels;
4733 foreach my $server (Irssi::servers()) {
4734 my $server_name = lc($server->{tag});
4735
4736 foreach my $channel ($server->channels()) {
4737 my $channel_name = lc($channel->{name});
4738
4739 if (lc($option{dau_remote_babble_channelpolicy}) eq 'allow' &&
4740 !$lookup{$server_name}{$channel_name})
4741 {
4742 push(@channels, $channel);
4743 }
4744 elsif (lc($option{dau_remote_babble_channelpolicy}) eq 'deny' &&
4745 $lookup{$server_name}{$channel_name})
4746 {
4747 push(@channels, $channel);
4748 }
4749 }
4750 }
4751
4752 # No channels found => return
4753
4754 return if (@channels == 0);
4755
4756 # Choose one of the @channels
4757
4758 my $channel = $channels[rand(@channels)];
4759
4760 # If something is babbling right now, stop
4761
4762 if (defined($babble{timer_writing})) {
4763 return;
4764 }
4765
4766 # else get text from file
4767
4768 else {
4769 my @filter = ();
4770 $text = &babble_get_text($channel, \@filter, undef, $option{dau_babble_history_size});
4771 }
4772
4773 # Stop the timer for the big breaks.
4774
4775 Irssi::timeout_remove($babble{timer_remote}) if (defined($babble{timer_remote}));
4776
4777 # Start the writing.
4778
4779 babble_start($channel, $text, 1);
4780 }
4781
4782 # remote babble: reset
4783
4784 sub timer_remote_babble_reset {
4785 Irssi::timeout_remove($babble{timer_remote}) if (defined($babble{timer_remote}));
4786
4787 # Do not set the timer, if the permission-bit is not set
4788
4789 return unless ($option{dau_remote_permissions} =~ /^[01][01][01][01][01]1$/);
4790
4791 # Calculate interval
4792
4793 my $interval = babble_set_interval($option{dau_remote_babble_interval}, $option{dau_remote_babble_interval_accuracy});
4794
4795 # Set timer
4796
4797 if ($interval != 0) {
4798 $babble{timer_remote} = Irssi::timeout_add($interval, \&timer_remote_babble, '');
4799 }
4800 }
4801
4802 ################################################################################
4803 # Helper subroutines
4804 ################################################################################
4805
4806 sub babble_get_text {
4807 my ($channel, $filter, $nicks, $history_size) = @_;
4808 my $output;
4809
4810 # Return a random line from the dau_files_babble_messages file
4811
4812 my ($text, @file, @filterindex);
4813 my $file = "$option{dau_files_root_directory}/$option{dau_files_babble_messages}";
4814
4815 if (-e $file && -r $file) {
4816 unless (tie(@file, 'Tie::File', $file)) {
4817 print_err("Cannot tie $file!");
4818 return;
4819 }
4820 } else {
4821 print_err("Couldn't access babble file '$file'!");
4822 return;
4823 }
4824
4825 my @nicks_channel = ();
4826 my @opnicks_channel = ();
4827 if (defined($channel) && $channel && $channel->{type} eq 'CHANNEL') {
4828 foreach my $nick ($channel->nicks()) {
4829 next if ($channel->{server}->{nick} eq $nick->{nick});
4830 push(@nicks_channel, $nick->{nick});
4831 push(@opnicks_channel, $nick->{nick}) if ($nick->{op});
4832 }
4833 }
4834
4835 my @compiled_patterns_filter;
4836 eval { # possible user input here
4837 @compiled_patterns_filter = map { qr/$_/i } @$filter;
4838 };
4839 if ($@) {
4840 print_err("The %9-filter%9 you gave wasn't a valid regular expression.");
4841 print_err($@);
4842 return;
4843 }
4844 my $compiled_pattern_nicks = qr/(?<![\\])\$nick(\d+)/;
4845 my $compiled_pattern_ops = qr/(?<![\\])\$opnick(\d+)/;
4846
4847 my $i = 0;
4848 foreach my $line (@file) {
4849 my $add = 1;
4850
4851 # Every filter has to match
4852
4853 FILTER: foreach my $filter (@compiled_patterns_filter) {
4854 if ($line !~ /$filter/) {
4855 $add = 0;
4856 last FILTER;
4857 }
4858 }
4859
4860 # Check against history
4861
4862 if ($add) {
4863 my $i = 1;
4864 foreach (@{ $babble{history} }) {
4865 if ($i++ <= $history_size) {
4866 if ($line eq $_) {
4867 $add = 0;
4868 }
4869 }
4870 }
4871 }
4872
4873 # Don't babble at non-existent nicks
4874
4875 if ($add) {
4876 my $minimum_number_nicks = 0;
4877 while ($line =~ /$compiled_pattern_nicks/g) {
4878 if ($1 > $minimum_number_nicks) {
4879 $minimum_number_nicks = $1;
4880 }
4881 }
4882 if (defined($nicks) && @$nicks > 0) {
4883 if (scalar(@$nicks) < $minimum_number_nicks) {
4884 $add = 0;
4885 }
4886 } else {
4887 if (scalar(@nicks_channel) < $minimum_number_nicks) {
4888 $add = 0;
4889 }
4890 }
4891 }
4892
4893 # Don't babble at non-existent channel operators
4894
4895 if ($add) {
4896 if ($line =~ /$compiled_pattern_ops/) {
4897 my $minimum_number_ops = 0;
4898 while ($line =~ /$compiled_pattern_ops/g) {
4899 if ($1 > $minimum_number_ops) {
4900 $minimum_number_ops = $1;
4901 }
4902 }
4903 if (defined($nicks) && @$nicks > 0) {
4904 if (scalar(@$nicks) < $minimum_number_ops) {
4905 $add = 0;
4906 }
4907 } else {
4908 if (scalar(@opnicks_channel) < $minimum_number_ops) {
4909 $add = 0;
4910 }
4911 }
4912 }
4913 }
4914
4915 # Add the line as it passed all the tests
4916
4917 if ($add) {
4918 push(@filterindex, $i);
4919 }
4920 $i++;
4921 }
4922 $text = $file[$filterindex[int(rand(@filterindex))]];
4923
4924 if (@filterindex == 0) {
4925 print_err("Babble failed. Possible reasons: a) Too restrictive %9-filter%9 in place b) No matching lines in the babble file c) babble history holding that babble d) Not enough people in the channel");
4926 return;
4927 }
4928
4929 if (!$text) {
4930 print_err("No text to babble.");
4931 return;
4932 }
4933
4934 # Put babble in global history and shorten it, if necessary
4935
4936 @{ $babble{history} } = ($text, @{ $babble{history} });
4937 if (scalar(@{ $babble{history} }) > $option{dau_babble_history_size}) {
4938 pop(@{ $babble{history} });
4939 }
4940
4941 # dauify $text and return the dauified $output
4942
4943 my $options = $option{dau_babble_options_line_by_line};
4944
4945 # We have to keep track of the command history. --me and the --command
4946 # switch change the variables $command_out and $command_out_activated.
4947 # Because they are reset after every run of parse_text() they have to be kept
4948 # in a struct so that the writing timers later can do their job correctly.
4949
4950 my $counter = 1;
4951 $babble{command_out_history} = ();
4952 $babble{command_out_history_switch} = ();
4953
4954 # parse for special characters and substitute them
4955
4956 if (defined($nicks)) {
4957 if (@$nicks > 0) {
4958 for (my $i = 1; $i <= @$nicks; $i++) {
4959 $text =~ s/(?<![\\])\$nick$i/@$nicks[$i - 1]/g;
4960 }
4961 }
4962 $text = switch_parse_special($text, $channel);
4963 } else {
4964 $text = switch_parse_special($text, $channel);
4965 }
4966
4967 # Preprocessing options
4968
4969 if ($option{dau_babble_options_preprocessing} !~ /^\s*$/) {
4970 $text = parse_text("$option{dau_babble_options_preprocessing} \x02$text");
4971 $text =~ s/^\x02//;
4972 }
4973
4974 # Process $text line by line
4975
4976 $text =~ s/\\n/\n/g;
4977 $text =~ s/\n$//;
4978 while ($text =~ /(.*?)(\n|$)/g) {
4979 my $line = $1;
4980
4981 # Exit while loop when finished
4982
4983 last if ($2 ne "\n" && $1 eq "");
4984
4985 # Dauify text
4986
4987 my $newtext = parse_text("$options $line") . "\n";
4988
4989 $output .= $newtext;
4990
4991 # The parsed text ($newtext) can contain more than one line.
4992 # All $newtext lines have the same command.
4993 # The command (MSG, ACTION, ...) has to be remembered.
4994
4995 while ($newtext =~ /\n/g) {
4996 $babble{command_out_history}{$counter} = $command_out;
4997 $babble{command_out_history_switch}{$counter} = $command_out_activated;
4998 $counter++;
4999 }
5000 }
5001
5002 # Lines are separated by newline characters. Maybe there are to many of
5003 # them at the end of the string (probably produced by --figlet, --cowsay, ...).
5004 # That's disturbing the number of lines calculation later.
5005
5006 $output =~ s/\n{2,}$/\n/;
5007
5008 # $output contains now the text to be babbled. It will be split by
5009 # newlines by the babble subroutines and each line will be babbled with
5010 # the correct commands restored.
5011
5012 return $output;
5013 }
5014
5015 sub babble_interval {
5016 return "BABBLE_INTERVAL=" . babble_set_interval(@_) . "\x02";
5017 }
5018
5019 sub babble_set_interval {
5020 my ($time, $accuracy) = @_;
5021
5022 my $interval = time_parse($time);
5023
5024 my $addend;
5025 if ($accuracy == 100) {
5026 $addend = 0;
5027 } elsif ($accuracy > 0 && $accuracy < 100) {
5028 $addend = rand($interval - ($interval * ($accuracy / 100)));
5029 } else {
5030 print_err('Invalid accuracy value');
5031 return;
5032 }
5033
5034 if (int(rand(2))) {
5035 $interval = $interval + $addend;
5036 } else {
5037 $interval = $interval - $addend;
5038 }
5039
5040 $interval = int($interval);
5041
5042 if ($interval < 10 || $interval > 1000000000) {
5043 print_err('Invalid interval value');
5044 return 0;
5045 }
5046
5047 return $interval;
5048 }
5049
5050 sub babble_start {
5051 my ($channel_rec, $text, $remote) = @_;
5052
5053 # These are some global variables for the writing timer
5054
5055 $babble{channel} = $channel_rec;
5056 $babble{counter} = 0;
5057 $babble{text} = "$text\n";
5058 $babble{numberoflines} = 0;
5059 $babble{numberoflines}++ while ($babble{text} =~ /\n/g);
5060 $babble{numberoflines} -= 1;
5061 $babble{remote} = $remote;
5062
5063 Irssi::timeout_remove($babble{timer_writing}) if (defined($babble{timer_writing}));
5064
5065 timer_babble_writing_reset();
5066 }
5067
5068 sub build_nick_mode_struct {
5069 undef(%nick_mode);
5070
5071 foreach my $server (Irssi::servers()) {
5072 my $network_name = lc($server->{tag});
5073
5074 foreach my $channel ($server->channels()) {
5075 my $channel_name = lc($channel->{name});
5076 my $op = $channel->{ownnick}{op};
5077 my $voice = $channel->{ownnick}{voice};
5078
5079 $nick_mode{$network_name}{$channel_name}{op} = $op;
5080 $nick_mode{$network_name}{$channel_name}{voice} = $voice;
5081 }
5082 }
5083 }
5084
5085 sub daumode_channels {
5086 my @items;
5087 my $item;
5088 while ($option{dau_daumode_channels} =~ /([^,]+)/g) {
5089 my $match = $1;
5090 if ($match =~ s/\\$//) {
5091 $item .= "$match,";
5092 } else {
5093 $item .=