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
49use 5.6.0;
50use File::Basename;
51use File::Path;
52use IPC::Open3;
53use Irssi 20021107.0841;
54use Irssi::TextUI;
55use locale;
56use POSIX;
57use re 'eval';
58use strict;
59use Tie::File;
60use 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
81Irssi::command_bind('dau', \&command_dau);
82
83################################################################################
84# Register settings
85# setting changed/added => change/add it here
86################################################################################
87
88# boolean
89Irssi::settings_add_bool('misc', 'dau_away_quote_reason', 1);
90Irssi::settings_add_bool('misc', 'dau_away_reminder', 0);
91Irssi::settings_add_bool('misc', 'dau_babble_verbose', 1);
92Irssi::settings_add_bool('misc', 'dau_color_choose_colors_randomly', 1);
93Irssi::settings_add_bool('misc', 'dau_cowsay_print_cow', 0);
94Irssi::settings_add_bool('misc', 'dau_figlet_print_font', 0);
95Irssi::settings_add_bool('misc', 'dau_silence', 0);
96Irssi::settings_add_bool('misc', 'dau_statusbar_daumode_hide_when_off', 0);
97Irssi::settings_add_bool('misc', 'dau_tab_completion', 1);
98
99# Integer
100Irssi::settings_add_int('misc', 'dau_babble_history_size', 10);
101Irssi::settings_add_int('misc', 'dau_babble_verbose_minimum_lines', 2);
102Irssi::settings_add_int('misc', 'dau_cool_maximum_line', 2);
103Irssi::settings_add_int('misc', 'dau_cool_probability_eol', 20);
104Irssi::settings_add_int('misc', 'dau_cool_probability_word', 20);
105Irssi::settings_add_int('misc', 'dau_remote_babble_interval_accuracy', 90);
106
107# String
108Irssi::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)!');
109Irssi::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)!');
110Irssi::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);
115Irssi::settings_add_str('misc', 'dau_away_reminder_interval', '1 hour');
116Irssi::settings_add_str('misc', 'dau_away_reminder_text', '$N is still away: [ $reason ]. Away time: [ $time ] (sry 4 amsg)');
117Irssi::settings_add_str('misc', 'dau_babble_options_line_by_line', '--nothing');
118Irssi::settings_add_str('misc', 'dau_babble_options_preprocessing', '');
119Irssi::settings_add_str('misc', 'dau_color_codes', 'blue; green; red; magenta; yellow; cyan');
120Irssi::settings_add_str('misc', 'dau_cool_eol_style', 'random');
121Irssi::settings_add_str('misc', 'dau_cowsay_cowlist', '');
122Irssi::settings_add_str('misc', 'dau_cowsay_cowpath', &def_dau_cowsay_cowpath);
123Irssi::settings_add_str('misc', 'dau_cowsay_cowpolicy', 'allow');
124Irssi::settings_add_str('misc', 'dau_cowsay_cowsay_path', &def_dau_cowsay_cowsay_path);
125Irssi::settings_add_str('misc', 'dau_cowsay_cowthink_path', &def_dau_cowsay_cowthink_path);
126Irssi::settings_add_str('misc', 'dau_daumode_channels', '');
127Irssi::settings_add_str('misc', 'dau_delimiter_string', ' ');
128Irssi::settings_add_str('misc', 'dau_figlet_fontlist', 'mnemonic,term,ivrit');
129Irssi::settings_add_str('misc', 'dau_figlet_fontpath', &def_dau_figlet_fontpath);
130Irssi::settings_add_str('misc', 'dau_figlet_fontpolicy', 'allow');
131Irssi::settings_add_str('misc', 'dau_figlet_path', &def_dau_figlet_path);
132Irssi::settings_add_str('misc', 'dau_files_away', '.away');
133Irssi::settings_add_str('misc', 'dau_files_babble_messages', 'babble_messages');
134Irssi::settings_add_str('misc', 'dau_files_cool_suffixes', 'cool_suffixes');
135Irssi::settings_add_str('misc', 'dau_files_root_directory', "$ENV{HOME}/.dau");
136Irssi::settings_add_str('misc', 'dau_files_substitute', 'substitute.pl');
137Irssi::settings_add_str('misc', 'dau_language', 'en');
138Irssi::settings_add_str('misc', 'dau_moron_eol_style', 'random');
139Irssi::settings_add_str('misc', 'dau_parse_special_list_delimiter', ' ');
140Irssi::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);
158Irssi::settings_add_str('misc', 'dau_remote_babble_channellist', '');
159Irssi::settings_add_str('misc', 'dau_remote_babble_channelpolicy', 'deny');
160Irssi::settings_add_str('misc', 'dau_remote_babble_interval', '1 hour');
161Irssi::settings_add_str('misc', 'dau_remote_channellist', '');
162Irssi::settings_add_str('misc', 'dau_remote_channelpolicy', 'deny');
163Irssi::settings_add_str('misc', 'dau_remote_deop_reply', 'you are on my shitlist now @ $nick');
164Irssi::settings_add_str('misc', 'dau_remote_devoice_reply', 'you are on my shitlist now @ $nick');
165Irssi::settings_add_str('misc', 'dau_remote_op_reply', 'thx 4 op @ $nick');
166Irssi::settings_add_str('misc', 'dau_remote_permissions', '000000');
167Irssi::settings_add_str('misc', 'dau_remote_question_regexp', '%%%DISABLED%%%');
168Irssi::settings_add_str('misc', 'dau_remote_question_reply', 'EDIT_THIS_ONE');
169Irssi::settings_add_str('misc', 'dau_remote_voice_reply', 'thx 4 voice @ $nick');
170Irssi::settings_add_str('misc', 'dau_standard_messages', 'hi @ all');
171Irssi::settings_add_str('misc', 'dau_standard_options', '--random');
172Irssi::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
179Irssi::signal_add_last('setup changed', \&signal_setup_changed);
180Irssi::signal_add_last('window changed' => sub { Irssi::statusbar_items_redraw('daumode') });
181Irssi::signal_add_last('window item changed' => sub { Irssi::statusbar_items_redraw('daumode') });
182
183################################################################################
184# Register statusbar items
185################################################################################
186
187Irssi::statusbar_item_register('daumode', '', 'statusbar_daumode');
188
189################################################################################
190# Global variables
191################################################################################
192
193# Timer used by --away
194
195our %away_timer;
196
197# babble
198
199our %babble;
200
201# --command -in
202
203our $command_in;
204
205# The command to use for the output (MSG f.e.)
206
207our $command_out;
208
209# '--command -out' used?
210
211our $command_out_activated;
212
213# Counter for the subroutines entered
214
215our $counter_subroutines;
216
217# Counter for the switches
218# --me --moron: --me would be 0, --moron 1
219
220our $counter_switches;
221
222# daumode
223
224our %daumode;
225
226# daumode activated?
227
228our $daumode_activated;
229
230# Help text
231
232our %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
476END
477
478# Containing irssi's 'cmdchars'
479
480our $k = Irssi::parse_special('$k');
481
482# Remember your nick mode
483
484our %nick_mode;
485
486# All the options
487
488our %option;
489
490# print() the message or not?
491
492our $print_message;
493
494# Queue holding the switches
495
496our %queue;
497
498# Remember the last switches used by --random so that they don't repeat
499
500our $random_last;
501
502# Signals
503
504our %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
515our %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
735print CLIENTCRAP "dau.pl $VERSION loaded. For help type %9${k}dau --help%9 or %9${k}dau --long_help%9";
736
737signal_setup_changed();
738build_nick_mode_struct();
739signal_handling();
740
741################################################################################
742# Subroutines (commands)
743################################################################################
744
745sub 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
868sub 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
1051sub 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
1121sub 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
1392sub 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
1503sub switch_daumode {
1504	$daumode_activated = 1;
1505}
1506
1507sub 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
2118sub 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
2247sub 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
2297sub 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
2314sub 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
2361sub 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
2371sub 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
2405sub 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
2571sub 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			local $/ = "\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
2706sub 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
2817sub 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
2828sub 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
2846sub 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
2943sub 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
2966sub 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
2977sub 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
3004sub 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
3012sub 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
3641sub switch_nothing {
3642	my $data = shift;
3643
3644	return $data;
3645}
3646
3647sub 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
3737sub switch_reverse {
3738	my $data = shift;
3739
3740	$data = reverse($data);
3741
3742	return $data;
3743}
3744
3745sub 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
3774sub 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
3793sub switch_underline {
3794	my $data = shift;
3795
3796	$data = "\037$data\037";
3797
3798	return $data;
3799}
3800
3801sub switch_uppercase {
3802	my $data = shift;
3803
3804	$data = uc($data);
3805
3806	return $data;
3807}
3808
3809sub 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
3848sub 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
3860sub 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
3879sub 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
3890sub 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
4192sub 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
4216sub 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
4254sub 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
4329sub 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
4350sub 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
4397sub 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
4448sub 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
4525sub 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
4607sub 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
4646sub 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
4718sub 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
4784sub 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
4806sub 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
5015sub babble_interval {
5016	return "BABBLE_INTERVAL=" . babble_set_interval(@_) . "\x02";
5017}
5018
5019sub 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
5050sub 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
5068sub 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
5085sub 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 .= $match;
5094			$item =~ s/^\s*//;
5095			$item =~ s/\s*$//;
5096			push @items, $item unless ($item =~ /^\s*$/);
5097			$item = "";
5098		}
5099	}
5100
5101	foreach my $server (Irssi::servers()) {
5102		my $network_name = $server->{tag};
5103		foreach my $channel ($server->channels()) {
5104			my $channel_name = $channel->{name};
5105			foreach my $daumode (@items) {
5106				$daumode =~ m#^([^/]+)/([^:]+):(.*)#;
5107				my $item_channel  = $1;
5108				my $item_network  = $2;
5109				my $item_switches = $3;
5110
5111				if (lc($item_channel) eq lc($channel_name) &&
5112				    lc($item_network) eq lc($network_name))
5113				{
5114					unless ($daumode{channels_in}{$network_name}{$channel_name} ||
5115					        $daumode{channels_out}{$network_name}{$channel_name})
5116					{
5117						$channel->print("%9dau.pl%9: Activating daumode according to setting dau_daumode_channels");
5118					}
5119					$channel->command("dau --daumode $item_switches");
5120				}
5121			}
5122		}
5123	}
5124}
5125
5126sub def_dau_cowsay_cowpath {
5127	my $cowsay = $ENV{COWPATH} || '/usr/share/cowsay/cows';
5128	chomp($cowsay);
5129	return $cowsay;
5130}
5131
5132sub def_dau_cowsay_cowsay_path {
5133	my $cowsay = `which cowsay`;
5134	chomp($cowsay);
5135	return $cowsay;
5136}
5137
5138sub def_dau_cowsay_cowthink_path {
5139	my $cowthink = `which cowthink`;
5140	chomp($cowthink);
5141	return $cowthink;
5142}
5143
5144sub def_dau_figlet_fontpath {
5145	my $figlet = `figlet -I2`;
5146	chomp($figlet);
5147	return $figlet;
5148}
5149
5150sub def_dau_figlet_path {
5151	my $figlet = `which figlet`;
5152	chomp($figlet);
5153	return $figlet;
5154}
5155
5156sub cowsay_cowlist {
5157	my $cowsay_cowpath = shift;
5158
5159	# clear cowlist
5160
5161	%{ $switches{combo}{cowsay}{cow} } = ();
5162
5163	# generate new list
5164
5165	while (<$cowsay_cowpath/*.cow>) {
5166		my $cow = (fileparse($_, qr/\.[^.]*/))[0];
5167		$switches{combo}{cowsay}{cow}{$cow} = 1;
5168	}
5169}
5170
5171sub figlet_fontlist {
5172	my $figlet_fontpath = shift;
5173
5174	# clear fontlist
5175
5176	%{ $switches{combo}{figlet}{font} } = ();
5177
5178	# generate new list
5179
5180	while (<$figlet_fontpath/*.flf>) {
5181		my $font = (fileparse($_, qr/\..*/))[0];
5182		$switches{combo}{figlet}{font}{$font} = 1;
5183	}
5184}
5185
5186sub fix {
5187	my $string = shift;
5188	$string =~ s/^\t+//gm;
5189	return $string;
5190}
5191
5192sub output_text {
5193	my ($thing, $target, $text) = @_;
5194
5195	foreach my $line (split /\n/, $text) {
5196
5197		# prevent "-!- Irssi: Not enough parameters given"
5198		$line = ' ' if ($line eq '');
5199
5200		# --command -out <command>?
5201
5202		if ($command_out_activated) {
5203			if (defined($thing) && $thing) {
5204				$thing->command("$command_out $line");
5205			} else {
5206				my $server = Irssi::active_server();
5207
5208				if (defined($server) && $server && $server->{connected}) {
5209					$server->command("$command_out $line");
5210				} else {
5211					print CLIENTCRAP $line;
5212				}
5213			}
5214		}
5215
5216		# Not a channel/query window, --help, --changelog, ...
5217
5218		elsif ($print_message) {
5219			print CLIENTCRAP $line;
5220		}
5221
5222		# MSG or ACTION to channel or query
5223
5224		elsif ($command_out eq 'ACTION' || $command_out eq 'MSG') {
5225			$thing->command("$command_out $target $line");
5226		}
5227
5228		# weird things happened...
5229
5230		else {
5231			print CLIENTCRAP $line;
5232		}
5233	}
5234}
5235
5236sub parse_text {
5237	my ($data, $channel_rec) = @_;
5238	my $output;
5239
5240	$command_out_activated = 0;
5241	$command_out           = 'MSG';
5242	$counter_switches      = 0;
5243	$daumode_activated     = 0;
5244	$print_message         = 0;
5245	%queue                 = ();
5246
5247	OUTER: while ($data =~ /^--(\w+) ?/g) {
5248
5249		my $first_level_option  = $1;
5250
5251		# If its the first time we are in the OUTER loop, check
5252		# if the first level option is one of the few options,
5253		# which must not be combined.
5254
5255		if (ref($switches{nocombo}{$first_level_option}{'sub'}) && $counter_switches == 0) {
5256
5257			$data =~ s/^--\w+ ?//;
5258
5259			# found a first level option
5260
5261			$queue{$counter_switches}{$first_level_option} = { };
5262
5263			# Check for second level options and third level options.
5264			# Get all of them and put theme in the
5265			# $queue hash
5266
5267			while ($data =~ /^-(\w+) ('.*?(?<![\\])'|\S+) ?/g) {
5268
5269				my $second_level_option = $1;
5270				my $third_level_option  = $2;
5271
5272				$third_level_option =~ s/^'//;
5273				$third_level_option =~ s/'$//;
5274				$third_level_option =~ s/\\'/'/g;
5275
5276				# If $switches{nocombo}{$first_level_option}{$second_level_option}{'*'}:
5277				# The user can give any third_level_option on the commandline
5278
5279				my $any_option =
5280				$switches{nocombo}{$first_level_option}{$second_level_option}{'*'} ? 1 : 0;
5281
5282				if ($switches{nocombo}{$first_level_option}{$second_level_option}{$third_level_option} ||
5283				    $any_option)
5284				{
5285					$queue{$counter_switches}{$first_level_option}{$second_level_option} = $third_level_option;
5286				}
5287
5288				$data =~ s/^-(\w+) ('.*?(?<![\\])'|\S+) ?//;
5289			}
5290
5291			# initialize some values
5292
5293			foreach my $second_level_option (keys(%{ $switches{nocombo}{$first_level_option} })) {
5294				if (!defined($queue{'0'}{$first_level_option}{$second_level_option})) {
5295					$queue{'0'}{$first_level_option}{$second_level_option} = '';
5296				}
5297			}
5298
5299			# All done. Run the subroutine
5300
5301			$output = &{ $switches{nocombo}{$first_level_option}{'sub'} }($data, $channel_rec);
5302
5303			return $output;
5304		}
5305
5306		# Check for all those options that can be combined.
5307
5308		elsif (ref($switches{combo}{$first_level_option}{'sub'})) {
5309
5310			$data =~ s/^--\w+ ?//;
5311
5312			# found a first level option
5313
5314			$queue{$counter_switches}{$first_level_option} = { };
5315
5316			# Check for second level options and
5317			# third level options. Get all of them and put them
5318			# in the $queue hash
5319
5320			while ($data =~ /^-(\w+) ('.*?(?<![\\])'|\S+) ?/g) {
5321
5322				my $second_level_option = $1;
5323				my $third_level_option  = $2;
5324
5325				$third_level_option =~ s/^'//;
5326				$third_level_option =~ s/'$//;
5327				$third_level_option =~ s/\\'/'/g;
5328
5329				# If $switches{combo}{$first_level_option}{$second_level_option}{'*'}:
5330				# The user can give any third_level_option on the commandline
5331
5332				my $any_option =
5333				$switches{combo}{$first_level_option}{$second_level_option}{'*'} ? 1 : 0;
5334
5335				# known option => Put it in the hash
5336
5337				if ($switches{combo}{$first_level_option}{$second_level_option}{$third_level_option}
5338			            || $any_option)
5339				{
5340					$queue{$counter_switches}{$first_level_option}{$second_level_option} = $third_level_option;
5341					$data =~ s/^-(\w+) ('.*?(?<![\\])'|\S+) ?//;
5342				} else {
5343					last OUTER;
5344				}
5345			}
5346
5347			# increase counter
5348
5349			$counter_switches++;
5350		}
5351
5352		else {
5353			last OUTER;
5354		}
5355	}
5356
5357	# initialize some values
5358
5359	for (my $i = 0; $i < $counter_switches; $i++) {
5360		foreach my $first_level (keys(%{ $queue{$i} })) {
5361			if (ref($switches{combo}{$first_level})) {
5362				foreach my $second_level (keys(%{ $switches{combo}{$first_level} })) {
5363					if (!defined($queue{$i}{$first_level}{$second_level})) {
5364						$queue{$i}{$first_level}{$second_level} = '';
5365					}
5366				}
5367			}
5368		}
5369	}
5370
5371	# text to subroutines
5372
5373	$output = $data;
5374
5375	# If theres no text left over, take one item of dau_random_messages
5376
5377	if ($output eq '') {
5378		$output = return_random_list_item($option{dau_standard_messages});
5379	}
5380
5381	# No options? Get options from setting dau_standard_options and run
5382	# parse_text() again
5383
5384	if (keys(%queue) == 0) {
5385
5386		if (!$counter_subroutines) {
5387			print_out("No options given, hence using the value of the setting %9dau_standard_options%9 and that is %9$option{dau_standard_options}%9", $channel_rec);
5388			$counter_subroutines++;
5389			$output = parse_text("$option{dau_standard_options} $output", $channel_rec);
5390		} else {
5391			print_err('Invalid value for setting dau_standard_options. ' .
5392			          'Will use %9--moron%9 instead!');
5393			$output =~ s/^\Q$option{dau_standard_options}\E //;
5394			$output = parse_text("--moron $output", $channel_rec);
5395		}
5396
5397	} else {
5398
5399		$counter_switches = 0;
5400
5401		for (keys(%queue)) {
5402			my ($first_level_option) = keys %{ $queue{$counter_switches} };
5403			$output = &{ $switches{combo}{$first_level_option}{'sub'} }($output, $channel_rec);
5404			$counter_switches++;
5405		}
5406	}
5407
5408	# reset subcounter
5409
5410	$counter_subroutines = 0;
5411
5412	# return text
5413
5414	return $output;
5415}
5416
5417sub print_err {
5418	my $text = shift;
5419
5420	foreach my $line (split /\n/, $text) {
5421		print CLIENTCRAP "%Rdau.pl error%n: $line";
5422	}
5423}
5424
5425sub print_out {
5426	my ($text, $channel_rec) = @_;
5427
5428	if ($option{dau_silence}) {
5429		return;
5430	}
5431
5432	foreach my $line (split /\n/, $text) {
5433		my $message = "%9dau.pl%9: $line";
5434		if (defined($channel_rec) && $channel_rec) {
5435			$channel_rec->print($message);
5436		} else {
5437			print CLIENTCRAP $message;
5438		}
5439	}
5440}
5441
5442# return_option('firstlevel', 'secondlevel'):
5443#
5444# If "--firstlevel -secondlevel value" given on the commandline, return 'value'.
5445#
5446# return_option('firstlevel', 'secondlevel', 'default value'):
5447#
5448# If "--firstlevel -secondlevel value" not given on the commandline, return
5449# 'default value'.
5450sub return_option {
5451	if (@_ == 2) {
5452		return $queue{$counter_switches}{$_[0]}{$_[1]};
5453	} elsif (@_ == 3) {
5454		if (length($queue{$counter_switches}{$_[0]}{$_[1]}) > 0) {
5455			return $queue{$counter_switches}{$_[0]}{$_[1]};
5456		} else {
5457			return $_[2];
5458		}
5459	} else {
5460		return 0;
5461	}
5462}
5463
5464sub return_random_list_item {
5465	my $arg = shift;
5466	my @strings;
5467
5468	my $item;
5469	while ($arg =~ /([^,]+)/g) {
5470		my $match = $1;
5471		if ($match =~ s/\\$//) {
5472			$item .= "$match,";
5473		} else {
5474			$item .= $match;
5475			$item =~ s/^\s*//;
5476			$item =~ s/\s*$//;
5477			push @strings, $item;
5478			$item = "";
5479		}
5480	}
5481
5482	if (@strings == 0) {
5483		return;
5484	} else {
5485		return $strings[rand(@strings)];
5486	}
5487}
5488
5489sub set_settings {
5490	# setting changed/added => change/add it here
5491
5492	# boolean
5493	$option{dau_away_quote_reason}               = Irssi::settings_get_bool('dau_away_quote_reason');
5494	$option{dau_away_reminder}                   = Irssi::settings_get_bool('dau_away_reminder');
5495	$option{dau_babble_verbose}                  = Irssi::settings_get_bool('dau_babble_verbose');
5496	$option{dau_color_choose_colors_randomly}    = Irssi::settings_get_bool('dau_color_choose_colors_randomly');
5497	$option{dau_cowsay_print_cow}                = Irssi::settings_get_bool('dau_cowsay_print_cow');
5498	$option{dau_figlet_print_font}               = Irssi::settings_get_bool('dau_figlet_print_font');
5499	$option{dau_silence}                         = Irssi::settings_get_bool('dau_silence');
5500	$option{dau_statusbar_daumode_hide_when_off} = Irssi::settings_get_bool('dau_statusbar_daumode_hide_when_off');
5501	$option{dau_tab_completion}                  = Irssi::settings_get_bool('dau_tab_completion');
5502
5503	# Integer
5504	$option{dau_babble_history_size}             = Irssi::settings_get_int('dau_babble_history_size');
5505	$option{dau_babble_verbose_minimum_lines}    = Irssi::settings_get_int('dau_babble_verbose_minimum_lines');
5506	$option{dau_cool_maximum_line}               = Irssi::settings_get_int('dau_cool_maximum_line');
5507	$option{dau_cool_probability_eol}            = Irssi::settings_get_int('dau_cool_probability_eol');
5508	$option{dau_cool_probability_word}           = Irssi::settings_get_int('dau_cool_probability_word');
5509	$option{dau_remote_babble_interval_accuracy} = Irssi::settings_get_int('dau_remote_babble_interval_accuracy');
5510
5511	# String
5512	$option{dau_away_away_text}                  = Irssi::settings_get_str('dau_away_away_text');
5513	$option{dau_away_back_text}                  = Irssi::settings_get_str('dau_away_back_text');
5514	$option{dau_away_options}                    = Irssi::settings_get_str('dau_away_options');
5515	$option{dau_away_reminder_interval}          = Irssi::settings_get_str('dau_away_reminder_interval');
5516	$option{dau_away_reminder_text}              = Irssi::settings_get_str('dau_away_reminder_text');
5517	$option{dau_babble_options_line_by_line}     = Irssi::settings_get_str('dau_babble_options_line_by_line');
5518	$option{dau_babble_options_preprocessing}    = Irssi::settings_get_str('dau_babble_options_preprocessing');
5519	$option{dau_color_codes}                     = Irssi::settings_get_str('dau_color_codes');
5520	$option{dau_cool_eol_style}                  = Irssi::settings_get_str('dau_cool_eol_style');
5521	$option{dau_cowsay_cowlist}                  = Irssi::settings_get_str('dau_cowsay_cowlist');
5522	$option{dau_cowsay_cowpath}                  = Irssi::settings_get_str('dau_cowsay_cowpath');
5523	$option{dau_cowsay_cowpolicy}                = Irssi::settings_get_str('dau_cowsay_cowpolicy');
5524	$option{dau_cowsay_cowsay_path}              = Irssi::settings_get_str('dau_cowsay_cowsay_path');
5525	$option{dau_cowsay_cowthink_path}            = Irssi::settings_get_str('dau_cowsay_cowthink_path');
5526	$option{dau_daumode_channels}                = Irssi::settings_get_str('dau_daumode_channels');
5527	$option{dau_delimiter_string}                = Irssi::settings_get_str('dau_delimiter_string');
5528	$option{dau_figlet_fontlist}                 = Irssi::settings_get_str('dau_figlet_fontlist');
5529	$option{dau_figlet_fontpath}                 = Irssi::settings_get_str('dau_figlet_fontpath');
5530	$option{dau_figlet_fontpolicy}               = Irssi::settings_get_str('dau_figlet_fontpolicy');
5531	$option{dau_figlet_path}                     = Irssi::settings_get_str('dau_figlet_path');
5532	$option{dau_files_away}                      = Irssi::settings_get_str('dau_files_away');
5533	$option{dau_files_babble_messages}           = Irssi::settings_get_str('dau_files_babble_messages');
5534	$option{dau_files_cool_suffixes}             = Irssi::settings_get_str('dau_files_cool_suffixes');
5535	$option{dau_files_root_directory}            = Irssi::settings_get_str('dau_files_root_directory');
5536	$option{dau_files_substitute}                = Irssi::settings_get_str('dau_files_substitute');
5537	$option{dau_language}                        = Irssi::settings_get_str('dau_language');
5538	$option{dau_moron_eol_style}                 = Irssi::settings_get_str('dau_moron_eol_style');
5539	$option{dau_parse_special_list_delimiter}    = Irssi::settings_get_str('dau_parse_special_list_delimiter');
5540	$option{dau_random_options}                  = Irssi::settings_get_str('dau_random_options');
5541	$option{dau_remote_babble_channellist}       = Irssi::settings_get_str('dau_remote_babble_channellist');
5542	$option{dau_remote_babble_channelpolicy}     = Irssi::settings_get_str('dau_remote_babble_channelpolicy');
5543	$option{dau_remote_babble_interval}          = Irssi::settings_get_str('dau_remote_babble_interval');
5544	$option{dau_remote_channellist}              = Irssi::settings_get_str('dau_remote_channellist');
5545	$option{dau_remote_channelpolicy}            = Irssi::settings_get_str('dau_remote_channelpolicy');
5546	$option{dau_remote_deop_reply}               = Irssi::settings_get_str('dau_remote_deop_reply');
5547	$option{dau_remote_devoice_reply}            = Irssi::settings_get_str('dau_remote_devoice_reply');
5548	$option{dau_remote_op_reply}                 = Irssi::settings_get_str('dau_remote_op_reply');
5549	$option{dau_remote_permissions}              = Irssi::settings_get_str('dau_remote_permissions');
5550	$option{dau_remote_question_regexp}          = Irssi::settings_get_str('dau_remote_question_regexp');
5551	$option{dau_remote_question_reply}           = Irssi::settings_get_str('dau_remote_question_reply');
5552	$option{dau_remote_voice_reply}              = Irssi::settings_get_str('dau_remote_voice_reply');
5553	$option{dau_standard_messages}               = Irssi::settings_get_str('dau_standard_messages');
5554	$option{dau_standard_options}                = Irssi::settings_get_str('dau_standard_options');
5555	$option{dau_words_range}                     = Irssi::settings_get_str('dau_words_range');
5556}
5557
5558sub signal_handling {
5559	# complete word
5560
5561	if ($option{dau_tab_completion}) {
5562		if ($signal{'complete word'} != 1) {
5563			Irssi::signal_add_last('complete word', 'signal_complete_word');
5564		}
5565		$signal{'complete word'} = 1;
5566	} else {
5567		if ($signal{'complete word'} != 0) {
5568			Irssi::signal_remove('complete word', 'signal_complete_word');
5569		}
5570		$signal{'complete word'} = 0;
5571	}
5572
5573	# event privmsg
5574
5575	if ($option{dau_remote_permissions} =~ /^1[01][01][01][01][01]$/) {
5576		if ($signal{'event privmsg'} != 1) {
5577			Irssi::signal_add_last('event privmsg', 'signal_event_privmsg');
5578		}
5579		$signal{'event privmsg'} = 1;
5580	} else {
5581		if ($signal{'event privmsg'} != 0) {
5582			Irssi::signal_remove('event privmsg', 'signal_event_privmsg');
5583		}
5584		$signal{'event privmsg'} = 0;
5585	}
5586
5587	# nick mode changed
5588
5589	if ($option{dau_remote_permissions} =~ /^[01]1[01][01][01][01]$/ ||
5590	    $option{dau_remote_permissions} =~ /^[01][01]1[01][01][01]$/ ||
5591	    $option{dau_remote_permissions} =~ /^[01][01][01]1[01][01]$/ ||
5592	    $option{dau_remote_permissions} =~ /^[01][01][01][01]1[01]$/)
5593	{
5594		if ($signal{'nick mode changed'} != 1) {
5595			Irssi::signal_add_last('channel joined', 'build_nick_mode_struct');
5596			Irssi::signal_add_last('nick mode changed', 'signal_nick_mode_changed');
5597		}
5598		$signal{'nick mode changed'} = 1;
5599	} else {
5600		if ($signal{'nick mode changed'} != 0) {
5601			Irssi::signal_remove('channel joined', 'build_nick_mode_struct');
5602			Irssi::signal_remove('nick mode changed', 'signal_nick_mode_changed');
5603		}
5604		$signal{'nick mode changed'} = 0;
5605	}
5606
5607	# daumode: outgoing messages
5608
5609	my $daumode_out = 0;
5610
5611	foreach my $server (keys %{ $daumode{channels_out} }) {
5612		foreach my $channel (keys %{ $daumode{channels_out}{$server} }) {
5613			if ($daumode{channels_out}{$server}{$channel} == 1) {
5614				$daumode_out = 1;
5615			}
5616		}
5617	}
5618
5619	if ($daumode_out) {
5620		if ($signal{'send text'} != 1) {
5621			Irssi::signal_add_first('send text', 'signal_send_text');
5622		}
5623		$signal{'send text'} = 1;
5624	} else {
5625		if ($signal{'send text'} != 0) {
5626			Irssi::signal_remove('send text', 'signal_send_text');
5627		}
5628		$signal{'send text'} = 0;
5629	}
5630
5631	# daumode: incoming messages
5632
5633	my $daumode_in = 0;
5634
5635	foreach my $server (keys %{ $daumode{channels_in} }) {
5636		foreach my $channel (keys %{ $daumode{channels_in}{$server} }) {
5637			if ($daumode{channels_in}{$server}{$channel} == 1) {
5638				$daumode_in = 1;
5639			}
5640		}
5641	}
5642
5643	if ($daumode_in) {
5644		if ($signal{'daumode in'} != 1) {
5645			Irssi::signal_add_last('message public', 'signals_daumode_in');
5646			Irssi::signal_add_last('message irc action', 'signals_daumode_in');
5647		}
5648		$signal{'daumode in'} = 1;
5649	} else {
5650		if ($signal{'daumode in'} != 0) {
5651			Irssi::signal_remove('message public', 'signals_daumode_in');
5652			Irssi::signal_remove('message irc action', 'signals_daumode_in');
5653		}
5654		$signal{'daumode in'} = 0;
5655	}
5656
5657	# continuing babbles, setting daumode
5658
5659	if ($signal{'channel joined'} != 1) {
5660		Irssi::signal_add_last('channel joined', 'signal_channel_joined');
5661		Irssi::signal_add_last('channel destroyed', 'signal_channel_destroyed');
5662		$signal{'channel joined'} = 1;
5663	}
5664
5665	# Cancel babble when message could not be sent to channel
5666
5667	if ($signal{'event 404'} != 1) {
5668		Irssi::signal_add_last('event 404', 'signal_event_404');
5669		$signal{'event 404'} = 1;
5670	}
5671}
5672
5673sub time_diff_verbose {
5674	my ($sub1, $sub2) = @_;
5675
5676	my $difference = $sub1 - $sub2;
5677	$difference *= (-1) if ($difference < 0);
5678	my $seconds = $difference % 60;
5679	$difference = ($difference - $seconds) / 60;
5680	my $minutes = $difference % 60;
5681	$difference = ($difference - $minutes) / 60;
5682	my $hours   = $difference % 24;
5683	$difference = ($difference - $hours) / 24;
5684	my $days    = $difference % 7;
5685	my $weeks   = ($difference - $days) / 7;
5686
5687	my $time;
5688	$time  = "$weeks week"     . ($weeks   == 1 ? "" : "s") . ", " if ($weeks);
5689	$time .= "$days day"       . ($days    == 1 ? "" : "s") . ", " if ($weeks || $days);
5690	$time .= "$hours hour"     . ($hours   == 1 ? "" : "s") . ", " if ($weeks || $days || $hours);
5691	$time .= "$minutes minute" . ($minutes == 1 ? "" : "s") . ", " if ($weeks || $days || $hours || $minutes);
5692	$time .= "$seconds second" . ($seconds == 1 ? "" : "s")        if ($weeks || $days || $hours || $minutes || $seconds);
5693
5694	return $time;
5695}
5696
5697sub time_parse {
5698	my $time = $_[0];
5699	my $parsed_time = 0;
5700
5701	# milliseconds
5702	while ($time =~ s/(\d+)\s*(?:milliseconds|ms)//g) {
5703		$parsed_time += $1;
5704	}
5705	# seconds
5706	while ($time =~ s/(\d+)\s*s(?:econds?)?//g) {
5707		$parsed_time += $1 * 1000;
5708	}
5709	# minutes
5710	while ($time =~ s/(\d+)\s*m(?:inutes?)?//g) {
5711		$parsed_time += $1 * 1000 * 60;
5712	}
5713	# hours
5714	while ($time =~ s/(\d+)\s*h(?:ours?)?//g) {
5715		$parsed_time += $1 * 1000 * 60 * 60;
5716	}
5717	# days
5718	while ($time =~ s/(\d+)\s*d(?:ays?)?//g) {
5719		$parsed_time += $1 * 1000 * 60 * 60 * 24;
5720	}
5721	# weeks
5722	while ($time =~ s/(\d+)\s*w(?:eeks?)?//g) {
5723		$parsed_time += $1 * 1000 * 60 * 60 * 24 * 7;
5724	}
5725
5726	if ($time !~ /^\s*$/) {
5727		print_err('Error while parsing the date!');
5728		return 0;
5729	}
5730
5731	return $parsed_time;
5732}
5733
5734################################################################################
5735# Debugging
5736################################################################################
5737
5738sub debug_message {
5739        open(DEBUG, ">>", "$ENV{HOME}/.dau/.debug");
5740
5741        print DEBUG $_[0];
5742
5743        close (DEBUG);
5744}
5745
5746#BEGIN {
5747#	use warnings;
5748#
5749#	open(STDERR, ">>", $ENV{HOME}/.dau/.STDERR");
5750#}
5751