use 5.6.0; use File::Basename; use File::Path; use IPC::Open3; use Irssi 20021107.0841; use Irssi::TextUI; use locale; use re 'eval'; use strict; use vars qw($VERSION %IRSSI); $VERSION = '1.5.3'; %IRSSI = ( authors => 'Clemens Heidinger', changed => 'Sat Aug 16 00:07:25 CEST 2003', commands => 'dau', contact => 'spoooky@dau.pl', description => 'write like an idiot', license => 'BSD', modules => 'File::Basename File::Path IPC::Open3', name => 'DAU', sbitems => 'daumode', url => 'http://dau.pl/', ); # dau.pl has a builtin help (--help switch) ################################################################################ # Register commands ################################################################################ Irssi::command_bind('dau', \&command_dau); ################################################################################ # Register settings ################################################################################ # boolean Irssi::settings_add_bool('misc', 'dau_figlet_print_font', 0); Irssi::settings_add_bool('misc', 'dau_statusbar_daumode_hide_when_off', 0); Irssi::settings_add_bool('misc', 'dau_tab_completion', 1); # Integer Irssi::settings_add_int('misc', 'dau_remote_babble_interval', 3600); # String Irssi::settings_add_str('misc', 'dau_delimiter_string', ' '); Irssi::settings_add_str('misc', 'dau_figlet_fontlist', 'mnemonic,term,ivrit'); Irssi::settings_add_str('misc', 'dau_figlet_fontpath', &def_dau_figlet_fontpath); Irssi::settings_add_str('misc', 'dau_figlet_fontpolicy', 'allow'); Irssi::settings_add_str('misc', 'dau_figlet_path', &def_dau_figlet_path); Irssi::settings_add_str('misc', 'dau_files_moron_own_substitutions', 'moron_own_substitutions.pl'); Irssi::settings_add_str('misc', 'dau_files_root_directory', "$ENV{HOME}/.dau"); Irssi::settings_add_str('misc', 'dau_moron_eol_style', 'new'); Irssi::settings_add_str('misc', 'dau_moron_substitutions_permissions', '000'); Irssi::settings_add_str('misc', 'dau_random_options', '--boxes --uppercase,' . '--color --uppercase,' . '--delimiter,' . '--dots --moron,' . '--leet,' . '--mixedcase --bracket,' . '--moron --stutter --uppercase,' . '--moron,' . '--uppercase --underline,' . '--words --mixedcase' ); Irssi::settings_add_str('misc', 'dau_remote_babble_messages', 'hi @ all'); Irssi::settings_add_str('misc', 'dau_remote_channellist', ''); Irssi::settings_add_str('misc', 'dau_remote_channelpolicy', 'deny'); Irssi::settings_add_str('misc', 'dau_remote_deop_reply', 'you are on my shitlist now @ $nick'); Irssi::settings_add_str('misc', 'dau_remote_devoice_reply', 'you are on my shitlist now @ $nick'); Irssi::settings_add_str('misc', 'dau_remote_op_reply', 'thx 4 op @ $nick'); Irssi::settings_add_str('misc', 'dau_remote_permissions', '000000'); Irssi::settings_add_str('misc', 'dau_remote_question_reply', 'alles klar @ $nick'); Irssi::settings_add_str('misc', 'dau_remote_voice_reply', 'thx 4 voice @ $nick'); Irssi::settings_add_str('misc', 'dau_standard_messages', 'hi @ all'); Irssi::settings_add_str('misc', 'dau_standard_options', '--random'); Irssi::settings_add_str('misc', 'dau_words_range', '1-4'); ################################################################################ # Register signals # (Note that most signals are set dynamical in the subroutine signal_handling) ################################################################################ Irssi::signal_add_last('setup changed', \&signal_setup_changed); ################################################################################ # Register statusbar items ################################################################################ Irssi::statusbar_item_register('daumode', '', 'statusbar_daumode'); ################################################################################ # Global variables ################################################################################ # Containing irssi's 'cmdchars' our $k = Irssi::parse_special('$k'); # Miscellaneous things our %misc = ( random_last => '', signals => { 'complete word' => 0, 'event privmsg' => 0, 'nick mode changed' => 0, 'send text' => 0, }, remote_babble_timer_last_interval => 0, ); # All the options our %option; # All guilty switches that may be given at commandline our %switches = ( # These switches may be combined combo => { boxes => { 'sub' => \&switch_boxes }, bracket => { 'sub' => \&switch_bracket }, chars => { 'sub' => \&switch_chars }, color => { 'sub' => \&switch_color, 'split' => { chars => 1, lines => 1, rchars => 1, words => 1, }, }, command => { 'sub' => \&switch_command, cmd => { '*' => 1 }, }, delimiter => { 'sub' => \&switch_delimiter, string => { '*' => 1 }, }, dots => { 'sub' => \&switch_dots }, figlet => { 'sub' => \&switch_figlet }, greet => { 'sub' => \&switch_greet, whom => { all => 1, rnick => 1, }, }, me => { 'sub' => \&switch_me }, moron => { 'sub' => \&switch_moron, eol => { classic => 1, 'new' => 1, nothing => 1, }, perm => { '000' => 1, '001' => 1, '010' => 1, '011' => 1, '100' => 1, '101' => 1, '110' => 1, '111' => 1, }, uppercase => { yes => 1, no => 1, }, }, leet => { 'sub' => \&switch_leet }, mixedcase => { 'sub' => \&switch_mixedcase }, 'reverse' => { 'sub' => \&switch_reverse }, stutter => { 'sub' => \&switch_stutter }, underline => { 'sub' => \&switch_underline, 'spaces' => { 'no' => 1, 'yes' => 1, } }, uppercase => { 'sub' => \&switch_uppercase }, words => { 'sub' => \&switch_words }, }, # The following switches must not be combined nocombo => { changelog => { 'sub' => \&switch_changelog }, create_files => { 'sub' => \&switch_create_files }, daumode => { 'sub' => \&switch_daumode, fix => { '*' => 1 }, }, help => { 'sub' => \&switch_help, # setting changed/added => change/add it here setting => { # boolean dau_figlet_print_font => 1, dau_statusbar_daumode_hide_when_off => 1, dau_tab_completion => 1, # Integer dau_remote_babble_interval => 1, # String dau_delimiter_string => 1, dau_figlet_fontlist => 1, dau_figlet_fontpath => 1, dau_figlet_fontpolicy => 1, dau_figlet_path => 1, dau_files_moron_own_substitutions => 1, dau_files_root_directory => 1, dau_moron_eol_style => 1, dau_moron_substitutions_permissions => 1, dau_random_options => 1, dau_remote_babble_messages => 1, dau_remote_channellist => 1, dau_remote_channelpolicy => 1, dau_remote_deop_reply => 1, dau_remote_devoice_reply => 1, dau_remote_op_reply => 1, dau_remote_permissions => 1, dau_remote_question_reply => 1, dau_remote_voice_reply => 1, dau_standard_messages => 1, dau_standard_options => 1, dau_words_range => 1, }, }, random => { 'sub' => \&switch_random }, }, ); ################################################################################ # Code run once at start ################################################################################ set_settings(); figlet_fontlist($option{dau_figlet_fontpath}); timer_babble_reset(); signal_handling(); print CLIENTCRAP "dau.pl $VERSION loaded. For help type %9${k}dau --help%9"; ################################################################################ # Subroutines (commands) ################################################################################ sub command_dau { my ($data, $server, $witem) = @_; my $output; $output = parse_text($data, $witem); unless (defined($server) && $server && $server->{connected}) { $misc{'print'} = 1; } unless ((defined($witem) && $witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'))) { $misc{'print'} = 1; } if ($misc{daumode}) { if (defined($witem) && $witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) { # daumode set with parameters if ($misc{queue}{0}{daumode}{fix}) { $misc{daumode_active}{$server->{tag}}{$witem->{name}} = 1; $misc{daumode_active_fix}{$server->{tag}}{$witem->{name}} = $misc{queue}{0}{daumode}{fix}; } # daumode set without parameters elsif (!$misc{daumode_active}{$server->{tag}}{$witem->{name}}) { $misc{daumode_active}{$server->{tag}}{$witem->{name}} = 1; $misc{daumode_active_fix}{$server->{tag}}{$witem->{name}} = ''; } # daumode unset else { $misc{daumode_active}{$server->{tag}}{$witem->{name}} = 0; $misc{daumode_active_fix}{$server->{tag}}{$witem->{name}} = ''; } Irssi::statusbar_items_redraw('daumode'); } # Signal handling (for daumode and signal 'send text') signal_handling(); return; } # MSG (or CTCP ACTION) $output to active channel/query-window { no strict 'refs'; $output = $output || ''; output_text($witem, $witem->{name}, $output); } } ################################################################################ # Subroutines (switches, must not be combined) ################################################################################ sub switch_changelog { my $output; $misc{'print'} = 1; $output = &fix(<<" END"); CHANGELOG 2002-05-05 release 0.1.0 initial release 2002-05-06 release 0.1.1 bugfixes, minor changes 2002-05-11 release 0.2.0 - new function: Put a single space after each character - %9--moron%9: minor changes 2002-05-12 release 0.3.0 new function: %9--mixedcase%9 2002-05-17 release 0.4.0 function putting a single space after each character changed name to %9--delimiter%9 and will accept any delimiter string now (new setting for that) 2002-05-20 release 0.4.1 some nice new substitutions for %9--moron%9 2002-05-24 release 0.5.0 new settings controlling the behavior of %9--figlet%9 2002-06-15 release 0.6.0 - new settings for %9--figlet%9 - %9--figlet%9 will omit lines only containing whitespace 2002-06-16 release 0.6.1 bugfixes 2002-06-16 release 0.6.2 bugfixes 2002-06-17 release 0.7.0 - new settings for %9--moron%9 - new substitutions for %9--moron%9 2002-06-19 release 0.8.0 new function: %9--dots%9 %9--moron%9: minor changes 2002-06-23 release 0.9.0 - new: remote feature - new substitutions for %9--moron%9 - %9--figlet%9: bugfixes 2002-06-23 release 0.9.1 - %9--moron%9: minor changes - remote feature: minor changes 2002-06-29 release 0.9.2 new settings for the remote feature 2002-07-23 release 0.9.3 new setting for %9--words%9 2002-07-28 release 1.0.0 - Syntax changed - Tabcompletion for the options - Integrated help (%9--help%9) - Integrated changelog (%9--changelog%9) - Some of the options and settings have a different name now - %9--moron%9 no longer tears smilies apart - new function: %9--leet%9 - new function: %9--reverse%9 2002-07-28 release 1.0.1 bugfixes 2002-09-01 release 1.0.2 - the script will now work properly even if the alias for /SAY does not exist - new substitutions for %9--moron%9 2002-09-03 release 1.0.3 - bugfixes - new option for %9--figlet%9: %9-font%9 2002-09-03 release 1.0.4 bugfixes 2002-09-03 release 1.0.5 bugfixes 2002-09-09 release 1.1.0 - You can combine commands now! - new substitutions for %9--moron%9 - bugfixes 2002-11-22 release 1.2.0 - _A lot_ of rewriting - Syntax for %9${k}dau%9's options changed. See %9${k}dau --help%9 - Some settings have changed their name and/or expect other values. Checkout %9${k}dau --help%9, %9${k}set dau_%9 and %9${k}dau --help %9 - new option for %9--delimiter%9: %9-string%9 - new option for %9--moron%9: %9-eol%9 - new option for %9--moron%9: %9-perm%9 - new setting: %9dau_moron_eol_style%9 - new setting: %9dau_random_options%9 - new setting: %9dau_standard_messages%9 - new setting: %9dau_standard_options%9 - new remote features: - new setting: %9dau_remote_question_reply%9 - new setting: %9dau_remote_voice_reply%9 - new setting: %9dau_remote_devoice_reply%9 - new setting: %9dau_remote_op_reply%9 - new setting: %9dau_remote_deop_reply%9 - new function: %9--color%9 - new function: %9--daumode%9 - new function: %9--random%9 - new function: %9--stutter%9 - new function: %9--uppercase%9 - new statusbar item: %9daumode%9 2002-11-27 release 1.2.1 minor changes and one crash-fix 2002-12-15 release 1.2.2 - Changing settings of 'hallo wie geht'-remote-feature didn't become effective immediately - new substitutions for %9--moron%9 2003-01-12 release 1.3.0 - %9--moron%9: randomly transpose letters with letters next to them at the keyboard - %9--moron%9: new 'substitution-level'. Checkout %9${k}dau --help -setting dau_moron_substitutions_permissions%9 and set a new value for this setting - new substitutions for %9--moron%9 - new option for %9--moron -eol%9 resp. setting %9dau_moron_eol_style%9: %9nothing%9 - new option for %9--moron%9: %9-uppercase%9 - new setting: %9dau_files_moron_own_substitutions%9 - new setting: %9dau_files_root_directory%9 - new function: %9--create_files%9 2003-01-17 release 1.4.0 - %9--color%9 revised - You'll have to specify the ircnet in dau_remote_channellist now. Checkout %9${k}dau --help -setting dau_remote_channellist%9 - You'll have to set a new value for dau_remote_permissions too. Checkout %9${k}dau --help -setting dau_remote_permissions%9 - new remote features: - new setting: %9dau_remote_babble_interval%9 - new setting: %9dau_remote_babble_messages%9 - new function: %9--greet%9 2003-01-18 release 1.4.1 crash-fix 2003-01-20 release 1.4.2 - new setting: %9dau_statusbar_daumode_hide_when_off%9 - some other (minor) changes 2003-02-01 release 1.4.3 a few minor changes 2003-02-09 release 1.4.4 - commandline-parsing-fixes - some other (minor) changes 2003-02-16 release 1.4.5 - commandline-parsing-fixes - many settings use now a comma spearated list of strings instead of one single string. So you can specify more replies for the remote features f.e. 2003-03-16 release 1.4.6 a few minor changes 2003-05-01 release 1.5.0 - almost all signal handlers are now added/removed dynamically. The timer-subroutine for the babble-feature will be entered less often too. So dau.pl will take less CPU-time. - new setting: %9dau_tab_completion%9 - new function: %9--bracket%9 2003-06-13 release 1.5.1 - fixed a few bugs. dau.pl should work now pretty good under the warnings pragma. - new function: %9--underline%9 2003-07-16 release 1.5.2 - new function: %9--boxes%9 - some other (minor) changes 2003-08-16 release 1.5.3 changes in %IRSSI END return $output; } sub switch_create_files { # create directory dau_files_root_directory if not found if (-f $option{dau_files_root_directory}) { print_err("$option{dau_files_root_directory} is a _file_ => aborting"); return; } if (-d $option{dau_files_root_directory}) { print_out('directory dau_files_root_directory already exists - no need to create it'); } else { if (mkpath([$option{dau_files_root_directory}])) { print_out("creating directory $option{dau_files_root_directory}/"); } else { print_err("failed creating directory $option{dau_files_root_directory}/"); } } # create file dau_files_moron_own_substitutions if not found my $file1 = "$option{dau_files_root_directory}/$option{dau_files_moron_own_substitutions}"; if (-e $file1) { print_out("file $file1 already exists - no need to create it"); } else { if (open(FH1, "> $file1")) { print FH1 &fix(<<' END'); # dau.pl - http://scripts.quizparanoia.org # # This is the file --moron will use for your own substitutions. # You can use any perlcode in here. # $_ contains the text you can work with. # $_ has to contain the data to be returned to dau.pl at the end. END print_out("$file1 created. you should edit it now!"); } else { print_err("cannot write $file1: $!"); } if (!close(FH1)) { print_err("cannot close $file1: $!"); } } return; } sub switch_daumode { $misc{daumode} = 1; } sub switch_help { my $output; my $option_setting = $misc{queue}{'0'}{help}{setting}; $misc{'print'} = 1; if ($option_setting eq '') { $output = &fix(<<" END"); %9SYNOPSIS%9 %9${k}dau [%Uoptions%U] [%Utext%U%9] %9DESCRIPTION%9 Just write in the annoying way many lusers do. In contrast to many scripts of this kind, this wont do _anything_ automatically unless you turn the feature on via an irssi setting or a command. %9OPTIONS%9 %9--boxes%9 Put words in boxes %9--bracket%9 Bracket the text %9--changelog%9 Print the scripts changelog %9--chars%9 Only one character each line %9--color%9 Write in colors %9-split%9: %Uchars%U: Every character another color %Ulines%U: Every line another color %Urchars%U: Some characters one color %Uwords%U: Every word another color %9--create_files%9 Create files and directories of all dau_files_*-settings %9--daumode%9 Toggle daumode. If daumode is switched on, any future message sent to channel will be daualized. %9-fix%9 %Umodes%U: Fix modes. %9${k}dau --daumode -fix '--moron --color'%9 f.e. will make you write like a color loving moron in a channel all the time. There is a statusbar item available displaying the current status of the daumode. Add it with %9/statusbar window add [-alignment ] daumode%9 You may customize the look of the statusbar item in the theme file. f.e.: sb_daumode = "{sb daumode $0$1-}"; # $0: status of daumode (ON or OFF) # $1-: fixed modes (set by %9-fix%9) sb_daumode_fix = " [\$*]"; # Special item formatting the modes fixed by switch %9-fix%9. # If you don't want them to be displayed, set it to "". # \$* contains the string with these fixed modes. %9--delimiter%9 Insert a delimiter-string after each character %9-string%9 %Ustring%U: Override setting dau_delimiter_string. If this string contains whitespace, you should quote the string with single quotes. %9--dots%9 Put some dots... after some words... %9--figlet%9 Use figlet to write %9-font%9 %Ufont%U: The font to use %9--greet%9 Greet people in channel %9-whom%9 %Uall|rnick%U: %Uall%U : every nick %Urnick%U: one nick randomly selected %9--help%9 Show these lines %9-setting%9 %Usetting%U: More information about a specific setting %9--me%9 Send a CTCP ACTION instead of a PRIVMSG %9--mixedcase%9 Write in mixed case %9--moron%9 Write in uppercase, mix in some typos, perform some substitutions on the text, ... Just write like a moron %9-eol%9 %Ustring%U: Override setting dau_moron_eol_style %9-perm%9 %U[01][01][01]%U: Override setting dau_moron_substitutions_permissions %9-uppercase%9 %Uyes|no%U: Uppercase text %9--leet%9 Write in leet speech %9--random%9 Let dau.pl choose randomly options. Get these options from the comma separated list of setting dau_random_options %9--reverse%9 Reverse the input string %9--stutter%9 Stutter a bit %9--underline%9 Underline text %9-spaces%9 %Uyes|no%U: One additional space at start of string and end of string? %9--uppercase%9 Write in upper case %9--words%9 Only a few words each line %9EXAMPLES%9 %9${k}dau --uppercase --mixedcase %Ufoo bar baz%9 Will write %Ufoo bar baz%U in mixed case. %Ufoo bar baz%U is sent _first_ to the uppercase subroutine _then_ to mixedcase subroutine. The order you specify the options on the commandline is important. You can see what output a command produces without sending it to the active channel/query-window by typing the command out of a non-channel/query-window. There are thousands of possiblilities combining the options, so some combinations may produce a strange output. Try changing the order of the options, that might help. %9${k}dau --color --figlet %Ufoo bar baz%9 %9--color%9 will insert colorcodes after some characters. So the string will look like %U\003005f\003004o[...]%U when leaving the color subroutine. %9--figlet%9 uses then that string as its input. So you'll have finally an output like %U005f004o[...]%U in the figlet latters. So its better to use _first_ %9--figlet%9 _then_ %9--color%9. END } # setting changed/added => change/add them below # boolean elsif ($option_setting eq 'dau_figlet_print_font') { $output = &fix(<<" END"); %9dau_figlet_print_font%9 %Ubool Print a message which font will be used. END } elsif ($option_setting eq 'dau_statusbar_daumode_hide_when_off') { $output = &fix(<<" END"); %9dau_statusbar_daumode_hide_when_off%9 %Ubool Hide statusbar item when daumode is turned off. END } elsif ($option_setting eq 'dau_tab_completion') { $output = &fix(<<" END"); %9dau_tab_completion%9 %Ubool Perhaps someone wants to disable TAB-Completion for the ${k}dau-command because he/she doesn't like it or wants to give the CPU a break (don't know whether it has much influence) END } # Integer elsif ($option_setting eq 'dau_remote_babble_interval') { $output = &fix(<<" END"); %9dau_remote_babble_interval%9 %Uinteger Interval (in seconds) dau.pl will babble text. END } # String elsif ($option_setting eq 'dau_delimiter_string') { $output = &fix(<<" END"); %9dau_delimiter_string%9 %Ustring Tell %9--delimiter%9 which delimiter to use. END } elsif ($option_setting eq 'dau_figlet_fontlist') { $output = &fix(<<" END"); %9dau_figlet_fontlist%9 %Ustring Comma separated list of fonts. Checkout %9${k}dau --help -setting dau_figlet_fontpolicy%9 to see what this setting is good for. Use the program `showfigfonts` shipped with figlet to find these fonts. END } elsif ($option_setting eq 'dau_figlet_fontpath') { $output = &fix(<<" END"); %9dau_figlet_fontpath%9 %Ustring Path to the figlet-fonts (*.flf). END } elsif ($option_setting eq 'dau_figlet_fontpolicy') { $output = &fix(<<" END"); %9dau_figlet_fontpolicy%9 %Ustring Specifies the policy used to handle the fonts in dau_figlet_fontpath. If set to %Uallow%U, all fonts available will be used by the command. You can exclude some fonts by setting dau_figlet_fontlist. If set to %Udeny%U, no fonts but the ones listed in dau_figlet_fontlist will be used by the command. Useful if you have many annoying fonts in your fontpath and you want to permit only a few of them. END } elsif ($option_setting eq 'dau_figlet_path') { $output = &fix(<<" END"); %9dau_figlet_path%9 %Ustring Should point to the figlet-executable. END } elsif ($option_setting eq 'dau_files_moron_own_substitutions') { $output = &fix(<<" END"); %9dau_files_moron_own_substitutions%9 %Ustring Your own substitutions-file (third bit setting dau_moron_substitutions_permissions). _Must_ be in dau_files_root_directory. %9${k}dau --create_files%9 will create it. END } elsif ($option_setting eq 'dau_files_root_directory') { $output = &fix(<<" END"); %9dau_files_root_directory%9 %Ustring Directory in which all files for dau.pl will be stored. %9${k}dau --create_files%9 will create it. END } elsif ($option_setting eq 'dau_moron_eol_style') { $output = &fix(<<" END"); %9dau_moron_eol_style%9 %Ustring What to do at End Of Line? %Uclassic%U: !!!??!!!!!????!??????????!!!1 (or similar) %Unew%U : !!!??!!!!!????!??????????!!!1 (or similar) or = and in a new line ? or ?¿? %Unothing%U: nothing at EOL END } elsif ($option_setting eq 'dau_moron_substitutions_permissions') { $output = &fix(<<" END"); %9dau_moron_substitutions_permissions%9 %U[01][01][01] Controls whether %9--moron%9 should perform some substitutions on the text or not. These substitutions make only sense performed on german text. First Bit: You should turn it on if you write german text with dau.pl Second Bit: Perform substitutions which may cause that a third person does not understand what you wanted to say. Anyway, most user i know have turned it on Third Bit: Your own substitutions. Checkout the help for the dau_files_*-settings and %9--create_files%9 END } elsif ($option_setting eq 'dau_random_options') { $output = &fix(<<" END"); %9dau_random_options%9 %Ustring Comma separated list of options %9--random%9 will use. It will take randomly one item of the list. If you set it f.e. to %U--uppercase --color,--mixedcase%U, the probability of printing a colored, uppercased string hello will be 50% as well as the probabilty of printing a mixedcased string hello when typing %9${k}dau --random hello%9. END } elsif ($option_setting eq 'dau_remote_babble_messages') { $output = &fix(<<" END"); %9dau_remote_babble_messages%9 %Ustring Comma separated list of messages dau.pl will babble. END } elsif ($option_setting eq 'dau_remote_channellist') { $output = &fix(<<" END"); %9dau_remote_channellist%9 %Ustring Comma separated list of channels. You'll have to specify the ircnet too. Format: #channel1/IRCNet,#channel2/EFnet END } elsif ($option_setting eq 'dau_remote_channelpolicy') { $output = &fix(<<" END"); %9dau_remote_channelpolicy%9 %Ustring Using the default policy %Udeny%U the script won't do anything except in the channels listed in dau_remote_channellist. Using the policy %Uallow%U the script will reply to all channels but the ones listed in dau_remote_channellist. END } elsif ($option_setting eq 'dau_remote_deop_reply') { $output = &fix(<<" END"); %9dau_remote_deop_reply%9 %Ustring Comma separated list of messages (it will take randomly one item of the list) sent to channel if someone deops you (mode change -o). The string given will be processed by the same subroutine parsing the %9${k}dau%9 command. Special Variables: \$nick: contains the nick of the one who changed the mode END } elsif ($option_setting eq 'dau_remote_devoice_reply') { $output = &fix(<<" END"); %9dau_remote_devoice_reply%9 %Ustring Comma separated list of messages (it will take randomly one item of the list) sent to channel if someone devoices you (mode change -v). The string given will be processed by the same subroutine parsing the %9${k}dau%9 command. Special Variables: \$nick: contains the nick of the one who changed the mode END } elsif ($option_setting eq 'dau_remote_op_reply') { $output = &fix(<<" END"); %9dau_remote_op_reply%9 %Ustring Comma separated list of messages (it will take randomly one item of the list) sent to channel if someone ops you (mode change +o). The string given will be processed by the same subroutine parsing the %9${k}dau%9 command. Special Variables: \$nick: contains the nick of the one who changed the mode END } elsif ($option_setting eq 'dau_remote_permissions') { $output = &fix(<<" END"); %9dau_remote_permissions%9 %U[01][01][01][01][01][01] Permit or forbid the remote features. First Bit: Very, very useful feature. Will reply to the profound question 'hallo wie geht?' the appropriate answer. Again, only useful for german users. ;-) Second Bit: If someone gives you voice in a channel, thank him! Third Bit: If someone gives you op in a channel, thank him! Fourth Bit: If devoiced, print message Fifth Bit: If deopped, print message Sixth Bit: Babble text in certain intervals END } elsif ($option_setting eq 'dau_remote_question_reply') { $output = &fix(<<" END"); %9dau_remote_question_reply%9 %Ustring Comma separated list of reply strings for the question 'hallo wie geht?' (it will randomly choose one item of the list). The string given will be processed by the same subroutine parsing the %9${k}dau%9 command. Special Variables: \$nick: contains the nick of the one who sent the message to which dau.pl reacts END } elsif ($option_setting eq 'dau_remote_voice_reply') { $output = &fix(<<" END"); %9dau_remote_voice_reply%9 %Ustring Comma separated list of messages (it will take randomly one item of the list) sent to channel if someone voices you (mode change +v). The string given will be processed by the same subroutine parsing the %9${k}dau%9 command. Special Variables: \$nick: contains the nick of the one who changed the mode END } elsif ($option_setting eq 'dau_standard_messages') { $output = &fix(<<" END"); %9dau_standard_messages%9 %Ustring Comma separated list of strings %9${k}dau%9 will use if the user omits the text on the commandline. END } elsif ($option_setting eq 'dau_standard_options') { $output = &fix(<<" END"); %9dau_standard_options%9 %Ustring Options %9${k}dau%9 will use if the user omits them on the commandline. END } elsif ($option_setting eq 'dau_words_range') { $output = &fix(<<" END"); %9dau_words_range%9 %Ui-j Setup the range howmany words the command should write per line. 1 <= i <= j <= 9; i, j element { 1, ... , 9 }. If i == j the command will write i words to the active window. Else it takes a random number k (element { i, ... , j }) and writes k words per line. END } return $output; } sub switch_random { my ($data, $channel_rec) = @_; my $output; my (@options, $text); # Push each item of dau_random_options in the @options array. while ($option{dau_random_options} =~ /\s*([^,]+)\s*,?/g) { my $item = $1; push @options, $item; } # More than one item in @options. Choose one randomly but exclude # the last item chosen. if (@options > 1) { @options = grep { $_ ne $misc{random_last} } @options; my $opt = @options[rand(@options)]; $misc{random_last} = $opt; $text .= $opt . ' ' . $data; $output = parse_text($text, $channel_rec); } # Exact one item in @options - take that elsif (@options == 1) { my $opt = $options[0]; $misc{random_last} = $opt; $text .= $opt . ' ' . $data; $output = parse_text($text, $channel_rec); } # No item in @options - call switch_moron() else { $output = &{ $switches{combo}{moron}{'sub'} }($output, $channel_rec); } return $output; } ################################################################################ # Subroutines (switches, may be combined) ################################################################################ sub switch_boxes { my $data = shift; # handling punctuation marks: # they will be put in their own box later $data =~ s%(\w+)([,.?!;:]+)% $1 . ' ' . join(' ', split(//, $2)) %egx; # separate words (by whitespace) and put them in a box $data =~ s/(\s*)(\S+)(\s*)/$1\[$2\]$3/g; return $data; } sub switch_bracket { my $data = shift; my $output; my %brackets = ( '((' => '))', '-=(' => ')=-', '-=[' => ']=-', '-={' => '}=-', '-=|(' => ')|=-', '-=|[' => ']|=-', '-=|{' => '}|=-', '.:>' => '<:.', ); foreach (keys %brackets) { for my $times (2 .. 3) { my $pre = $_; my $post = $brackets{$_}; $pre =~ s/(.)/$1 x $times/eg; $post =~ s/(.)/$1 x $times/eg; $brackets{$pre} = $post; } } $brackets{'!---?['} = ']?---!'; $brackets{'(qp=>'} = '<=qp)'; $brackets{'----->'} = '<-----'; my $pre = (keys(%brackets))[int(rand(keys(%brackets)))]; my $post = $brackets{$pre}; $output = "$pre $data $post"; return $output; } sub switch_chars { my $data = shift; my $output; foreach my $char (split //, $data) { $output .= "$char\n"; } return $output; } sub switch_command { my $data = shift; $misc{command} = $misc{queue}{$misc{counter}}{command}{cmd}; $misc{switch_command_set} = 1; return $data; } sub switch_color { my $data = shift; my (@colors, $option_color_split, $output, $split); my @all_colors = qw(2 3 5 6 8 10); @all_colors = map { $_ = sprintf('%02d', $_) } @all_colors; if ($misc{queue}{$misc{counter}}{color}{'split'}) { $option_color_split = $misc{queue}{$misc{counter}}{color}{'split'}; } else { $option_color_split = 'rchars'; } if ($option_color_split eq 'chars') { $split = ''; } elsif ($option_color_split eq 'lines') { $split = "\n"; } elsif ($option_color_split eq 'words') { $split = '\s+'; } elsif ($option_color_split eq 'rchars') { $split = '.' x rand(10); } else { $split = '.' x rand(10); } @colors = @all_colors; for (split /($split)/, $data) { my $color = $colors[rand(@colors)]; if ($_ eq ',') { $output .= "\003" . $color . ',,'; @colors = grep { $_ ne $color } @all_colors; } elsif (/^\s*$/) { $output .= $_; } else { $output .= "\003" . $color . $_; @colors = grep { $_ ne $color } @all_colors; } } return $output; } sub switch_delimiter { my $data = shift; my $output; my $option_delimiter_string; if ($misc{queue}{$misc{counter}}{delimiter}{string}) { $option_delimiter_string = $misc{queue}{$misc{counter}}{delimiter}{string}; } else { $option_delimiter_string = $option{dau_delimiter_string}; } foreach my $char (split //, $data) { $output .= $char . $option_delimiter_string; } return $output; } sub switch_dots { my $data = shift; $data =~ s/\s*[,;.:?!]*\s+(?!$)/ if (rand(10) < 3) { (rand(10) >= 5 ? ' ' : '') . ('...' . '.' x rand(5)) . (rand(10) >= 5 ? ' ' : '') } else { ' ' } /xge; rand(10) >= 5 ? $data .= ' ' : 0; $data .= ('...' . '.' x rand(10)); return $data; } sub switch_figlet { my $data = shift; my $skip = 1; my ($output, @fonts, %font, $font, @cache1, @cache2); unless (-e $option{dau_figlet_path}) { print_err('figlet not found. More information: ' . "%9${k}dau --help -setting dau_figlet_path%9"); return; } if ($misc{queue}{$misc{counter}}{figlet}{font}) { $font = $misc{queue}{$misc{counter}}{figlet}{font}; } else { while ($option{dau_figlet_fontlist} =~ /\s*([^,\s]+)\s*,?/g) { $font{$1} = 1; } foreach my $font (keys %{ $switches{combo}{figlet}{font} }) { if (lc($option{dau_figlet_fontpolicy}) eq 'allow') { push(@fonts, $font) unless ($font{$font}); } elsif (lc($option{dau_figlet_fontpolicy}) eq 'deny') { push(@fonts, $font) if ($font{$font}); } else { print_err('Invalid value for setting dau_figlet_fontpolicy. ' . 'More information: ' . "%9${k}dau --help -setting dau_figlet_fontpolicy%9"); return; } } if (@fonts == 0) { print_err('Cannot find figlet-fonts. Please check your figlet installation ' . "or dau.pl's settings for %9--figlet%9 (%9${k}set dau_figlet%9)"); return; } $font = $fonts[rand(@fonts)]; } # Run figlet my $childpid = open3(*IN, *OUT, *ERR, $option{dau_figlet_path}, '-f', $font, $data); my @errors = ; # Error during execution? Print out && return unless (@errors == 0) { print_err('Error during execution of figlet'); foreach my $line (@errors) { print_err($line); } return; } if ($option{dau_figlet_print_font}) { print_out("using figlet-font $font"); } while () { chomp; if (/^\s*$/ && $skip) { next; } else { $skip = 0; } push(@cache1, $_); } close OUT; waitpid($childpid, 0); $skip = 1; foreach (reverse @cache1) { chomp; if (/^\s*$/ && $skip) { next; } else { $skip = 0; } push(@cache2, $_); } foreach (reverse @cache2) { $output .= "$_\n"; } return $output; } sub switch_greet { my $channel = $_[1]; my (@nicks, $output); if (defined($channel) && $channel && $channel->{type} eq 'CHANNEL') { foreach my $nick ($channel->nicks()) { if ($channel->{server}->{nick} ne $nick->{nick}) { push(@nicks, $nick->{nick}); } } } if (@nicks == 0) { return ''; } if ($misc{queue}{$misc{counter}}{greet}{whom} eq 'rnick') { $output = 'hi @ ' . $nicks[rand(@nicks)]; } else { $output = 'hi @ '; @nicks = sort { lc($a) cmp lc($b) } @nicks; for my $nick (@nicks) { $output .= "$nick, "; } $output =~ s/, $//; } return $output; } sub switch_leet { my $data = shift; $_ = $data; s'fucker'f@#$er'gi; s/hacker/h4x0r/gi; s/sucker/sux0r/gi; s/fear/ph34r/gi; s/dude/d00d/gi; s/rude/r00d/gi; s/\bthe\b/d4/gi; s/\byou\b/j00/gi; s/\bdo\b/d00/gi; s/\b(\w{3,})er\b/${1}0r/gi; tr/lLzZeEaAsSgGtTbBqQoOiIcC/11223344556677889900||((/; s/(\w)/rand(100) < 50 ? "\u$1" : "\l$1"/ge; return $_; } sub switch_me { my $data = shift; $misc{command} = 'ACTION'; return $data; } sub switch_mixedcase { my $data = shift; $data =~ s/([[:alpha:]])/rand(100) < 50 ? uc($1) : lc($1)/ge; return $data; } sub switch_moron { my ($data, $channel_rec) = @_; my $output; my $option_eol_style; my $option_substitutions_permissions; local $" = '|'; # Get values of settings/switchs if ($misc{queue}{$misc{counter}}{moron}{eol}) { $option_eol_style = $misc{queue}{$misc{counter}}{moron}{eol}; } else { $option_eol_style = $option{dau_moron_eol_style}; } if ($misc{queue}{$misc{counter}}{moron}{perm}) { $option_substitutions_permissions = $misc{queue}{$misc{counter}}{moron}{perm}; } else { $option_substitutions_permissions = $option{dau_moron_substitutions_permissions}; } # Generate list of nicks in current channel for later use my @nicks; if (defined($channel_rec) && $channel_rec && $channel_rec->{type} eq 'CHANNEL') { foreach my $nick ($channel_rec->nicks()) { if ($channel_rec->{server}->{nick} ne $nick->{nick}) { push(@nicks, quotemeta($nick->{nick})); } } } $_ = $data; # Remove puntuation marks at EOL and ensure there is a single space at EOL. # This is necessary because the EOL-styles 'new' and 'classic' put them at # EOL. If EOL-style is set to 'nothing' don't do this. s/\s*([,;.:?!])*\s*$/ / unless ($option_eol_style eq 'nothing'); my $lastchar = $1; # Only whitespace? Remove it. s/^\s+$//; # Some substitutions making always sense ;-) s/'/`/go; eval { # Catch strange error s/^(@nicks): (.+)/$2@ $1 /; }; { # possible asterisks my @a = ('*', 'Ü'); # choose one my $a = $a[int(rand(@a))]; # replacement s/\*g\*/$a . 'ggg' . ('g' x rand(10)) . $a/egi; } { # Use of uninitialized value in concatenation (.) or string at... # (the optional dash ($1) in the regular expressions) no warnings; if (int(rand(2))) { s/:(-)?\)/^^/go; } else { s/:(-)?\)/':' . $1 . ')))' . (')' x rand(10)) . ('9' x rand(4))/ego; } s/;(-)?\)/';' . $1 . ')))' . (')' x rand(10)) . ('9' x rand(4))/ego; s/:(-)?\(/':' . $1 . '(((' . ('(' x rand(10)) . ('8' x rand(4))/ego; s#:(-)?\/#':' . $1 . '///' . ('/' x rand(10)) . ('7' x rand(4))#ego; } # Your own substitutions from file if ($option_substitutions_permissions =~ /^[01][01]1$/) { my $file = "$option{dau_files_root_directory}/$option{dau_files_moron_own_substitutions}"; unless (-e $file && -r $file) { print_err("cannot access $file properly"); return; } unless (my $return = do $file) { if ($@) { print_err("parsing $file failed: $@"); } unless (defined($return)) { print_err("'do $file' failed"); } } } # Substitutions making sense performed on german text. # The user can turn them off/on if ($option_substitutions_permissions =~ /^1[01][01]$/) { # verbs s/\bfunktionieren\b/funzen/gio; s/\bfunktioniere\b/funze/gio; s/\bfunktionierst\b/funzt/gio; s/\bfunktioniert\b/funzt/gio; s/\bholen\b/hohlen/gio; s/\bhole\b/hohle/gio; s/\bholst\b/hohlst/gio; s/\bholt\b/hohlt/gio; s/\blachen\b/lölen/gio; s/\blache\b/löle/gio; s/\blachst\b/lölst/gio; s/\blacht\b/lölt/gio; s/\bmachen\b/tun/gio; s/\bmache\b/tu/gio; s/\bmachst\b/tust/gio; s/\bnerven\b/nerfen/gio; s/\bnerve\b/nerfe/gio; s/\bnervst\b/nerfst/gio; s/\bnervt\b/nerft/gio; s/\bregistrieren\b/regestrieren/gio; s/\bregistriere\b/regestriere/gio; s/\bregistrierst\b/regestrierst/gio; s/\bregistriert\b/regestriert/gio; s/\bspazieren\b/spatzieren/gio; s/\bspaziere\b/spatziere/gio; s/\bspazierst\b/spatzierst/gio; s/\bspaziert\b/spatziert/gio; # other s/\bist er\b/issa/gio; s/\bist\b/int(rand(2)) ? 'is' : 'iss'/egio; s/\bda(?:ss|ß) du\b/dasu/gio; s/\bda(?:ss|ß)\b/das/gio; s/\bsag mal\b/samma/gio; s/\bnochmal\b/nomma/gio; s/mal\b/ma/gio; s/\bund nun\b/unnu/gio; s/\bnun\b/nu/gio; s/\bund\b/unt/gio; s/\bsoll denn\b/solln/gio; s/\bdenn\b/den/gio; s/\b(?:kiste|box|b(?:ü|ue)chse)\b/byxe/gio; s/\b(?:sorry|entschuldigung)\b/sry/gio; s/\b([[:lower:]]{2,})st du\b/${1}su/gio; s/\baber\b/abba/gio; s/\bachso\b/axo/gio; s/\bau(?:ss|ß)er\b/auser/gio; s/\bbist\b/bis/gio; s/\bbitte\b/plz/gio; s/\bblo(?:ss|ß)\b/blos/gio; s/\bchannel\b/kanal/gio; s/\bcool\b/kewl/gio; s/\bd(?:ä|ae)mlich\b/dähmlich/gio; s/\bdanke\b/thx/gio; s/\bdirekt\b/direckt/gio; s/\bdiskussion\b/disskusion/gio; s/\bdistribution/dystrubution/gio; s/\beigentlich\b/eigendlich/gio; s/\beine\b/ne/gio; s/\beinzige\b/einzigste/gio; s/\bfilm\b/movie/gio; s/\bh(?:ä|ae)sslich/häslich/gio; s/\bhat\b/hatt/gio; s/\binteressant\b/interressant/gio; s/\birgend/irgent/gio; s/\bja\b/joh/gio; s/\bjetzt\b/jez/gio; s/\bkaputt\b/kaput/gio; s/\bkein problem\b/np/gio; s/\bkrise\b/kriese/gio; s/\bleute\b/ppl/gio; s/\blizenz\b/lizens/gio; s/\blol\b/löl/gio; s/\blustig/lölig/gio; s/\bmaschine\b/maschiene/gio; s/\bmiserabel\b/mieserabel/gio; s/\bmit dem\b/mim/gio; s/\bn(?:ä|ae)mlich\b/nähmlich/gio; s/\bnein\b/neh/gio; s/\bnewbie\b/n00b/gio; s/\bnicht\b/int(rand(2)) ? 'net' : 'ned'/egio; s/\bniveau/niwo/gio; s/\bok(?:ay)?\b/k/gio; s/\boriginal\b/orginal/gio; s/\bpl(?:ö|oe)tzlich\b/plözlich/gio; s/\bprobleme\b/probs/gio; s/\bprogramm\b/proggie/gio; s/\bprogramme\b/proggies/gio; s/\bquery\b/querry/gio; s/\brofl\b/röfl/gio; s/\broflol\b/röflöl/gio; s/\brotfl\b/rötfl/gio; s/\brotflol\b/rötflöl/gio; s/\bscherz\b/schertz/gio; s/\bsei([dt])\b/$1 eq 'd' ? 'seit' : 'seid'/egio; s/\bspiel\b/game/gio; s/\bstabil\b/stabiel/gio; s/\bstandard\b/standart/gio; s/\bsyntax\b/synthax/gio; s/\bto([td])/$1 eq 't' ? 'tod' : 'tot'/egio; s/\btoler/toller/gio; s/\bungef(?:ä|ae)hr\b/ungefär/gio; s/\bviel gl(?:ü|ue)ck\b/gl/gio; s/\bvielleicht\b/vileicht/gio; s/\bvoraussichtlich\b/vorraussichtlich/gio; s/\bw(?:ä|ae)re\b/währe/gio; s/\bwa(h)?r/$1 eq 'h' ? 'war' : 'wahr'/egio; s/\bwas du\b/wasu/gio; s/\bweil du\b/weilu/gio; s/\bweis(s)?/$1 eq 's' ? 'weis' : 'weiss'/egio; s/\bwenn du\b/wennu/gio; s/\bwider/wieder/gio; s/\bziemlich\b/ziehmlich/gio; s/\bzumindest\b/zumindestens/gio; } if ($option_substitutions_permissions =~ /^[01]1[01]$/) { s/\b([[:alpha:]]+[b-np-tv-z])er\b/${1}a/gio; s/\b([fv])(?=[[:alpha:]]{2,})/lc($1) eq 'f' ? 'v' : 'f'/egio; } $data = $_; # Swap characters with characters near at the keyboard my %mark; my %chars = ( 'a' => [ 's' ], 'b' => [ 'v', 'n' ], 'c' => [ 'x', 'v' ], 'd' => [ 's', 'f' ], 'e' => [ 'w', 'r' ], 'f' => [ 'd', 'g' ], 'g' => [ 'f', 'h' ], 'h' => [ 'g', 'j' ], 'i' => [ 'u', 'o' ], 'j' => [ 'h', 'k' ], 'k' => [ 'j', 'l' ], 'l' => [ 'k', 'ö' ], 'm' => [ 'n' ], 'n' => [ 'b', 'm' ], 'o' => [ 'i', 'p' ], 'p' => [ 'o', 'ü' ], 'q' => [ 'w' ], 'r' => [ 'e', 't' ], 's' => [ 'a', 'd' ], 't' => [ 'r', 'z' ], 'u' => [ 'z', 'i' ], 'v' => [ 'c', 'b' ], 'w' => [ 'q', 'e' ], 'x' => [ 'y', 'c' ], 'y' => [ 'x' ], 'z' => [ 't', 'u' ], 'A' => [ 'S' ], 'B' => [ 'V', 'N' ], 'C' => [ 'X', 'V' ], 'D' => [ 'S', 'F' ], 'E' => [ 'W', 'R' ], 'F' => [ 'D', 'G' ], 'G' => [ 'F', 'H' ], 'H' => [ 'G', 'J' ], 'I' => [ 'U', 'O' ], 'J' => [ 'H', 'K' ], 'K' => [ 'J', 'L' ], 'L' => [ 'K', 'Ö' ], 'M' => [ 'N' ], 'N' => [ 'B', 'M' ], 'O' => [ 'I', 'P' ], 'P' => [ 'O', 'Ü' ], 'Q' => [ 'W' ], 'R' => [ 'E', 'T' ], 'S' => [ 'A', 'D' ], 'T' => [ 'R', 'Z' ], 'U' => [ 'Z', 'I' ], 'V' => [ 'C', 'B' ], 'W' => [ 'Q', 'E' ], 'X' => [ 'Y', 'C' ], 'Y' => [ 'X' ], 'Z' => [ 'T', 'U' ], ); # Do not replace one character twice # Therefore every replace-position will be marked for (0 .. length($data)) { $mark{$_} = 0; } for (0 .. rand(length($data))/20) { my $pos = int(rand(length($data))); pos $data = $pos; unless ($mark{$pos} == 1) { no locale; if ($data =~ /\G([A-Za-z])/g) { my $replacement = $chars{$1}[int(rand(@{ $chars{$1} }))]; substr($data, $pos, 1, $replacement); $mark{$pos} = 1; } } } # Mix in some typos foreach my $word (split /([\s\n])/, $data) { if ((rand(100) <= 20) && length($word) > 1) { if ($word =~ s/([[:punct:]])$//) { my $random = rand(length($word)); $random = 2 if ($random == 1); (substr($word, $random, 1), substr($word, $random-1, 1)) = (substr($word, $random-1, 1), substr($word, $random, 1)); } else { my $random = rand(length($word)); $random = 2 if ($random == 1); (substr($word, $random, 1), substr($word, $random-1, 1)) = (substr($word, $random-1, 1), substr($word, $random, 1)); } } $output .= $word . $1; } # 'plenken' #$output =~ s/(\w+)([,;.:?!]+)/$1 $2/g; #$output =~ s/([,;.:?!]+)(\w+)/$1 $2/g; # default behaviour: uppercase text $output = uc($output) unless ($misc{queue}{$misc{counter}}{moron}{uppercase} eq 'no'); # do something at EOL # 'classic' style if ($option_eol_style eq 'classic' || ($option_eol_style ne 'nothing' && $lastchar eq '!')) { my @punct = qw(? !); $output .= $punct[rand(@punct)] x int(rand(5)) for (1..15); if ($lastchar eq '?') { $output .= '?' x (int(rand(4))+1); } elsif ($lastchar eq '!') { $output .= '!' x (int(rand(4))+1); } if ($output =~ /\?$/) { $output .= "ß" x int(rand(10)); } elsif ($output =~ /!$/) { $output .= "1" x int(rand(10)); } } # 'new' style elsif ($option_eol_style eq 'new') { my $random = rand(100); # many punctuation marks at EOL if ($random <= 70) { my @punct = qw(? !); $output .= $punct[rand(@punct)] x int(rand(5)) for (1..15); if ($lastchar eq '?') { $output .= '?' x (int(rand(4))+1); } elsif ($lastchar eq '!') { $output .= '!' x (int(rand(4))+1); } if ($output =~ /\?$/) { $output .= "ß" x int(rand(10)); } elsif ($output =~ /!$/) { $output .= "1" x int(rand(10)); } } # or '?¿?' at EOL elsif ($random <= 85) { $output .= '?¿?'; } # or "=\n?" at EOL else { $output .= "=\n?"; } } return $output; } sub switch_reverse { my $data = shift; $data = reverse($data); return $data; } sub switch_stutter { my $data = shift; my $output; my @words = qw(nnugub rautakauppa jakki uuh rakkaus rakastan ihana vittu mug mugmug homo huora huh huhhuh hinttari paska öh äh ööh ääh aah ah uh oh ooh gnnn goaar siis eiku perkele vittu saatana helvetti ku); foreach (split / (?=\w+\b)/, $data) { if (rand(100) < 20) { $output .= ' ' . $words[rand(@words)] . ", $_"; } else { $output .= ' ' . $_; } } $output =~ s/\s*,\s+\@/ @/g; for (1 .. rand(length($output)/5)) { pos $output = rand(length($output)); $output =~ s/\G ([[:alpha:]]+)\b/ $1, $1/; } for (1 .. rand(length($output)/10)) { pos $output = rand(length($output)); $output =~ s/\G([[:alpha:]])/$1 . ($1 x rand(3))/e; } $output =~ s/^\s+//; return $output; } sub switch_underline { my $data = shift; if ($misc{queue}{$misc{counter}}{underline}{spaces} eq 'no') { $data = "\037$data\037"; } else { $data = "\037 $data \037"; } return $data; } sub switch_uppercase { my $data = shift; $data = uc($data); return $data; } sub switch_words { my $data = shift; my $output; my @numbers; if ($option{dau_words_range} =~ /^([1-9])-([1-9])$/) { my $x = $1; my $y = $2; unless ($x <= $y) { print_err('Invalid value for setting dau_words_range. ' . "More information: %9${k}dau --help -setting dau_words_range%9"); return; } if ($x == $y) { push(@numbers, $x); } elsif ($x < $y) { for (my $i = $x; $i <= $y; $i++) { push(@numbers, $i); } } } else { print_err('Invalid value for setting dau_words_range. ' . "More information: %9${k}dau --help -setting dau_words_range%9"); return; } my $random = $numbers[rand(@numbers)]; while ($data =~ /((?:.*?(?:\s+|$)){1,$random})/g) { $output .= "$1\n" unless (length($1) == 0); $random = $numbers[rand(@numbers)]; } return $output; } ################################################################################ # Subroutines (signals) ################################################################################ sub signal_complete_word { my ($list, $window, $word, $linestart, $want_space) = @_; # Parsing the commandline for dau.pl is relatively complicated. # TAB-Completion depends on commandline parsing in dau.pl. # Script autors looking for a simple example for irssi's # TAB-Completion are wrong here. my $server = Irssi::active_server(); my $channel = $window->{active}; my @switches_combo = map { $_ = "--$_" } keys %{ $switches{combo} }; my @switches_nocombo = map { $_ = "--$_" } keys %{ $switches{nocombo} }; my @nicks; # Only complete when the commandline starts with '${k}dau'. # If not, let irssi do the work return unless ($linestart =~ /^\Q${k}\Edau/i); # Remove everything syntactically correct thing of $linestart. # If there is anything else but whitespace at the end of # commandline parsing, we have an syntax error. # If we have a syntax error, complete only nicks. $linestart =~ s/^\Q${k}\Edau ?//i; # Generate list of nicks in current channel for later use if (defined($channel->{type}) && $channel->{type} eq 'CHANNEL') { foreach my $nick ($channel->nicks()) { if ($nick->{nick} =~ /^\Q$word\E/i && $window->{active_server}->{nick} ne $nick->{nick}) { push(@nicks, quotemeta($nick->{nick})); } } } # Variables my $combo = 0; # Boolean: True if last switch was one of keys %{ $switches{combo} } my $syntax_error = 0; # Boolean: True if syntax error found my $counter = 0; # Integer: Counts First-Level-Options my $first_level_option = ''; # String: Last First-Level-Option my $second_level_option = ''; # String: Last Second-Level-Option my $third_level_option = 0; # Boolean: True if found a Third-Level-Option # Parsing commandline now. Set variables accordingly. OUTER: while ($linestart =~ /^--(\w+) ?/g) { $second_level_option = ''; $third_level_option = 0; # Found a First-Level-Option (combo) if (ref($switches{combo}{$1}{'sub'})) { $first_level_option = $1; $combo = 1; } # Found a First-Level-Option (nocombo) elsif (ref($switches{nocombo}{$1}{'sub'}) && $counter == 0) { $first_level_option = $1; $combo = 0; } # Not a First-Level-Option => Syntax error else { $syntax_error = 1; last OUTER; } # Syntactically correct => remove it $linestart =~ s/^--\w+ ?//; # Checkout if there are Second- or Third-Level-Options INNER: while ($linestart =~ /^-(\w+)(?: ('[^']+'|\S+))? ?/g) { my $second_level = $1; my $third_level = $2 || ''; $third_level =~ s/^'([^']+)'$/$1/; # Do the same for combo and nocombo-options. They have to be # handled separately anyway. # combo... if ($combo) { # Found a Second-Level-Option if ($switches{combo}{$first_level_option}{$second_level}) { $second_level_option = $second_level; } # Not a Second-Level-Option => Syntax error else { $syntax_error = 1; last OUTER; } # Syntactically correct => remove it $linestart =~ s/^-\w+//; # Found something in the regexp of the INNER-while-loop-condition, # which is perhaps a Third-Level-Option if ($third_level) { # Found a Third-Level-Option if ($switches{combo}{$first_level_option}{$second_level_option}{$third_level} || $switches{combo}{$first_level_option}{$second_level_option}{'*'}) { $third_level_option = 1; # Syntactically correct => remove it $linestart =~ s/^(?: ('[^']+'|\S+))? ?//; } # Not a Third-Level-Option => Syntax error else { $syntax_error = 1; last OUTER; } # Nothing found which comes into question for a Third-Level-Option. # The commandline has to be empty now (remember: everything # syntactically correct has been removed) or we have a syntax error. } else { # Empty! Later we will complete to Third-Level-Options if ($linestart =~ /^\s*$/) { $third_level_option = 0; } # Not empty => Syntax error else { $syntax_error = 1; last OUTER; } } # nocombo... } else { # Found a Second-Level-Option if ($switches{nocombo}{$first_level_option}{$second_level}) { $second_level_option = $second_level; } # Not a Second-Level-Option => Syntax error else { $syntax_error = 1; last OUTER; } # Syntactically correct => remove it $linestart =~ s/^-\w+//; # Found something in the regexp of the INNER-while-loop-condition, # which is perhaps a Third-Level-Option if ($third_level) { # Found a Third-Level-Option if ($switches{nocombo}{$first_level_option}{$second_level_option}{$third_level} || $switches{nocombo}{$first_level_option}{$second_level_option}{'*'}) { $third_level_option = 1; # Syntactically correct => remove it $linestart =~ s/^(?: ('[^']+'|\S+))? ?//; } # Not a Third-Level-Option => Syntax error else { $syntax_error = 1; last OUTER; } # Nothing found which comes into question for a Third-Level-Option. # The commandline has to be empty now (remember: everything # syntactically correct has been removed) or we have a syntax error. } else { # Empty! Later we will complete to Third-Level-Options if ($linestart =~ /^\s*$/) { $third_level_option = 0; } # Not empty => Syntax error else { $syntax_error = 1; last OUTER; } } } } } continue { $counter++; } # End of commandline-parsing. # Everything syntactically correct removed. # If commandline is not empty now, we have a syntax error. if ($linestart !~ /^\s*$/) { $syntax_error = 1; } # Do the TAB-Completion if ($syntax_error) { foreach my $x (sort @nicks) { if($x =~ /^$word/i) { push(@$list, $x); } } } elsif ($counter == 0) { foreach my $x (sort (@switches_combo, @switches_nocombo, @nicks)) { if($x =~ /^$word/i) { push(@$list, $x); } } } elsif (($combo && $first_level_option && $second_level_option && $third_level_option) || ($combo && $first_level_option && !$second_level_option && !$third_level_option)) { my @switches_second_level = grep !/^-sub$/, map { $_ = "-$_" } keys %{ $switches{combo}{$first_level_option} }; foreach my $x (sort (@switches_second_level, @switches_combo, @nicks)) { if($x =~ /^$word/i) { push(@$list, $x); } } } elsif ((!$combo && $counter == 1 && $first_level_option && $second_level_option && $third_level_option) || (!$combo && $counter == 1 && $first_level_option && !$second_level_option && !$third_level_option)) { my @switches_second_level = grep !/^-sub$/, map { $_ = "-$_" } keys %{ $switches{nocombo}{$first_level_option} }; foreach my $x (sort (@switches_second_level)) { if($x =~ /^$word/i) { push(@$list, $x); } } } elsif ($combo && $first_level_option && $second_level_option && !$third_level_option) { my @switches_third_level = grep !/^\*$/, keys %{ $switches{combo}{$first_level_option}{$second_level_option} }; foreach my $x (sort (@switches_third_level)) { if($x =~ /^$word/i) { push(@$list, $x); } } } elsif (!$combo && $counter == 1 && $first_level_option && $second_level_option && !$third_level_option) { my @switches_third_level = grep !/^\*$/, keys %{ $switches{nocombo}{$first_level_option}{$second_level_option} }; foreach my $x (sort (@switches_third_level)) { if($x =~ /^$word/i) { push(@$list, $x); } } } Irssi::signal_stop(); } sub signal_event_privmsg { my ($server, $data, $nick, $hostmask) = @_; my ($channel_name, $text) = split / :/, $data, 2; my $channel_rec = $server->channel_find($channel_name); $channel_name = lc($channel_name); my $server_name = lc($server->{tag}); my %lookup; set_settings(); while ($option{dau_remote_channellist} =~ /\s*([^\/]+)\/([^,]+)\s*,?/g) { my $channel = $1; $channel = lc($channel); my $ircnet = $2; $ircnet = lc($ircnet); $lookup{$ircnet}{$channel} = 1; } if (lc($option{dau_remote_channelpolicy}) eq 'allow') { return if ($lookup{$server_name}{$channel_name}); } elsif (lc($option{dau_remote_channelpolicy}) eq 'deny') { return unless ($lookup{$server_name}{$channel_name}); } else { return; } if ($text =~ /^hallo wie geht[\s?ß!1]*$/i) { set_settings(); my $reply = parse_setting_list('dau_remote_question_reply'); $reply =~ s/(?{name}); my $server_name = lc($channel->{server}->{tag}); return unless ($channel->{server}->{nick} eq $nick->{nick}); return if ($nick->{nick} eq $setby); return if ($setby eq 'irc.psychoid.net'); set_settings(); while ($option{dau_remote_channellist} =~ /\s*([^\/]+)\/([^,]+)\s*,?/g) { my $channel = $1; $channel = lc($channel); my $ircnet = $2; $ircnet = lc($ircnet); $lookup{$ircnet}{$channel} = 1; } if (lc($option{dau_remote_channelpolicy}) eq 'allow') { return if ($lookup{$server_name}{$channel_name}); } elsif (lc($option{dau_remote_channelpolicy}) eq 'deny') { return unless ($lookup{$server_name}{$channel_name}); } else { return; } if ($option{dau_remote_permissions} =~ /^[01]1[01][01][01][01]$/) { if ($mode eq '+' && $type eq '+') { $reply = parse_setting_list('dau_remote_voice_reply'); $reply =~ s/(?{name}, $reply); } sub signal_send_text { my ($data, $server, $witem) = @_; my $output; return unless (defined($server) && $server && $server->{connected}); return unless (defined($witem) && $witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')); if ($misc{daumode_active}{$server->{tag}}{$witem->{name}} == 1) { if ($misc{daumode_active_fix}{$server->{tag}}{$witem->{name}} eq '') { $output = parse_text($misc{daumode_active_fix}{$server->{tag}}{$witem->{name}} . $data, $witem); } else { $output = parse_text($misc{daumode_active_fix}{$server->{tag}}{$witem->{name}} . ' ' . $data, $witem); } output_text($witem, $witem->{name}, $output); Irssi::signal_stop(); } } sub signal_setup_changed { set_settings(); # setting changed/added => change/add it here # setting cmdchars $k = Irssi::parse_special('$k'); # setting dau_figlet_fontpath figlet_fontlist($option{dau_figlet_fontpath}); # setting dau_remote_babble_interval if ($option{dau_remote_babble_interval} != $misc{remote_babble_timer_last_interval}) { timer_babble_reset(); } # setting dau_statusbar_daumode_hide_when_off Irssi::statusbar_items_redraw('daumode'); # timer for the babble-feature timer_babble_reset(); # signal handling signal_handling(); } ################################################################################ # Subroutines (statusbar) ################################################################################ sub statusbar_daumode { my ($item, $get_size_only) = @_; my ($daumode, $string, $string_fix); my $server = Irssi::active_server(); my $witem = Irssi::active_win()->{active}; my $theme = Irssi::current_theme(); my $format = $theme->format_expand('{sb_daumode}'); set_settings(); if (defined($witem) && $witem && defined($server) && $server && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) { if (defined($misc{daumode_active}{$server->{tag}}{$witem->{name}}) && $misc{daumode_active}{$server->{tag}}{$witem->{name}} == 1) { $daumode = 'ON'; } else { $daumode = 'OFF'; } # Hide statusbaritem if setting dau_statusbar_daumode_hide_when_off # is turned on and daumode is turned off if ($daumode eq 'OFF' && $option{dau_statusbar_daumode_hide_when_off}) { $item->{min_size} = $item->{max_size} = 0; return; } if ($format) { my $daumode_active_fix = $misc{daumode_active_fix}{$server->{tag}}{$witem->{name}}; $string_fix = $theme->format_expand("{sb_daumode_fix $daumode_active_fix}", Irssi::EXPAND_FLAG_IGNORE_EMPTY()); if ($daumode_active_fix ne '') { $string .= $string_fix; } else { $string = ''; } $format = $theme->format_expand("{sb_daumode $daumode $string}"); } else { if (defined($misc{daumode_active_fix}{$server->{tag}}{$witem->{name}}) && $misc{daumode_active_fix}{$server->{tag}}{$witem->{name}} ne '') { $format = "{sb daumode \%9$daumode\%9 ($misc{daumode_active_fix}{$server->{tag}}{$witem->{name}})}"; } else { $format = "{sb daumode \%9$daumode\%9}"; } } } else { $item->{min_size} = $item->{max_size} = 0; return; } $item->default_handler($get_size_only, $format, '', 1); } ################################################################################ # Subroutines (timer) ################################################################################ sub timer_babble { set_settings(); # Push all channels where it's ok to babble text in @channels my %lookup; while ($option{dau_remote_channellist} =~ /\s*([^\/]+)\/([^,]+)\s*,?/g) { my $channel = $1; $channel = lc($channel); my $ircnet = $2; $ircnet = lc($ircnet); $lookup{$ircnet}{$channel} = 1; } my @channels; foreach my $server (Irssi::servers()) { my $server_name = lc($server->{tag}); foreach my $channel ($server->channels()) { my $channel_name = lc($channel->{name}); if (lc($option{dau_remote_channelpolicy}) eq 'allow' && !$lookup{$server_name}{$channel_name}) { push(@channels, $channel); } elsif (lc($option{dau_remote_channelpolicy}) eq 'deny' && $lookup{$server_name}{$channel_name}) { push(@channels, $channel); } } } # No channels found => return return if (@channels == 0); # Get the text to babble from setting dau_remote_babble_messages my $text = parse_setting_list('dau_remote_babble_messages'); # Format text and print it to one of the @channels my $channel = $channels[rand(@channels)]; $text = parse_text($text, $channel); output_text($channel, $channel->{name}, $text); # reset timer timer_babble_reset(); } sub timer_babble_reset { set_settings(); Irssi::timeout_remove($misc{remote_babble_timer}) if (defined($misc{remote_babble_timer})); # Do not set the timer, if the permission-bit is not set return unless ($option{dau_remote_permissions} =~ /^[01][01][01][01][01]1$/); my $interval = $option{dau_remote_babble_interval} * 1000; my $addend = rand($interval / 10); if (int(rand(2))) { $interval = $interval + $addend; } else { $interval = $interval - $addend; } $interval = int($interval); if ($interval < 10 || $interval > 1000000000) { print_err('Invalid value of dau_remote_babble_interval'); return; } # Store settings value (when setup changes it must know whether to # reset timer or not $misc{remote_babble_timer_last_interval} = $option{dau_remote_babble_interval}; # Set timer $misc{remote_babble_timer} = Irssi::timeout_add($interval, \&timer_babble, ''); } ################################################################################ # Helper subroutines ################################################################################ sub def_dau_figlet_fontpath { my $figlet = `figlet -I2`; chomp($figlet); return $figlet; } sub def_dau_figlet_path { my $figlet = `which figlet`; chomp($figlet); return $figlet; } sub figlet_fontlist { my $figlet_fontpath = shift; # clear fontlist %{ $switches{combo}{figlet}{font} } = (); # generate new list while (<$figlet_fontpath/*.flf>) { my $font = (fileparse($_, qr/\..*/))[0]; $switches{combo}{figlet}{font}{$font} = 1; } } sub fix { my $string = shift; $string =~ s/^\t+//gm; return $string; } sub output_text { my ($thing, $target, $text) = @_; foreach my $line (split /\n/, $text) { # --command -cmd 'some command'? if ($misc{switch_command_set}) { if (defined($thing) && $thing) { $thing->command("$misc{command} $line"); } else { my $server = Irssi::active_server(); if (defined($server) && $server && $server->{connected}) { $server->command("$misc{command} $line"); } else { print CLIENTCRAP $line; } } } # Not a channel/query-window, --help, --changelog, ... elsif ($misc{'print'}) { print CLIENTCRAP $line; } # Normal behaviour elsif ($misc{command} eq 'ACTION' || $misc{command} eq 'MSG') { $thing->command("$misc{command} $target $line"); } # if weird things happened... else { print CLIENTCRAP $line; } } } sub parse_setting_list { my $arg = shift; my @strings; while ($option{$arg} =~ /\s*([^,]+)\s*,?/g) { push @strings, $1; } if (@strings == 0) { return ''; } else { return $strings[rand(@strings)]; } } sub parse_text { my ($data, $channel_rec) = @_; my $output; %{ $misc{queue} } = (); $misc{'print'} = 0; $misc{command} = 'MSG'; $misc{counter} = 0; $misc{daumode} = 0; $misc{switch_command_set} = 0; set_settings(); OUTER: while ($data =~ /^--(\w+) ?/g) { my $first_level_option = $1; # If its the first time we are in the OUTER loop, check # if the First-Level-Option is one of the few options, # which must not be combined. if (ref($switches{nocombo}{$first_level_option}{'sub'}) && $misc{counter} == 0) { $data =~ s/^--\w+ ?//; # found a First-Level-Option $misc{queue}{$misc{counter}}{$first_level_option} = { }; # Check for Second-Level-Options and Third-Level-Options. # Get all of them and put theme in the # $misc{queue} hash while ($data =~ /^-(\w+) ('[^']+'|\S+) ?/g) { my $second_level_option = $1; my $third_level_option = $2; $third_level_option =~ s/^'([^']+)'$/$1/; # If $switches{nocombo}{$first_level_option}{$second_level_option}{'*'}: # The user can give any third_level_option on the commandline my $any_option = $switches{nocombo}{$first_level_option}{$second_level_option}{'*'} ? 1 : 0; if ($switches{nocombo}{$first_level_option}{$second_level_option}{$third_level_option} || $any_option) { $misc{queue}{$misc{counter}}{$first_level_option}{$second_level_option} = $third_level_option; } $data =~ s/^-(\w+) ('[^']+'|\S+) ?//; } # initialize some values foreach my $second_level_option (keys(%{ $switches{nocombo}{$first_level_option} })) { if (!defined($misc{queue}{'0'}{$first_level_option}{$second_level_option})) { $misc{queue}{'0'}{$first_level_option}{$second_level_option} = ''; } } # All done. Run the subroutine $output = &{ $switches{nocombo}{$first_level_option}{'sub'} }($data, $channel_rec); return $output; } # Check for all those options that can be combined. elsif (ref($switches{combo}{$first_level_option}{'sub'})) { $data =~ s/^--\w+ ?//; # found a First-Level-Option $misc{queue}{$misc{counter}}{$first_level_option} = { }; # Check for Second-Level-Options and # Third-Level-Options. Get all of them and put them # in the $misc{queue} hash while ($data =~ /^-(\w+) ('[^']+'|\S+) ?/g) { my $second_level_option = $1; my $third_level_option = $2; $third_level_option =~ s/^'([^']+)'$/$1/; # If $switches{combo}{$first_level_option}{$second_level_option}{'*'}: # The user can give any third_level_option on the commandline my $any_option = $switches{combo}{$first_level_option}{$second_level_option}{'*'} ? 1 : 0; # known option => Put it in the hash if ($switches{combo}{$first_level_option}{$second_level_option}{$third_level_option} || $any_option) { $misc{queue}{$misc{counter}}{$first_level_option}{$second_level_option} = $third_level_option; $data =~ s/^-(\w+) ('[^']+'|\S+) ?//; } else { last OUTER; } } # increase counter $misc{counter}++; } else { last OUTER; } } # initialize some values for (my $i = 0; $i < $misc{counter}; $i++) { foreach my $first_level (keys(%{ $misc{queue}{$i} })) { if (ref($switches{combo}{$first_level})) { foreach my $second_level (keys(%{ $switches{combo}{$first_level} })) { if (!defined($misc{queue}{$i}{$first_level}{$second_level})) { $misc{queue}{$i}{$first_level}{$second_level} = ''; } } } } } # text to subroutines $output = $data; # If theres no text left over, take one item of dau_random_messages if ($output =~ /^\s*$/) { $output = parse_setting_list('dau_standard_messages'); } # No options? Get options from setting dau_standard_options and run # parse_text() again if (keys %{ $misc{queue} } == 0) { if (!$misc{subcounter}) { $misc{subcounter}++; $output = parse_text("$option{dau_standard_options} $output", $channel_rec); } else { print_err('Invalid value for setting dau_standard_options. ' . 'Will use %9--moron%9 instead!'); $output =~ s/^\Q$option{dau_standard_options}\E //; $output = parse_text("--moron $output", $channel_rec); } } else { $misc{counter} = 0; for (keys(%{ $misc{queue} })) { my ($first_level_option) = keys %{ $misc{queue}{$misc{counter}} }; $output = &{ $switches{combo}{$first_level_option}{'sub'} }($output, $channel_rec); $misc{counter}++; } } # reset subcounter $misc{subcounter} = 0; # return text return $output; } sub print_err { my $text = shift; print CLIENTCRAP "%Rdau.pl error%n: $text"; } sub print_out { my $text = shift; print CLIENTCRAP "%9dau.pl%9: $text"; } sub set_settings { # setting changed/added => change/add it here # boolean $option{dau_figlet_print_font} = Irssi::settings_get_bool('dau_figlet_print_font'); $option{dau_statusbar_daumode_hide_when_off} = Irssi::settings_get_bool('dau_statusbar_daumode_hide_when_off'); $option{dau_tab_completion} = Irssi::settings_get_bool('dau_tab_completion'); # Integer $option{dau_remote_babble_interval} = Irssi::settings_get_int('dau_remote_babble_interval'); # String $option{dau_delimiter_string} = Irssi::settings_get_str('dau_delimiter_string'); $option{dau_figlet_fontlist} = Irssi::settings_get_str('dau_figlet_fontlist'); $option{dau_figlet_fontpath} = Irssi::settings_get_str('dau_figlet_fontpath'); $option{dau_figlet_fontpolicy} = Irssi::settings_get_str('dau_figlet_fontpolicy'); $option{dau_figlet_path} = Irssi::settings_get_str('dau_figlet_path'); $option{dau_files_moron_own_substitutions} = Irssi::settings_get_str('dau_files_moron_own_substitutions'); $option{dau_files_root_directory} = Irssi::settings_get_str('dau_files_root_directory'); $option{dau_moron_eol_style} = Irssi::settings_get_str('dau_moron_eol_style'); $option{dau_moron_substitutions_permissions} = Irssi::settings_get_str('dau_moron_substitutions_permissions'); $option{dau_random_options} = Irssi::settings_get_str('dau_random_options'); $option{dau_remote_babble_messages} = Irssi::settings_get_str('dau_remote_babble_messages'); $option{dau_remote_channellist} = Irssi::settings_get_str('dau_remote_channellist'); $option{dau_remote_channelpolicy} = Irssi::settings_get_str('dau_remote_channelpolicy'); $option{dau_remote_deop_reply} = Irssi::settings_get_str('dau_remote_deop_reply'); $option{dau_remote_devoice_reply} = Irssi::settings_get_str('dau_remote_devoice_reply'); $option{dau_remote_op_reply} = Irssi::settings_get_str('dau_remote_op_reply'); $option{dau_remote_permissions} = Irssi::settings_get_str('dau_remote_permissions'); $option{dau_remote_question_reply} = Irssi::settings_get_str('dau_remote_question_reply'); $option{dau_remote_voice_reply} = Irssi::settings_get_str('dau_remote_voice_reply'); $option{dau_standard_messages} = Irssi::settings_get_str('dau_standard_messages'); $option{dau_standard_options} = Irssi::settings_get_str('dau_standard_options'); $option{dau_words_range} = Irssi::settings_get_str('dau_words_range'); } sub signal_handling { set_settings(); # complete word if ($option{dau_tab_completion}) { if ($misc{signals}{'complete word'} != 1) { Irssi::signal_add_last('complete word', 'signal_complete_word'); } $misc{signals}{'complete word'} = 1; } else { if ($misc{signals}{'complete word'} != 0) { Irssi::signal_remove('complete word', 'signal_complete_word'); } $misc{signals}{'complete word'} = 0; } # event privmsg if ($option{dau_remote_permissions} =~ /^1[01][01][01][01][01]$/) { if ($misc{signals}{'event privmsg'} != 1) { Irssi::signal_add_last('event privmsg', 'signal_event_privmsg'); } $misc{signals}{'event privmsg'} = 1; } else { if ($misc{signals}{'event privmsg'} != 0) { Irssi::signal_remove('event privmsg', 'signal_event_privmsg'); } $misc{signals}{'event privmsg'} = 0; } # nick mode changed if ($option{dau_remote_permissions} =~ /^[01]1[01][01][01][01]$/ || $option{dau_remote_permissions} =~ /^[01][01]1[01][01][01]$/ || $option{dau_remote_permissions} =~ /^[01][01][01]1[01][01]$/ || $option{dau_remote_permissions} =~ /^[01][01][01][01]1[01]$/) { if ($misc{signals}{'nick mode changed'} != 1) { Irssi::signal_add_last('nick mode changed', 'signal_nick_mode_changed'); } $misc{signals}{'nick mode changed'} = 1; } else { if ($misc{signals}{'nick mode changed'} != 0) { Irssi::signal_remove('nick mode changed', 'signal_nick_mode_changed'); } $misc{signals}{'nick mode changed'} = 0; } # send text my $mark = 0; foreach my $server (keys %{ $misc{daumode_active} }) { foreach my $channel (keys %{ $misc{daumode_active}{$server} }) { if ($misc{daumode_active}{$server}{$channel} == 1) { $mark = 1; } } } if ($mark) { if ($misc{signals}{'send text'} != 1) { Irssi::signal_add_first('send text', 'signal_send_text'); } $misc{signals}{'send text'} = 1; } else { if ($misc{signals}{'send text'} != 0) { Irssi::signal_remove('send text', 'signal_send_text'); } $misc{signals}{'send text'} = 0; } } ################################################################################ # Debugging ################################################################################ #BEGIN { # use warnings; # # open(STDERR, ">> dau-stderr") or print "STDERR redirect failed: $!"; #}