################################################################################ # $Id: dau.pl 273 2008-02-03 15:27:25Z heidinger $ ################################################################################ # # dau.pl - write like an idiot # ################################################################################ # Author ################################################################################ # # Clemens Heidinger # ################################################################################ # Changelog ################################################################################ # # dau.pl has a built-in changelog (--changelog switch) # ################################################################################ # Credits ################################################################################ # # - Robert Hennig: For the original dau shell script. Out of this script, # merged with some other small Perl and shell scripts and aliases arised the # first version of dau.pl for irssi. # ################################################################################ # Documentation ################################################################################ # # dau.pl has a built-in documentation (--help switch) # ################################################################################ # License ################################################################################ # # Licensed under the BSD license # ################################################################################ # Website ################################################################################ # # http://dau.pl/ # # Additional information, DAU.pm, the dauomat and the dauproxy # ################################################################################ use 5.6.0; use File::Basename; use File::Path; use IPC::Open3; use Irssi 20021107.0841; use Irssi::TextUI; use locale; use POSIX; use re 'eval'; use strict; use Tie::File; use vars qw($VERSION %IRSSI); $VERSION = '2.4.3'; #$VERSION = '2.4.3 SVN ($LastChangedRevision: 273 $)'; %IRSSI = ( authors => 'Clemens Heidinger', changed => '$LastChangedDate: 2008-02-03 16:27:25 +0100 (Sun, 03 Feb 2008) $', commands => 'dau', contact => 'heidinger@dau.pl', description => 'write like an idiot', license => 'BSD', modules => 'File::Basename File::Path IPC::Open3 POSIX Tie::File', name => 'DAU', sbitems => 'daumode', url => 'http://dau.pl/', ); ################################################################################ # Register commands ################################################################################ Irssi::command_bind('dau', \&command_dau); ################################################################################ # Register settings # setting changed/added => change/add it here ################################################################################ # boolean Irssi::settings_add_bool('misc', 'dau_away_quote_reason', 1); Irssi::settings_add_bool('misc', 'dau_away_reminder', 0); Irssi::settings_add_bool('misc', 'dau_babble_verbose', 1); Irssi::settings_add_bool('misc', 'dau_color_choose_colors_randomly', 1); Irssi::settings_add_bool('misc', 'dau_cowsay_print_cow', 0); Irssi::settings_add_bool('misc', 'dau_figlet_print_font', 0); Irssi::settings_add_bool('misc', 'dau_silence', 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_babble_history_size', 10); Irssi::settings_add_int('misc', 'dau_babble_verbose_minimum_lines', 2); Irssi::settings_add_int('misc', 'dau_cool_maximum_line', 2); Irssi::settings_add_int('misc', 'dau_cool_probability_eol', 20); Irssi::settings_add_int('misc', 'dau_cool_probability_word', 20); Irssi::settings_add_int('misc', 'dau_remote_babble_interval_accuracy', 90); # String Irssi::settings_add_str('misc', 'dau_away_away_text', '$N is away now: [ $reason ]. Away since: $Z. I am currently not available at $T @ $chatnet (sry 4 amsg)!'); Irssi::settings_add_str('misc', 'dau_away_back_text', '$N is back: [ $reason ]. Away time: [ $time ]. I am available again at $T @ $chatnet (sry 4 amsg)!'); Irssi::settings_add_str('misc', 'dau_away_options', "--parse_special --bracket -left '!---?[' -right ']?---!' --color -split capitals -random off -codes 'light red; yellow'," . "--parse_special --bracket -left '--==||{{' -right '}}||==--' --color -split capitals -random off -codes 'light red; light cyan'," . "--parse_special --bracket -left '--==||[[' -right ']]||==--' --color -split capitals -random off -codes 'yellow; light green'" ); Irssi::settings_add_str('misc', 'dau_away_reminder_interval', '1 hour'); Irssi::settings_add_str('misc', 'dau_away_reminder_text', '$N is still away: [ $reason ]. Away time: [ $time ] (sry 4 amsg)'); Irssi::settings_add_str('misc', 'dau_babble_options_line_by_line', '--nothing'); Irssi::settings_add_str('misc', 'dau_babble_options_preprocessing', ''); Irssi::settings_add_str('misc', 'dau_color_codes', 'blue; green; red; magenta; yellow; cyan'); Irssi::settings_add_str('misc', 'dau_cool_eol_style', 'random'); Irssi::settings_add_str('misc', 'dau_cowsay_cowlist', ''); Irssi::settings_add_str('misc', 'dau_cowsay_cowpath', &def_dau_cowsay_cowpath); Irssi::settings_add_str('misc', 'dau_cowsay_cowpolicy', 'allow'); Irssi::settings_add_str('misc', 'dau_cowsay_cowsay_path', &def_dau_cowsay_cowsay_path); Irssi::settings_add_str('misc', 'dau_cowsay_cowthink_path', &def_dau_cowsay_cowthink_path); Irssi::settings_add_str('misc', 'dau_daumode_channels', ''); 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_away', '.away'); Irssi::settings_add_str('misc', 'dau_files_babble_messages', 'babble_messages'); Irssi::settings_add_str('misc', 'dau_files_cool_suffixes', 'cool_suffixes'); Irssi::settings_add_str('misc', 'dau_files_root_directory', "$ENV{HOME}/.dau"); Irssi::settings_add_str('misc', 'dau_files_substitute', 'substitute.pl'); Irssi::settings_add_str('misc', 'dau_language', 'en'); Irssi::settings_add_str('misc', 'dau_moron_eol_style', 'random'); Irssi::settings_add_str('misc', 'dau_parse_special_list_delimiter', ' '); Irssi::settings_add_str('misc', 'dau_random_options', '--substitute --boxes --uppercase,' . "--substitute --color -split capitals -random off -codes 'light red; yellow'," . "--substitute --color -split capitals -random off -codes 'light red; light cyan'," . "--substitute --color -split capitals -random off -codes 'yellow; light green'," . '--substitute --color --uppercase,' . '--substitute --cool,' . '--substitute --delimiter,' . '--substitute --dots --moron,' . '--substitute --leet,' . '--substitute --mix,' . '--substitute --mixedcase --bracket,' . '--substitute --moron --stutter --uppercase,' . '--substitute --moron -omega on,' . '--substitute --moron,' . '--substitute --uppercase --underline,' . '--substitute --words --mixedcase' ); Irssi::settings_add_str('misc', 'dau_remote_babble_channellist', ''); Irssi::settings_add_str('misc', 'dau_remote_babble_channelpolicy', 'deny'); Irssi::settings_add_str('misc', 'dau_remote_babble_interval', '1 hour'); 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_regexp', '%%%DISABLED%%%'); Irssi::settings_add_str('misc', 'dau_remote_question_reply', 'EDIT_THIS_ONE'); 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); Irssi::signal_add_last('window changed' => sub { Irssi::statusbar_items_redraw('daumode') }); Irssi::signal_add_last('window item changed' => sub { Irssi::statusbar_items_redraw('daumode') }); ################################################################################ # Register statusbar items ################################################################################ Irssi::statusbar_item_register('daumode', '', 'statusbar_daumode'); ################################################################################ # Global variables ################################################################################ # Timer used by --away our %away_timer; # babble our %babble; # --command -in our $command_in; # The command to use for the output (MSG f.e.) our $command_out; # '--command -out' used? our $command_out_activated; # Counter for the subroutines entered our $counter_subroutines; # Counter for the switches # --me --moron: --me would be 0, --moron 1 our $counter_switches; # daumode our %daumode; # daumode activated? our $daumode_activated; # Help text our %help; $help{options} = < 0, 'daumode in' => 0, 'event 404' => 0, 'event privmsg' => 0, 'nick mode changed' => 0, 'send text' => 0, ); # All switches that may be given at commandline our %switches = ( # These switches may be combined combo => { boxes => { 'sub' => \&switch_boxes }, bracket => { 'sub' => \&switch_bracket, left => { '*' => 1 }, right => { '*' => 1 }, }, chars => { 'sub' => \&switch_chars }, color => { 'sub' => \&switch_color, codes => { '*' => 1 }, random => { off => 1, on => 1, }, 'split' => { capitals => 1, chars => 1, lines => 1, paragraph => 1, rchars => 1, words => 1, }, }, command => { 'sub' => \&switch_command, in => { '*' => 1 }, out => { '*' => 1 }, }, cool => { 'sub' => \&switch_cool, eol_style => { suffixes => 1, exclamation_marks => 1, random => 1, }, max => { '*' => 1 }, prob_eol => { '*' => 1 }, prob_word => { '*' => 1 }, }, cowsay => { 'sub' => \&switch_cowsay, arguments => { '*' => 1 }, think => { off => 1, on => 1, }, }, delimiter => { 'sub' => \&switch_delimiter, string => { '*' => 1 }, }, dots => { 'sub' => \&switch_dots }, figlet => { 'sub' => \&switch_figlet }, me => { 'sub' => \&switch_me }, mix => { 'sub' => \&switch_mix }, moron => { 'sub' => \&switch_moron, eol_style => { nothing => 1, random => 1, }, level => { '*' => 1 }, omega => { off => 1, on => 1, }, typo => { off => 1, on => 1, }, uppercase => { off => 1, on => 1, }, }, leet => { 'sub' => \&switch_leet }, mixedcase => { 'sub' => \&switch_mixedcase }, nothing => { 'sub' => \&switch_nothing }, parse_special => { 'sub' => \&switch_parse_special, irssi_variables => { off => 1, on => 1, }, list_delimiter => { '*' => 1 }, }, 'reverse' => { 'sub' => \&switch_reverse }, stutter => { 'sub' => \&switch_stutter }, substitute => { 'sub' => \&switch_substitute }, underline => { 'sub' => \&switch_underline }, uppercase => { 'sub' => \&switch_uppercase }, words => { 'sub' => \&switch_words }, }, # The following switches must not be combined nocombo => { away => { 'sub' => \&switch_away, channels => { '*' => 1 }, interval => { '*' => 1 }, reminder => { on => 1, off => 1, }, }, babble => { 'sub' => \&switch_babble, at => { '*' => 1 }, cancel => { on => 1, off => 1, }, filter => { '*' => 1 }, history_size => { '*' => 1 }, }, changelog => { 'sub' => \&switch_changelog }, create_files => { 'sub' => \&switch_create_files }, daumode => { 'sub' => \&switch_daumode, modes_in => { '*' => 1 }, modes_out => { '*' => 1 }, perm => { '00' => 1, '01' => 1, '10' => 1, '11' => 1, }, }, help => { 'sub' => \&switch_help, # setting changed/added => change/add it here setting => { # boolean dau_away_quote_reason => 1, dau_away_reminder => 1, dau_babble_verbose => 1, dau_color_choose_colors_randomly => 1, dau_cowsay_print_cow => 1, dau_figlet_print_font => 1, dau_silence => 1, dau_statusbar_daumode_hide_when_off => 1, dau_tab_completion => 1, # Integer dau_babble_history_size => 1, dau_babble_verbose_minimum_lines => 1, dau_cool_maximum_line => 1, dau_cool_probability_eol => 1, dau_cool_probability_word => 1, dau_remote_babble_interval_accuracy => 1, # String dau_away_away_text => 1, dau_away_back_text => 1, dau_away_options => 1, dau_away_reminder_interval => 1, dau_away_reminder_text => 1, dau_babble_options_line_by_line => 1, dau_babble_options_preprocessing => 1, dau_color_codes => 1, dau_cool_eol_style => 1, dau_cowsay_cowlist => 1, dau_cowsay_cowpath => 1, dau_cowsay_cowpolicy => 1, dau_cowsay_cowsay_path => 1, dau_cowsay_cowthink_path => 1, dau_daumode_channels => 1, dau_delimiter_string => 1, dau_figlet_fontlist => 1, dau_figlet_fontpath => 1, dau_figlet_fontpolicy => 1, dau_figlet_path => 1, dau_files_away => 1, dau_files_babble_messages => 1, dau_files_cool_suffixes => 1, dau_files_root_directory => 1, dau_files_substitute => 1, dau_language => 1, dau_moron_eol_style => 1, dau_parse_special_list_delimiter => 1, dau_random_options => 1, dau_remote_babble_channellist => 1, dau_remote_babble_channelpolicy => 1, dau_remote_babble_interval => 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_regexp => 1, dau_remote_question_reply => 1, dau_remote_voice_reply => 1, dau_standard_messages => 1, dau_standard_options => 1, dau_words_range => 1, }, }, long_help => { 'sub' => \&switch_long_help }, random => { 'sub' => \&switch_random, verbose => { off => 1, on => 1, }, }, }, ); ################################################################################ # Code run once at start ################################################################################ print CLIENTCRAP "dau.pl $VERSION loaded. For help type %9${k}dau --help%9 or %9${k}dau --long_help%9"; signal_setup_changed(); build_nick_mode_struct(); signal_handling(); ################################################################################ # Subroutines (commands) ################################################################################ sub command_dau { my ($data, $server, $witem) = @_; my $output; $output = parse_text($data, $witem); unless (defined($server) && $server && $server->{connected}) { $print_message = 1; } unless ((defined($witem) && $witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY'))) { $print_message = 1; } if ($daumode_activated) { if (defined($witem) && $witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) { my $modes_set = 0; # daumode set with parameters (modes_in) if ($queue{0}{daumode}{modes_in}) { $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1; $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = $queue{0}{daumode}{modes_in}; $modes_set = 1; } # daumode set with parameters (modes_out) if ($queue{0}{daumode}{modes_out}) { $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1; $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = $queue{0}{daumode}{modes_out}; $modes_set = 1; } # daumode set without parameters if (!$daumode{channels_in}{$server->{tag}}{$witem->{name}} && !$daumode{channels_out}{$server->{tag}}{$witem->{name}} && !$modes_set) { $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1; $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1; $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = ''; $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = ''; } # daumode unset elsif (($daumode{channels_in}{$server->{tag}}{$witem->{name}} || $daumode{channels_out}{$server->{tag}}{$witem->{name}}) && !$modes_set) { $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 0; $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 0; $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = ''; $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = ''; } # the perm-option overrides everything # perm: 00 if ($queue{0}{daumode}{perm} eq '00') { $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 0; $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 0; $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = ''; $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = ''; } # perm: 01 if ($queue{0}{daumode}{perm} eq '01') { $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 0; $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1; $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} = ''; } # perm: 10 if ($queue{0}{daumode}{perm} eq '10') { $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1; $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 0; $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} = ''; } # perm: 11 if ($queue{0}{daumode}{perm} eq '11') { $daumode{channels_in}{$server->{tag}}{$witem->{name}} = 1; $daumode{channels_out}{$server->{tag}}{$witem->{name}} = 1; } 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_away { my ($reason, $channel_rec, $reminder, $interval) = @_; my $output; my $time; my $status = 'away'; ################################################################################ ################################################################################ # Get and handle options ################################################################################ ################################################################################ ################################################################################ # "/dau --away -interval " resp. dau_away_reminder_interval setting ################################################################################ # If called from command line, i.e. not by the # "/dau --away -channels ''" workaround, $interval will be defined # here if (!defined($interval)) { $interval = time_parse(return_option('away', 'interval', $option{dau_away_reminder_interval})); } if ($interval < 10 || $interval > 1000000000) { print_err('Invalid value for away timer!'); return; } ################################################################################ # setting dau_away_options ################################################################################ my $options = return_random_list_item($option{dau_away_options}); ################################################################################ # "/dau --away -reminder " resp. dau_away_reminder setting ################################################################################ # If called from command line, i.e. not by "/dau --away -channels ''" # workaround, $reminder will be defined here if (!defined($reminder)) { $reminder = return_option('away', 'reminder', $option{dau_away_reminder}); } # on -> 1, off -> 0 if ($reminder eq 'on' || $reminder == 1) { $reminder = 1; } else { $reminder = 0; } ################################################################################ # "/dau --away -channels ''" ################################################################################ # Go through all channels and for each call this subroutine again with # $reminder and $interval as additional parameter as those otherwise would be # lost. Sad world. my $channels = return_option('away', 'channels'); # If not deleted, the program may loop here. undef($queue{0}{away}{channels}); while ($channels =~ m{([^/]+)/([^,]+),?\s*}g) { my $channel = $1; my $network = $2; my $server_rec = Irssi::server_find_tag($network); my $channel_rec = $server_rec->channel_find($channel); if (defined($channel_rec) && $channel_rec && ($channel_rec->{type} eq 'CHANNEL' || $channel_rec->{type} eq 'QUERY')) { switch_away($reason, $channel_rec, $reminder, $interval); } } # "/dau --away -channels ''" first run => exit return if ($channels); ################################################################################ # Now we are clear (from -channels)... ################################################################################ # Normal "/dau --away" (i.e. no -channels), but called from non # channel/query window => exit unless (defined($channel_rec) && $channel_rec && ($channel_rec->{type} eq 'CHANNEL' || $channel_rec->{type} eq 'QUERY')) { return; } my $channel = $channel_rec->{name}; my $network = $channel_rec->{server}->{tag}; my $id = "$channel/$network"; ################################################################################ # Open file ################################################################################ my $file = "$option{dau_files_root_directory}/$option{dau_files_away}"; my @file; unless (tie(@file, 'Tie::File', $file)) { print_err("Cannot tie $file!"); return; } ################################################################################ # Go through/edit file ################################################################################ # Format: # channel | network | time | options | reminder | interval | reason my $i = 0; foreach my $line (@file) { if ($line =~ m{^\Q$channel\E\x02\Q$network\E\x02(\d+)\x02([^\x02]*)\x02(?:\d)\x02(?:\d+)\x02(.*)}) { $time = $1; $options = $2; $reason = $3; $status = 'back'; last; } $i++; } if ($status eq 'away' && $reason eq '') { print_out('Please set reason for your being away!'); return; } if ($status eq 'away') { push(@file, "$channel\x02$network\x02" . time . "\x02$options\x02$reminder\x02$interval\x02$reason"); $output = $option{dau_away_away_text}; } if ($status eq 'back') { splice(@file, $i, 1); $output = $option{dau_away_back_text}; } ################################################################################ # Special variables ################################################################################ # $time if ($status eq 'back') { my $difference = time_diff_verbose(time, $time); $output =~ s/\$time/$difference/g; } # $reason if ($option{dau_away_quote_reason}) { $reason =~ s/\\/\\\\/g; $reason =~ s/\$/\\\$/g; } $output =~ s/\$reason/$reason/g; ################################################################################ # Write changes back to file ################################################################################ untie(@file); ################################################################################ # The reminder timer ################################################################################ if ($status eq 'away' && $reminder) { $away_timer{$id} = Irssi::timeout_add($interval, \&timer_away_reminder, $id); } else { Irssi::timeout_remove($away_timer{$id}); } ################################################################################ # Print message to channel ################################################################################ $output = parse_text("$options $output", $channel_rec); output_text($channel_rec, $channel_rec->{name}, $output); return; } sub switch_babble { my ($data, $channel) = @_; my $text; # Cancel babble? if (lc(return_option('babble', 'cancel')) eq 'on') { if (defined($babble{timer_writing})) { Irssi::timeout_remove($babble{timer_writing}); undef($babble{timer_writing}); if ($babble{remote}) { timer_remote_babble_reset(); } print_out("Babble cancelled."); } return; } # Filters my @filter = (); my $option_babble_at = return_option('babble', 'at'); my $option_babble_filter = return_option('babble', 'filter'); my $option_babble_history_size = return_option('babble', 'history_size', $option{dau_babble_history_size}); if ($option_babble_filter) { push(@filter, $option_babble_filter); } # If something is babbling right now, exit if (defined($babble{timer_writing})) { print_err("You are already babbling something!"); return; } # get text from file if ($option_babble_at) { my @nicks; foreach my $nick (split(/\s*,\s*/, $option_babble_at)) { push(@nicks, $nick); } if (@nicks > 0) { for (my $i = 1; $i <= $#nicks + 1; $i++) { push(@filter, '\$nick' . $i); } } $text = &babble_get_text($channel, \@filter, \@nicks, $option_babble_history_size); } else { $text = &babble_get_text($channel, \@filter, undef, $option_babble_history_size); } # babble only in channels unless (defined($channel) && $channel && $channel->{type} eq 'CHANNEL') { print_out('%9--babble%9 will only work in channel windows!'); return; } # Start the babbling babble_start($channel, $text, 0); return; } sub switch_changelog { my $output; $print_message = 1; $output = &fix(<<" END"); CHANGELOG 2002-05-05 release 0.1.0 initial release 2002-05-06 release 0.1.1 maintenance release 2002-05-11 release 0.2.0 new feature: %9--delimiter%9 2002-05-12 release 0.3.0 new feature: %9--mixedcase%9 2002-05-17 release 0.4.0 %9--delimiter%9 revised 2002-05-20 release 0.4.1 some nice new substitutions for %9--moron%9 2002-05-24 release 0.5.0 new settings for %9--figlet%9 2002-06-15 release 0.6.0 new settings for %9--figlet%9 2002-06-16 release 0.6.1 maintenance release 2002-06-16 release 0.6.2 maintenance release 2002-06-17 release 0.7.0 new stuff for %9--moron%9 2002-06-19 release 0.8.0 new feature: %9--dots%9 2002-06-23 release 0.9.0 new "reply to question" remote feature 2002-06-23 release 0.9.1 maintenance release 2002-06-29 release 0.9.2 maintenance release 2002-07-23 release 0.9.3 maintenance release 2002-07-28 release 1.0.0 - Tabcompletion for the switches - new feature: %9--changelog%9 - new feature: %9--help%9 - new feature: %9--leet%9 - new feature: %9--reverse%9 2002-07-28 release 1.0.1 maintenance release 2002-09-01 release 1.0.2 maintenance release 2002-09-03 release 1.0.3 new switch for %9--figlet%9: %9-font%9 2002-09-03 release 1.0.4 maintenance release 2002-09-03 release 1.0.5 maintenance release 2002-09-09 release 1.1.0 You can combine switches now! 2002-11-22 release 1.2.0 - new setting: %9dau_moron_eol_style%9 - new setting: %9dau_standard_messages%9 - new setting: %9dau_standard_options%9 - new remote features: Say something on (de)op/(de)voice - new switch for %9--delimiter%9: %9-string%9 - new switch for %9--moron%9: %9-eol_style%9 - new feature: %9--color%9 - new feature: %9--daumode%9 - new feature: %9--random%9 - new feature: %9--stutter%9 - new feature: %9--uppercase%9 - new statusbar item: %9daumode%9 2002-11-27 release 1.2.1 maintenance release 2002-12-15 release 1.2.2 maintenance release 2003-01-12 release 1.3.0 - new setting: %9dau_files_root_directory%9 - %9--moron%9: randomly transpose letters with letters next to them at the keyboard - new switch for %9--moron%9: %9-uppercase%9 - new feature: %9--create_files%9 2003-01-17 release 1.4.0 - %9--color%9 revised - new remote feature: babble 2003-01-18 release 1.4.1 maintenance release 2003-01-20 release 1.4.2 new setting: %9dau_statusbar_daumode_hide_when_off%9 2003-02-01 release 1.4.3 maintenance release 2003-02-09 release 1.4.4 maintenance release 2003-02-16 release 1.4.5 maintenance release 2003-03-16 release 1.4.6 maintenance release 2003-05-01 release 1.5.0 - new setting: %9dau_tab_completion%9 - new feature: %9--bracket%9 2003-06-13 release 1.5.1 new feature: %9--underline%9 2003-07-16 release 1.5.2 new feature: %9--boxes%9 2003-08-16 release 1.5.3 maintenance release 2003-09-14 release 1.5.4 maintenance release 2003-11-16 release 1.6.0 - Incoming messages can be dauified now! - daumode statusbar item revised 2004-03-25 release 1.7.0 - new setting: %9dau_babble_options_line_by_line%9 - new setting: %9dau_files_babble_messages%9 - new switch for %9--color%9: %9-split paragraph%9 - new switch for %9--command%9: %9-in%9 - new switch for %9--moron%9: %9-omega%9 - new feature: %9--cowsay%9 - new feature: %9--mix%9 (by Martin Kihlgren ) 2004-04-01 release 1.7.1 - new setting: %9dau_remote_babble_channellist%9 - new setting: %9dau_remote_babble_channelpolicy%9 - new setting: %9dau_remote_babble_interval_accuracy%9 2004-04-02 release 1.7.2 maintenance release 2004-04-05 release 1.7.3 maintenance release 2004-05-01 release 1.8.0 - new feature: %9--babble%9 - %9--help%9 revised 2004-06-24 release 1.8.1 - new setting: %9dau_babble_verbose%9 - new setting: %9dau_babble_verbose_minimum_lines%9 2004-07-10 release 1.8.2 maintenance release 2004-07-25 release 1.8.3 maintenance release 2004-09-14 release 1.8.4 maintenance release 2004-10-18 release 1.8.5 maintenance release 2004-11-07 release 1.8.6 maintenance release 2005-01-28 release 1.9.0 - new setting: %9dau_cowsay_cowthink_path%9 - new switch for %9--cowsay%9: %9-arguments%9 - new switch for %9--cowsay%9: %9-think%9 2005-06-05 release 2.0.0 - new setting: %9dau_color_choose_colors_randomly%9 - new setting: %9dau_color_codes%9 - new setting: %9dau_language%9 - new setting: %9dau_remote_question_regexp%9 - new switch for %9--bracket%9: %9-left%9 - new switch for %9--bracket%9: %9-right%9 - new switch for %9--color%9: %9-codes%9 - new switch for %9--color%9: %9-random%9 - new switch for %9--color%9: %9-split capitals%9 - new feature: %9--away%9 - new feature: %9--cool%9 - new feature: %9--long_help%9 - new feature: %9--parse_special%9 2005-07-01 release 2.1.0 - new switch for %9--babble%9: %9-at%9 - %9--color%9: Support for background colors - %9--color -codes%9: You may use now the color names instead of the numeric color codes 2005-07-24 release 2.1.1 maintenance release 2005-08-02 release 2.1.2 maintenance release 2005-11-01 release 2.1.3 maintenance release 2006-03-11 release 2.1.4 maintenance release 2006-05-21 release 2.1.5 new switch for %9--babble%9: %9-filter%9 2006-10-25 release 2.1.6 new switch for %9--babble%9: %9-cancel%9 2006-11-25 release 2.2.0 new feature: %9--substitute%9 2007-03-07 release 2.3.0 - new setting: %9dau_daumode_channels%9 - new switch for %9--moron%9: %9-level%9 - new switch for %9--moron%9: %9-typo%9 - new switch for %9--random%9: %9-verbose%9 2007-03-08 release 2.3.1 maintenance release 2007-03-11 release 2.3.2 maintenance release 2007-03-18 release 2.3.3 maintenance release 2007-06-02 release 2.4.0 - new setting: %9dau_babble_history_size%9 - new switch for %9--babble%9: %9-history_size%9 2007-06-26 release 2.4.1 maintenance release 2007-10-11 release 2.4.2 maintenance release 2008-02-03 release 2.4.3 maintenance release 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_substitute if not found my $file1 = "$option{dau_files_root_directory}/$option{dau_files_substitute}"; 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://dau.pl/ # # 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: $!"); } } # create file dau_files_babble_messages if not found my $file2 = "$option{dau_files_root_directory}/$option{dau_files_babble_messages}"; if (-e $file2) { print_out("file $file2 already exists - no need to create it"); } else { if (open(FH1, ">", $file2)) { print FH1 &fix(<<' END'); END print_out("$file2 created. you should edit it now!"); } else { print_err("cannot write $file2: $!"); } if (!close(FH1)) { print_err("cannot close $file2: $!"); } } # create file dau_files_cool_suffixes if not found my $file3 = "$option{dau_files_root_directory}/$option{dau_files_cool_suffixes}"; if (-e $file3) { print_out("file $file3 already exists - no need to create it"); } else { if (open(FH1, ">", $file3)) { print FH1 &fix(<<' END'); END print_out("$file3 created. you should edit it now!"); } else { print_err("cannot write $file3: $!"); } if (!close(FH1)) { print_err("cannot close $file3: $!"); } } return; } sub switch_daumode { $daumode_activated = 1; } sub switch_help { my $output; my $option_setting = return_option('help', 'setting'); $print_message = 1; if ($option_setting eq '') { $output = &fix(<<" END"); %9OPTIONS%9 $help{options} END } # setting changed/added => change/add them below # boolean elsif ($option_setting eq 'dau_away_quote_reason') { $output = &fix(<<" END"); %9dau_away_quote_reason%9 %Ubool If turned on, %9--parse_special%9 will not be able to replace variables which probably aren't one anyway. END } elsif ($option_setting eq 'dau_away_reminder') { $output = &fix(<<" END"); %9dau_away_reminder%9 %Ubool Turn the reminder message of %9--away%9 on or off. END } elsif ($option_setting eq 'dau_babble_verbose') { $output = &fix(<<" END"); %9dau_babble_verbose%9 %Ubool Before babbling print a message how many lines will be babbled and when finished a notification message. END } elsif ($option_setting eq 'dau_color_choose_colors_randomly') { $output = &fix(<<" END"); %9dau_color_choose_colors_randomly%9 %Ubool Choose colors randomly from setting dau_color_codes resp. %9--color -codes%9 or take one by one in the exact order given. END } elsif ($option_setting eq 'dau_cowsay_print_cow') { $output = &fix(<<" END"); %9dau_cowsay_print_cow%9 %Ubool Print a message which cow will be used. END } 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_silence') { $output = &fix(<<" END"); %9dau_silence%9 %Ubool Don't print any information message. This does not include error messages. 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_babble_history_size') { $output = &fix(<<" END"); %9dau_babble_history_size%9 %Uinteger Number of lines to store in the babble history. dau.pl will babble no line the history is holding. END } elsif ($option_setting eq 'dau_babble_verbose_minimum_lines') { $output = &fix(<<" END"); %9dau_babble_verbose_minimum_lines%9 %Uinteger Minimum lines necessary to produce the output of the verbose information. END } elsif ($option_setting eq 'dau_cool_maximum_line') { $output = &fix(<<" END"); %9dau_cool_maximum_line%9 %Uinteger Trademarke[tm] or do \$this only %Un%U words per line tops. END } elsif ($option_setting eq 'dau_cool_probability_eol') { $output = &fix(<<" END"); %9dau_cool_probability_eol%9 %Uinteger Probability that "!!!11one" or something like that will be put at EOL. Set it to 100 and every line will be. Set it to 0 and no line will be. END } elsif ($option_setting eq 'dau_cool_probability_word') { $output = &fix(<<" END"); %9dau_cool_probability_word%9 %Uinteger Probability that a word will be trademarked[tm]. Set it to 100 and every word will be. Set it to 0 and no word will be. END } elsif ($option_setting eq 'dau_remote_babble_interval_accuracy') { $output = &fix(<<" END"); %9dau_remote_babble_interval_accuracy%9 %Uinteger Value expressed as a percentage how accurate the timer of the babble feature should be. Legal values: 1-100 %U100%U would result in a very accurate timer. END } # String elsif ($option_setting eq 'dau_away_away_text') { $output = &fix(<<" END"); %9dau_away_away_text%9 %Ustring The text to say when using %9--away%9. Special Variables: \$reason: Your away reason. END } elsif ($option_setting eq 'dau_away_back_text') { $output = &fix(<<" END"); %9dau_away_back_text%9 %Ustring The text to say when you return. Special Variables: \$reason: Your away reason. \$time: The time you've been away. END } elsif ($option_setting eq 'dau_away_reminder_interval') { $output = &fix(<<" END"); %9dau_away_reminder_interval%9 %Ustring Remind the channel that you're away! Repeat the message in the given interval. END } elsif ($option_setting eq 'dau_away_reminder_text') { $output = &fix(<<" END"); %9dau_away_reminder_text%9 %Ustring The text to say when you remind the channel that you're away. Special Variables: \$reason: Your away reason. \$time: The time you've been away. END } elsif ($option_setting eq 'dau_away_options') { $output = &fix(<<" END"); %9dau_away_options%9 %Ustring Options %9--away%9 will use. END } elsif ($option_setting eq 'dau_babble_options_line_by_line') { $output = &fix(<<" END"); %9dau_babble_options_line_by_line%9 %Ustring One single babble may contain several lines. The options specified in this setting are used for every line. END } elsif ($option_setting eq 'dau_babble_options_preprocessing') { $output = &fix(<<" END"); %9dau_babble_options_preprocessing%9 %Ustring The options specified in this setting are applied to the whole babble before anything else. Later, the options of the setting %9dau_babble_options_line_by_line%9 are applied to every line of the babble. END } elsif ($option_setting eq 'dau_color_codes') { $output = &fix(<<" END"); %9dau_color_codes%9 %Ustring Specify the color codes to use, seperated by semicolons. Example: %Ugreen; red; blue%U. You may use the color code (one or two digits) or the color names. So either %U2%U or %Ublue%U is ok. You can set a background color too: %Ured,green%U and you will write with red on a green background. For a complete list of the color codes and names look at formats.txt in the irssi documentation. END } elsif ($option_setting eq 'dau_cool_eol_style') { $output = &fix(<<" END"); %9dau_cool_eol_style%9 %Ustring %Uexclamation_marks%U: !!!11one %Urandom%U: Choose one style randomly %Usuffixes%U: Suffixes from file END } elsif ($option_setting eq 'dau_cowsay_cowlist') { $output = &fix(<<" END"); %9dau_cowsay_cowlist%9 %Ustring Comma separated list of cows. Checkout %9${k}dau --help -setting dau_cowsay_cowpolicy%9 to see what this setting is good for. END } elsif ($option_setting eq 'dau_cowsay_cowpath') { $output = &fix(<<" END"); %9dau_cowsay_cowpath%9 %Ustring Path to the cowsay-cows (*.cow). END } elsif ($option_setting eq 'dau_cowsay_cowpolicy') { $output = &fix(<<" END"); %9dau_cowsay_cowpolicy%9 %Ustring Specifies the policy used to handle the cows in dau_cowsay_cowpath. If set to %Uallow%U, all cows available will be used by the command. You can exclude some cows by setting dau_cowsay_cowlist. If set to %Udeny%U, no cows but the ones listed in dau_cowsay_cowlist will be used by the command. Useful if you have many annoying cows in your cowpath and you want to permit only a few of them. END } elsif ($option_setting eq 'dau_cowsay_cowsay_path') { $output = &fix(<<" END"); %9dau_cowsay_cowsay_path%9 %Ustring Should point to the cowsay executable. END } elsif ($option_setting eq 'dau_cowsay_cowthink_path') { $output = &fix(<<" END"); %9dau_cowsay_cowthink_path%9 %Ustring Should point to the cowthink executable. END } elsif ($option_setting eq 'dau_daumode_channels') { $output = &fix(<<" END"); %9dau_daumode_channels%9 %U/:, ...%U Automatically enable the daumode for some channels. %U#foo/bar:-modes_out '--substitute'%U would automatically set the daumode on #foo in network bar to modify outgoing messages with --substitute. END } 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_away') { $output = &fix(<<" END"); %9dau_files_away%9 %Ustring The file with the away messages. _Must_ be in dau_files_root_directory. END } elsif ($option_setting eq 'dau_files_babble_messages') { $output = &fix(<<" END"); %9dau_files_babble_messages%9 %Ustring The file with the babble messages. _Must_ be in dau_files_root_directory. %9${k}dau --create_files%9 will create it. Format of the file: Newline separated plain text. The text will be sent through %9--parse_special%9 as well. END } elsif ($option_setting eq 'dau_files_cool_suffixes') { $output = &fix(<<" END"); %9dau_files_cool_suffixes%9 %Ustring %9--cool%9 takes randomly one line out of this file and puts it at the end of the line. This file _must_ be in dau_files_root_directory. %9${k}dau --create_files%9 will create it. Format of the file: Newline separated plain text. 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_files_substitute') { $output = &fix(<<" END"); %9dau_files_substitute%9 %Ustring Your own substitutions file. _Must_ be in dau_files_root_directory. %9${k}dau --create_files%9 will create it. END } elsif ($option_setting eq 'dau_language') { $output = &fix(<<" END"); %9dau_language%9 %Ustring %Ude%U: If you are writing in german %Uen%U: If you are writing in english 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? %Urandom%U: - !!!??!!!!!????!??????????!!!1 - = ? - ?¿? %Unothing%U: do nothing END } elsif ($option_setting eq 'dau_parse_special_list_delimiter') { $output = &fix(<<" END"); %9dau_parse_special_list_delimiter%9 %Ustring Set the list delimiter used for \@nicks and \@opnicks to %Ustring%U. 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_channellist') { $output = &fix(<<" END"); %9dau_remote_babble_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_babble_channelpolicy') { $output = &fix(<<" END"); %9dau_remote_babble_channelpolicy%9 %Ustring Using the default policy %Udeny%U the script won't do anything except in the channels listed in dau_remote_babble_channellist. Using the policy %Uallow%U the script will babble in all channels but the ones listed in dau_remote_babble_channellist. END } elsif ($option_setting eq 'dau_remote_babble_interval') { $output = &fix(<<" END"); %9dau_remote_babble_interval%9 %Ustring dau.pl will babble text in the given interval. 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: Reply to question 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_regexp') { $output = &fix(<<" END"); %9dau_remote_question_regexp%9 %Ustring If someone says something matching that regular expression, act accordingly. The regexp will be sent through %9--parse_special%9. Because of that you will have to escape some characters, f.e. \\s to \\\\s for whitespace. 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 of setting dau_remote_question_regexp (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_long_help { my $output; $print_message = 1; $output = &fix(<<" END"); %9SYNOPSIS%9 %9${k}dau [%Uoptions%U] [%Utext%U%9] %9DESCRIPTION%9 dau? What does that mean? It's a german acronym for %9d%9ümmster %9a%9nzunehmender %9u%9ser. In english: stupidest imaginable user. With dau.pl every person can write like an idiot on the IRC! %9OPTIONS%9 $help{options} %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 %9--uppercase%9, _then_ to %9--mixedcase%9. The order in which you put the options on the commandline is important! You can see what output a command produces without sending it to the active channel/query by sending it to a non-channel/query window. %9${k}dau --color --figlet %Ufoo bar baz%9 %9--color%9 is the first to be run and thus color codes will be inserted. The string will look like %U\\00302f\\00303o[...]%U when leaving %9--color%9. %9--figlet%9 uses then that string as its input. So you'll have finally an output like %U02f03o[...]%U in the figlet letters. You'll probably want to use %9--figlet --color%9 instead. %9SPECIAL FEATURES%9 %9Combine the options%9 You can combine most of the options! So you can write colored leet messages f.e.. Look in the EXAMPLES section above. %9Babble%9 dau.pl will babble text for you. It can do this on its own in certain intervals or forced by the user using %9--babble%9. Related settings: %9dau_babble_options_line_by_line%9 %9dau_files_babble_messages%9 %9dau_files_root_directory%9 %9dau_remote_babble_channellist%9 %9dau_remote_babble_channelpolicy%9 %9dau_remote_babble_interval%9 %9dau_remote_babble_interval_accuracy%9 %9dau_remote_permissions%9 Related switches: %9--babble%9 %9--create_files%9 %9Daumode%9 Dauify incoming and/or outgoing messages. There is a statusbar item available displaying the current status of the daumode. Add it with %9/statusbar add [-alignment ] daumode%9 You may customize the look of the statusbar item in the theme file: sb_daumode = "{sb daumode I: \$0 (\$1) O: \$2 (\$3)}"; # \$0: will incoming messages be dauified? # \$1: modes for incoming messages # \$2: will outgoing messages be dauified? # \$3: modes for outgoing messages %9Remote features%9 Don't worry, dau.pl won't do anything automatically unless you unlock these features! %9Babble%9 dau.pl will babble text for you in certain intervals. %9Reply to a question%9 Answer a question as a moron would. Related settings: %9dau_remote_channellist%9 %9dau_remote_channelpolicy%9 %9dau_remote_permissions%9 %9dau_remote_question_regexp%9 %9dau_remote_question_reply%9 %9Say something on (de)op/(de)voice%9 Related settings: %9dau_remote_channellist%9 %9dau_remote_channelpolicy%9 %9dau_remote_deop_reply%9 %9dau_remote_devoice_reply%9 %9dau_remote_op_reply%9 %9dau_remote_permissions%9 %9dau_remote_voice_reply%9 %9TAB Completion%9 There is a really clever TAB Completion included! Since commands can get very long you definitely want to use it. It will only complete syntactically correct commands so the TAB Completion isn't only a time saver, it's a control instance too. You'll be suprised to see that it even completes the figlet fonts and cows for cowsay that are available on your system. %9Website%9 $IRSSI{url}: Additional information, DAU.pm, the dauomat and the dauproxy. END return $output; } sub switch_random { my ($data, $channel_rec) = @_; my $output; my (@options, $opt, $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 $random_last } @options; $opt = @options[rand(@options)]; $random_last = $opt; } # Exact one item in @options - take that elsif (@options == 1) { $opt = $options[0]; $random_last = $opt; } # No item in @options - call switch_moron() else { $opt = '--moron'; } # dauify it! unless (lc(return_option('random', 'verbose')) eq 'off') { print_out("%9--random%9 has chosen %9$opt%9", $channel_rec); } $text .= $opt . ' ' . $data; $output = parse_text($text, $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 $option_left = return_option('bracket', 'left'); my $option_right = return_option('bracket', 'right'); 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 ($left, $right); if ($option_left && $option_right) { $left = $option_left; $right = $option_right; } else { $left = (keys(%brackets))[int(rand(keys(%brackets)))]; $right = $brackets{$left}; } $output = "$left $data $right"; 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, $channel_rec) = @_; # -out $command_out = return_option('command', 'out'); $command_out_activated = 1; # -in $command_in = ''; my $option_command_in = return_option('command', 'in'); if ($option_command_in) { return unless (defined($channel_rec) && $channel_rec); # Deactivate daumode for a brief moment $signal{'send text'} = 0; Irssi::signal_remove('send text', 'signal_send_text'); # Capture the output Irssi::signal_add_first('command msg', 'signal_command_msg'); $channel_rec->command("$option_command_in $data"); Irssi::signal_remove('command msg', 'signal_command_msg'); # Reactivate daumode signal_handling(); return $command_in; } return $data; } sub switch_color { my $data = shift; my (@all_colors, @colors, $output, $split); ################################################################################ # Hack to support UTF-8 ################################################################################ if (Irssi::settings_get_str('term_charset') =~ /utf-?8/i) { eval { require Encode; $data = Encode::decode("utf-8", $data); }; } ################################################################################ # Get options ################################################################################ my $option_color_split = return_option('color', 'split', 'words'); my $option_color_codes = return_option('color', 'codes', $option{dau_color_codes}); my $option_color_random = return_option('color', 'random', $option{dau_color_choose_colors_randomly}); if ($option_color_random eq 'on' || $option_color_random == 1) { $option_color_random = 1; } else { $option_color_random = 0; } ################################################################################ # color name -> color code ################################################################################ $option_color_codes =~ s/\blight green\b/09/gi; $option_color_codes =~ s/\bgreen\b/03/gi; $option_color_codes =~ s/\blight red\b/04/gi; $option_color_codes =~ s/\bred\b/05/gi; $option_color_codes =~ s/\blight cyan\b/11/gi; $option_color_codes =~ s/\bcyan\b/10/gi; $option_color_codes =~ s/\blight blue\b/12/gi; $option_color_codes =~ s/\bblue\b/02/gi; $option_color_codes =~ s/\blight magenta\b/13/gi; $option_color_codes =~ s/\bmagenta\b/06/gi; $option_color_codes =~ s/\blight grey\b/15/gi; $option_color_codes =~ s/\bgrey\b/14/gi; $option_color_codes =~ s/\bwhite\b/00/gi; $option_color_codes =~ s/\bblack\b/01/gi; $option_color_codes =~ s/\borange\b/07/gi; $option_color_codes =~ s/\byellow\b/08/gi; ################################################################################ # Produce @all_colors ################################################################################ # 5 shall be a colored 5 $option_color_codes =~ s/(\d+)/sprintf('%02d', $1)/eg; # Fill @all_colors and do error checking my @all_colors = split(/\s*;\s*/, $option_color_codes); foreach my $code (@all_colors) { if ($code !~ /^\d+(,\d+)?$/) { print_err("Incorrect color code '$code'!"); return $data; } } if (@all_colors == 0) { print_err('No color code found.'); return $data; } @colors = @all_colors; ################################################################################ # "-split capitals" ################################################################################ if ($option_color_split eq 'capitals') { $output = $data; my ($color1, $color2); if ($option_color_random) { $color1 = $colors[rand(@colors)]; @colors = grep { $_ ne $color1 } @colors unless (@colors == 1); $color2 = $colors[rand(@colors)]; } else { if (@colors == 1) { $color1 = $color2 = $colors[0]; } else { $color1 = $colors[0]; $color2 = $colors[1]; } } $output =~ s/([[:upper:][:punct:]]+|\b\S)/\003${color1}${1}\003${color2}/g; # Remove needless color codes $output =~ s/\003(?:$color1|$color2)( *)\003(?:$color1|$color2)/$1/g; $output =~ s/\003(?:$color1|$color2)$//; } ################################################################################ # Not "-split capitals" ################################################################################ else { 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); } elsif ($option_color_split eq 'paragraph') { $split = "\n"; } else { $split = '\s+'; } my $i = 0; my $background = 0; my $color; for (split /($split)/, $data) { if (/^\s*$/) { $output .= $_; next; } if ($option_color_random) { $color = $colors[rand(@colors)]; $output .= "\017" if ($background && $color !~ /,/); $output .= "\003" . $color . $_; if ($color =~ /,/) { $background = 1; } else { $background = 0; } if ($option_color_split eq 'paragraph') { @colors = ($color); } else { @colors = grep { $_ ne $color } @all_colors unless (@all_colors == 1); } } else { $color = $colors[($i++ % ($#colors + 1))]; if ($option_color_split eq 'paragraph') { $color = $colors[0]; } $output .= "\017" if ($background && $color !~ /,/); $output .= "\003" . $color . $_; if ($color =~ /,/) { $background = 1; } else { $background = 0; } } } } return $output; } sub switch_cool { my ($data, $channel) = @_; my $output; ################################################################################ # Get the options ################################################################################ my $option_eol_style = return_option('cool', 'eol_style', $option{dau_cool_eol_style}); my $option_max = return_option('cool', 'max', $option{dau_cool_maximum_line}); if (!defined($option_max) || int($option_max) < 0) { $option_max = INT_MAX; } my $option_prob_eol = return_option('cool', 'prob_eol', $option{dau_cool_probability_eol}); if (!defined($option_prob_eol) || int($option_prob_eol) < 0 || int($option_prob_eol) > 100) { $option_prob_eol = 20; } my $option_prob_word = return_option('cool', 'prob_word', $option{dau_cool_probability_word}); if (!defined($option_prob_word) || int($option_prob_word) < 0 || int($option_prob_word) > 100) { $option_prob_word = 20; } ################################################################################ # Insert the trademarks and dollar signs ################################################################################ my $max = $option_max; foreach my $line (split /(\n)/, $data) { foreach my $word (split /(\s)/, $line) { if ($max > 0 && (rand(100) <= $option_prob_word) && $word =~ /^(\w+)([[:punct:]])?$/) { $word = "${1}[tm]${2}"; $max--; } if ($max > 0 && (rand(100) <= $option_prob_word) && $word =~ /^(\w+(?:\[tm\])?)([[:punct:]])?$/) { $word = "\$${1}${2}"; $max--; } $output .= $word; } $max = $option_max; } ################################################################################ # Reversed smileys ################################################################################ my $hat = '[(<]'; my $eyes = '[:;%]'; my $nose = '[-]'; my $mouth = '[)(><\[\]{}|]'; $output =~ s{($hat?$eyes$nose?$mouth+)}{ # Supposed to be read from the right to the left. # Therefore reverse all parenthesis characters: my $tr = $1; $tr =~ tr/()<>[]\{\}/)(><][\}\{/; # Reverse the rest reverse($tr); }egox; ################################################################################ # EOL modifications ################################################################################ my $style = $option_eol_style; if ($option_eol_style eq 'random') { if (int(rand(2)) && $output !~ /[?!]$/) { $style = 'exclamation_marks'; } else { $style = 'suffixes'; } } # If there is no suffixes file, go for the exclamation marks my $file = "$option{dau_files_root_directory}/$option{dau_files_cool_suffixes}"; unless (-e $file && -r $file && !(-z $file)) { $style = 'exclamation_marks'; } # Skip EOL modifications? if (int(rand(100)) > $option_prob_eol) { $style = 'none'; } # Style determined. Act accordingly: if ($style eq 'exclamation_marks') { my @eol; if ($option{dau_language} eq 'de') { @eol = ("eins", "shifteins", "elf", "hundertelf", "tausendeinhundertundelf"); for (1 .. 5) { push(@eol, "eins"); push(@eol, "elf"); } } else { @eol = ("one", "shiftone", "eleven"); for (1 .. 5) { push(@eol, "one"); push(@eol, "eleven"); } } $output =~ s/\s*([,.?!])*\s*$//; $output .= '!' x (3 + int(rand(3))); $output .= '1' x (3 + int(rand(3))); $output .= $eol[rand(@eol)] x (1 + int(rand(1))); $output .= $eol[rand(@eol)] x (int(rand(2))); } elsif ($style eq 'suffixes') { my $suffix; if (-e $file && -r $file) { local $/ = "\n"; @ARGV = ($file); srand; rand($.) < 1 && ($suffix = switch_parse_special($_, $channel)) while <>; } $output =~ s/\s*$//; if ($output =~ /^\s*$/) { $output = $suffix; } else { $output .= " " . $suffix; } } return $output; } sub switch_cowsay { my $data = shift; my ($binarypath, $output, @cows, %cow, $cow, @cache1, @cache2); my $skip = 1; my $think = return_option('cowsay', 'think'); my $executable_name; if ($think eq 'on') { $binarypath = $option{dau_cowsay_cowthink_path}; $executable_name = 'cowthink'; } else { $binarypath = $option{dau_cowsay_cowsay_path}; $executable_name = 'cowsay'; } if (-e $binarypath && !(-f $binarypath)) { print_err("dau_cowsay_${executable_name}_path has to point to the $executable_name executable."); return; } elsif (!(-e $binarypath)) { print_err("$executable_name not found. Install it and set dau_cowsay_${executable_name}_path."); return; } if (return_option('cowsay', 'cow')) { $cow = return_option('cowsay', 'cow'); } else { while ($option{dau_cowsay_cowlist} =~ /\s*([^,\s]+)\s*,?/g) { $cow{$1} = 1; } foreach my $cow (keys %{ $switches{combo}{cowsay}{cow} }) { if (lc($option{dau_cowsay_cowpolicy}) eq 'allow') { push(@cows, $cow) unless ($cow{$cow}); } elsif (lc($option{dau_cowsay_cowpolicy}) eq 'deny') { push(@cows, $cow) if ($cow{$cow}); } else { print_err('Invalid value for dau_cowsay_cowpolicy'); return; } } if (@cows == 0) { print_err('Cannot find any cowsay cow.'); return; } $cow = $cows[rand(@cows)]; } # Run cowsay or cowthink local(*HIS_IN, *HIS_OUT, *HIS_ERR); my @arguments; my $option_arguments = return_option('cowsay', 'arguments'); if ($option_arguments) { @arguments = split(/ /, $option_arguments); } my $childpid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $binarypath, '-f', $cow, @arguments); print HIS_IN $data or return; close(HIS_IN) or return; my @errlines = ; my @outlines = ; close(HIS_ERR) or return; close(HIS_OUT) or return; waitpid($childpid, 0); if ($?) { print_err("That child exited with wait status of $?"); } # Error during execution? Print errors and return unless (@errlines == 0) { print_err('Error during execution of cowsay'); foreach my $line (@errlines) { print_err($line); } return; } if ($option{dau_cowsay_print_cow}) { print_out("Using cowsay cow $cow"); } foreach (@outlines) { chomp; if (/^\s*$/ && $skip) { next; } else { $skip = 0; } push(@cache1, $_); } $skip = 1; foreach (reverse @cache1) { chomp; if (/^\s*$/ && $skip) { next; } else { $skip = 0; } push(@cache2, $_); } foreach (reverse @cache2) { $output .= "$_\n"; } return $output; } sub switch_delimiter { my $data = shift; my $output; my $option_delimiter_string = return_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+/ if (rand(10) < 3) { (rand(10) >= 5 ? ' ' : '') . ('...' . '.' x rand(5)) . (rand(10) >= 5 ? ' ' : '') } else { ' ' } /egox; 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); if (-e $option{dau_figlet_path} && !(-f $option{dau_figlet_path})) { print_err('dau_figlet_path has to point to the figlet executable.'); return; } elsif (!(-e $option{dau_figlet_path})) { print_err('figlet not found. Install it and set dau_figlet_path.'); return; } if (return_option('figlet', 'font')) { $font = return_option('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 dau_figlet_fontpolicy.'); return; } } if (@fonts == 0) { print_err('Cannot find figlet fonts.'); return; } $font = $fonts[rand(@fonts)]; } # Run figlet local(*HIS_IN, *HIS_OUT, *HIS_ERR); my $childpid = open3(*HIS_IN, *HIS_OUT, *HIS_ERR, $option{dau_figlet_path}, '-f', $font); print HIS_IN $data or return; close(HIS_IN) or return; my @errlines = ; my @outlines = ; close(HIS_ERR) or return; close(HIS_OUT) or return; waitpid($childpid, 0); if ($?) { print_err("That child exited with wait status of $?"); } # Error during execution? Print errors and return unless (@errlines == 0) { print_err('Error during execution of figlet'); foreach my $line (@errlines) { print_err($line); } return; } if ($option{dau_figlet_print_font}) { print_out("Using figlet font $font"); } foreach (@outlines) { chomp; if (/^\s*$/ && $skip) { next; } else { $skip = 0; } push(@cache1, $_); } $skip = 1; foreach (reverse @cache1) { chomp; if (/^\s*$/ && $skip) { next; } else { $skip = 0; } push(@cache2, $_); } foreach (reverse @cache2) { $output .= "$_\n"; } 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/\b(\w+)ude\b/${1}00d/gi; s/\b(\w+)um\b/${1}00m/gi; s/\b(\w{3,})er\b/${1}0r/gi; s/\bdo\b/d00/gi; s/\bthe\b/d4/gi; s/\byou\b/j00/gi; tr/lLzZeEaAsSgGtTbBqQoOiIcC/11223344556677889900||((/; s/(\w)/rand(100) < 50 ? "\u$1" : "\l$1"/ge; return $_; } sub switch_me { my $data = shift; $command_out = 'ACTION'; return $data; } # &switch_mix by Martin Kihlgren # slightly modified by myself sub switch_mix { my $data = shift; my $output; while ($data =~ s/(\s*)([^\w]*)([\w]+)([^\w]*)(\s+[^\w]*\w+[^\w]*\s*)*/$5/) { my $prespace = $1; my $prechars = $2; my $w = $3; my $postchars = $4; $output = $output . $prespace . $prechars . substr($w,0,1); my $middle = substr($w,1,length($w) - 2); while ($middle =~ s/(.)(.*)/$2/) { if (rand() > 0.1) { $middle = $middle . $1; } else { $output = $output . $1; } } if (length($w) > 1) { $output = $output . substr($w, length($w) - 1, 1); } $output = $output . $postchars; } return $output; } 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 = return_option('moron', 'eol_style', $option{dau_moron_eol_style}); my $option_language = $option{dau_language}; ################################################################################ # -omega on ################################################################################ my $omega; if (return_option('moron', 'omega') eq 'on') { my @words = qw(omfg lol wtf); foreach (split / (?=\w+\b)/, $data) { if (rand(100) < 20) { $omega .= ' ' . $words[rand(@words)] . " $_"; } else { $omega .= ' ' . $_; } } $omega =~ s/\s*,\s+\@/ @/g; $omega =~ s/^\s+//; } $_ = $omega || $data; ################################################################################ # 'nick: text' -> 'text @ nick' ################################################################################ my $old_list_delimiter = $option{dau_parse_special_list_delimiter}; $option{dau_parse_special_list_delimiter} = ' '; my @nicks = split(/ /, switch_parse_special('@nicks', $channel_rec)); $option{dau_parse_special_list_delimiter} = $old_list_delimiter; @nicks = map { quotemeta($_) } @nicks; { local $" = '|'; eval { # Catch strange error s/^(@nicks): (.+)/$2 @ $1/; }; } ################################################################################ # Preparations for "EOL modifications" later ################################################################################ # 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+$//; ################################################################################ # Substitutions for every language ################################################################################ tr/'/`/; # Dauify smileys { # Use of uninitialized value in concatenation (.) or string at... # (the optional dash ($1) in the regular expressions). # Thus turn off warnings no warnings; if ($option{dau_language} eq 'de') { 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#(^|\s):(-)?/(\s|$)#$1 . ':' . $2 . '///' . ('/' x rand(10)) . ('7' x rand(4)) . $3#ego; } else { if (int(rand(2))) { s/:(-)?\)/^^/go; } else { s/:(-)?\)/':' . $1 . ')))' . (')' x rand(10)) . ('0' x rand(4))/ego; } s/;(-)?\)/';' . $1 . ')))' . (')' x rand(10)) . ('0' x rand(4))/ego; s/:(-)?\(/':' . $1 . '(((' . ('(' x rand(10)) . ('9' x rand(4))/ego; } } ################################################################################ # English text ################################################################################ if ($option_language eq 'en') { s/\bthe\b/teh/go; } ################################################################################ # German text ################################################################################ if ($option_language eq 'de') { # '*GG*' -> 'ÜGGÜ' { my @a = ('*', 'Ü'); my $a = $a[int(rand(@a))]; s/\*g\*/$a . 'ggg' . ('g' x rand(10)) . $a/egio; } # verbs s/\b(f)reuen\b/$1roien/gio; s/\b(f)reue\b/$1roie/gio; s/\b(f)reust\b/$1roist/gio; s/\b(f)reut\b/$1roit/gio; s/\b(f)unktionieren\b/$1unzen/gio; s/\b(f)unktioniere\b/$1unze/gio; s/\b(f)unktionierst\b/$1unzt/gio; s/\b(f)unktioniert\b/$1unzt/gio; s/\b(h)olen\b/$1ohlen/gio; s/\b(h)ole\b/$1ohle/gio; s/\b(h)olst\b/$1ohlst/gio; s/\b(h)olt\b/$1ohlt/gio; s/\b(k)onfigurieren\b/$1 eq 'k' ? 'confen' : 'Confen'/egio; s/\b(k)onfiguriere\b/$1 eq 'k' ? 'confe' : 'Confe'/egio; s/\b(k)onfigurierst\b/$1 eq 'k' ? 'confst' : 'Confst'/egio; s/\b(k)onfiguriert\b/$1 eq 'k' ? 'conft' : 'Conft'/egio; s/\b(l)achen\b/$1ölen/gio; s/\b(l)ache\b/$1öle/gio; s/\b(l)achst\b/$1ölst/gio; s/\b(l)acht\b/$1ölt/gio; s/\b(m)achen\b/$1 eq 'm' ? 'tun' : 'Tun'/egio; s/\b(m)ache\b/$1 eq 'm' ? 'tu' : 'Tu'/egio; s/\b(m)achst\b/$1 eq 'm' ? 'tust' : 'Tust'/egio; s/\b(n)erven\b/$1erfen/gio; s/\b(n)erve\b/$1erfe/gio; s/\b(n)ervst\b/$1erfst/gio; s/\b(n)ervt\b/$1erft/gio; s/\b(p)rojizieren\b/$1rojezieren/gio; s/\b(p)rojiziere\b/$1rojeziere/gio; s/\b(p)rojizierst\b/$1rojezierst/gio; s/\b(p)rojiziert\b/$1rojeziert/gio; s/\b(r)egistrieren\b/$1egestrieren/gio; s/\b(r)egistriere\b/$1egestriere/gio; s/\b(r)egistrierst\b/$1egestrierst/gio; s/\b(r)egistriert\b/$1egestriert/gio; s/\b(s)pazieren\b/$1patzieren/gio; s/\b(s)paziere\b/$1patziere/gio; s/\b(s)pazierst\b/$1patzierst/gio; s/\b(s)paziert\b/$1patziert/gio; # other s/\bdanke\b/ if (int(rand(2)) == 0) { 'thx' } else { 'danks' } /ego; s/\bDanke\b/ if (int(rand(2)) == 0) { 'Thx' } else { 'Danks' } /ego; s/\blol\b/ if (int(rand(2)) == 0) { 'löl' } else { 'löllens' } /ego; s/\bLOL\b/ if (int(rand(2)) == 0) { 'LÖL' } else { 'LÖLLENS' } /ego; s/\br(?:ü|ue)ckgrat\b/ if (int(rand(3)) == 0) { 'rückgrad' } elsif (int(rand(3)) == 1) { 'rückrad' } else { 'rückrat' } /ego; s/\bR(?:ü|ue)ckgrat\b/ if (int(rand(3)) == 0) { 'Rückgrad' } elsif (int(rand(3)) == 1) { 'Rückrad' } else { 'Rückrat' } /ego; s/\b(i)st er\b/$1ssa/gio; s/\bist\b/int(rand(2)) ? 'is' : 'iss'/ego; s/\bIst\b/int(rand(2)) ? 'Is' : 'Iss'/ego; s/\b(d)a(?:ss|ß) du\b/$1asu/gio; s/\b(d)a(?:ss|ß)\b/$1as/gio; s/\b(s)ag mal\b/$1amma/gio; s/\b(n)ochmal\b/$1omma/gio; s/(m)al\b/$1a/gio; s/\b(u)nd nun\b/$1nnu/gio; s/\b(n)un\b/$1u/gio; s/\b(s)oll denn\b/$1olln/gio; s/\b(d)enn\b/$1en/gio; s/\b(s)o eine\b/$1onne/gio; s/\b(e)ine\b/$1 eq 'e' ? 'ne' : 'Ne'/egio; s/\bkein problem\b/NP/gio; s/\b(p)roblem\b/$1rob/gio; s/\b(p)robleme\b/$1robs/gio; s/\b(a)ber\b/$1bba/gio; s/\b(a)chso\b/$1xo/gio; s/\b(a)dresse\b/$1ddresse/gio; s/\b(a)ggressiv\b/$1gressiv/gio; s/\b([[:alpha:]]{2,})st du\b/${1}su/gio; s/\b(a)nf(?:ä|ae)nger\b/$1 eq 'a' ? 'n00b' : 'N00b'/egio; s/\b(a)sozial\b/$1ssozial/gio; s/\b(a)u(?:ss|ß)er\b/$1user/gio; s/\b(a)utor/$1uthor/gio; s/\b(b)asta\b/$1 eq 'b' ? 'pasta' : 'Pasta'/egio; s/\b(b)illard\b/$1illiard/gio; s/\b(b)i(?:ss|ß)chen\b/$1ischen/gio; s/\b(b)ist\b/$1is/gio; s/\b(b)itte\b/$1 eq 'b' ? 'plz' : 'Plz'/egio; s/\b(b)lo(?:ss|ß)\b/$1los/gio; s/\b(b)(?:ox|(?:ü|ue)chse)\b/$1yxe/gio; s/\b(b)rillant\b/$1rilliant/gio; s/\b(c)hannel\b/$1 eq 'c' ? 'kanal' : 'Kanal'/egio; s/\b(c)hat\b/$1hatt/gio; s/\b(c)ool\b/$1 eq 'c' ? 'kewl' : 'Kewl'/egio; s/\b(d)(?:ä|ae)mlich\b/$1ähmlich/gio; s/\b(d)etailliert\b/$1etailiert/gio; s/\b(d)ilettantisch\b/$1illetantisch/gio; s/\b(d)irekt\b/$1ireckt/gio; s/\b(d)iskussion\b/$1isskusion/gio; s/\b(d)istribution/$1ystrubution/gio; s/\b(e)igentlich\b/$1igendlich/gio; s/\b(e)inzige\b/$1inzigste/gio; s/\b(e)nd/$1nt/gio; s/\b(e)ntschuldigung\b/$1 eq 'e' ? 'sry' : 'Sry'/egio; s/\b(f)ilm\b/$1 eq 'f' ? 'movie' : 'Movie'/egio; s/\b(f)lachbettscanner\b/$1lachbrettscanner/gio; s/\b(f)reu\b/$1roi/gio; s/\b(g)alerie\b/$1allerie/gio; s/\b(g)ay\b/$1hey/gio; s/\b(g)ebaren\b/$1ebahren/gio; s/\b(g)elatine\b/$1elantine/gio; s/\b(g)eratewohl\b/$1eradewohl/gio; s/\b(g)ibt es\b/$1ibbet/gio; s/\bgra([dt])/$1 eq 'd' ? 'grat' : 'grad'/ego; s/\bGra([dt])/$1 eq 'd' ? 'Grat' : 'Grad'/ego; s/\b(h)(?:ä|ae)ltst\b/$1älst/gio; s/\b(h)(?:ä|ae)sslich/$1äslich/gio; s/\b(h)aneb(?:ü|ue)chen\b/$1ahneb$2chen/gio; s/\b(i)mmobilie/$1mobilie/gio; s/\b(i)nteressant\b/$1nterressant/gio; s/\b(i)ntolerant\b/$1ntollerant/gio; s/\b(i)rgend/$1rgent/gio; s/\b(j)a\b/$1oh/gio; s/\b(j)etzt\b/$1ez/gio; s/\b(k)affee\b/$1affe/gio; s/\b(k)aputt\b/$1aput/gio; s/\b(k)arussell\b/$1arussel/gio; s/\b(k)iste\b/$1 eq 'k' ? 'byxe' : 'Byxe'/egio; s/\b(k)lempner\b/$1lemptner/gio; s/\b(k)r(?:ä|ae)nker\b/$1ranker/gio; s/\b(k)rise\b/$1riese/gio; s/\b(l)etal\b/$1ethal/gio; s/\b(l)eute\b/$1 eq 'l' ? 'ppl' : 'Ppl'/egio; s/\b(l)ibyen\b/$1ybien/gio; s/\b(l)izenz\b/$1izens/gio; s/\b(l)oser\b/$1ooser/gio; s/\b(l)ustig/$1ölig/gio; s/\b(m)aschine\b/$1aschiene/gio; s/\b(m)illennium\b/$1illenium/gio; s/\b(m)iserabel\b/$1ieserabel/gio; s/\b(m)it dem\b/$1im/gio; s/\b(m)orgendlich\b/$1orgentlich/gio; s/\b(n)(?:ä|ae)mlich\b/$1ähmlich/gio; s/\b(n)ein\b/$1eh/gio; s/\bnett\b/n1/gio; s/\b(n)ewbie\b/$100b/gio; s/\bnicht\b/int(rand(2)) ? 'net' : 'ned'/ego; s/\bNicht\b/int(rand(2)) ? 'Net' : 'Ned'/ego; s/\b(n)iveau/$1iwo/gio; s/\bok(?:ay)?\b/K/gio; s/\b(o)riginal\b/$1rginal/gio; s/\b(p)aket\b/$1acket/gio; s/\b(p)l(?:ö|oe)tzlich\b/$1lözlich/gio; s/\b(p)ogrom\b/$1rogrom/gio; s/\b(p)rogramm\b/$1roggie/gio; s/\b(p)rogramme\b/$1roggies/gio; s/\b(p)sychiater\b/$1sychater/gio; s/\b(p)ubert(?:ä|ae)t\b/$1upertät/gio; s/\b(q)uarz\b/$1uartz/gio; s/\b(q)uery\b/$1uerry/gio; s/\b(r)eferenz\b/$1efferenz/gio; s/\b(r)eparatur\b/$1eperatur/gio; s/\b(r)eply\b/$1eplay/gio; s/\b(r)essource\b/$1esource/gio; s/\b(r)(o)(t?fl)\b/$1 . ($2 eq 'o' ? 'ö' : 'Ö') . $3/egio; s/\b(r)(o)(t?fl)(o)(l)\b/$1 . ($2 eq 'o' ? 'ö' : 'Ö') . $3 . ($4 eq 'o' ? 'ö' : 'Ö') . $5/egio; s/\b(s)atellit\b/$1attelit/gio; s/\b(s)cherz\b/$1chertz/gio; s/\bsei([dt])\b/$1 eq 'd' ? 'seit' : 'seid'/ego; s/\bSei([dt])\b/$1 eq 'd' ? 'Seit' : 'Seid'/ego; s/\b(s)elig\b/$1eelig/gio; s/\b(s)eparat\b/$1eperat/gio; s/\b(s)eriosit(?:ä|ae)t\b/$1erösität/gio; s/\b(s)onst\b/$1onnst/gio; s/\b(s)orry\b/$1ry/gio; s/\b(s)pelunke\b/$1ilunke/gio; s/\b(s)piel\b/$1 eq 's' ? 'game' : 'Game'/egio; s/\b(s)tabil\b/$1tabiel/gio; s/\b(s)tandard\b/$1tandart/gio; s/\b(s)tegreif\b/$1tehgreif/gio; s/\b(s)ympathisch\b/$1ymphatisch/gio; s/\b(s)yntax\b/$1ynthax/gio; s/\b(t)era/$1erra/gio; s/\b(t)oler/$1oller/gio; s/\bto([td])/$1 eq 't' ? 'tod' : 'tot'/ego; s/\bTo([td])/$1 eq 't' ? 'Tod' : 'Tot'/ego; s/\b(u)ngef(?:ä|ae)hr\b/$1ngefär/gio; s/\bviel gl(?:ü|ue)ck\b/GL/gio; s/\b(v)ielleicht\b/$1ileicht/gio; s/\b(v)oraus/$1orraus/gio; s/\b(w)(?:ä|ae)re\b/$1ähre/gio; s/\bwa(h)?r/$1 eq 'h' ? 'war' : 'wahr'/ego; s/\bWa(h)?r/$1 eq 'h' ? 'War' : 'Wahr'/ego; s/\b(w)as du\b/$1asu/gio; s/\b(w)eil du\b/$1eilu/gio; s/\bweis(s)?/$1 eq 's' ? 'weis' : 'weiss'/ego; s/\bWeis(s)?/$1 eq 's' ? 'Weis' : 'Weiss'/ego; s/\b(w)enn du\b/$1ennu/gio; s/\b(w)ider/$1ieder/gio; s/\b(w)ieso\b/$1iso/gio; s/\b(z)iemlich\b/$1iehmlich/gio; s/\b(z)umindest\b/$1umindestens/gio; tr/üÜ/yY/; s/ei(?:ss?|ß)e?/ice/go; s/eife?/ive/go; if(return_option('moron', 'level') >= 1) { s/\b(u)nd\b/$1nt/gio; s/\b(h)at\b/$1att/gio; s/\b(n)ur\b/$1uhr/gio; s/\b(v)er(\w+)/$1 eq 'V' ? "Fa$2" : "fa$2"/egio; s/\b([[:alpha:]]+[b-np-tv-z])er\b/${1}a/go; s/\b([[:alpha:]]+)ck/${1}q/go; s/\b([fv])(?=[[:alpha:]]{2,})/ if (rand(10) <= 4) { if ($1 eq 'f') { 'v' } else { 'f' } } else { $1 } /egox; s/\b([FV])(?=[[:alpha:]]{2,})/ if (rand(10) <= 4) { if ($1 eq 'F') { 'V' } else { 'F' } } else { $1 } /egox; s#\b([[:alpha:]]{2,})([td])\b# my $begin = $1; my $end = $2; if (rand(10) <= 4) { if ($end eq 't' && $begin !~ /t$/) { "${begin}d" } elsif ($end eq 'd' && $begin !~ /d$/) { "${begin}t" } else { "${begin}${end}" } } else { "${begin}${end}" } #egox; s/\b([[:alpha:]]{2,})ie/ if (rand(10) <= 4) { "$1i" } else { "$1ie" } /egox; } } $data = $_; ################################################################################ # Swap characters with characters near at the keyboard ################################################################################ my %mark; my %chars; if ($option{dau_language} eq 'de') { %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' ], ); } else { %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' => [ 't', 'u' ], 'z' => [ 'x' ], ); } # Do not replace one character twice # Therefore every replace-position will be marked unless (lc(return_option('moron', 'typo')) eq 'off') { 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 $matched = $1; my $replacement; if ($matched eq lc($matched)) { $replacement = $chars{$matched}[int(rand(@{ $chars{$matched} }))]; } else { $replacement = uc($chars{$matched}[int(rand(@{ $chars{$matched} }))]); } if ($replacement !~ /^\s*$/) { substr($data, $pos, 1, $replacement); $mark{$pos} = 1; } } } } } ################################################################################ # Mix in some typos (swapping characters) ################################################################################ unless (lc(return_option('moron', 'typo')) eq 'off') { foreach my $word (split /([\s\n])/, $data) { if ((rand(100) <= 20) && length($word) > 1) { my $position_swap = int(rand(length($word))); if ($position_swap == 0) { $position_swap = 1; } elsif ($position_swap == length($word)) { $position_swap = length($word) - 1; } if (substr($word, $position_swap - 1, 1) eq uc(substr($word, $position_swap - 1, 1)) && substr($word, $position_swap, 1) eq lc(substr($word, $position_swap, 1))) { (substr($word, $position_swap, 1), substr($word, $position_swap - 1, 1)) = (lc(substr($word, $position_swap - 1, 1)), uc(substr($word, $position_swap, 1))); } else { (substr($word, $position_swap, 1), substr($word, $position_swap - 1, 1)) = (substr($word, $position_swap - 1, 1), substr($word, $position_swap, 1)); } } $output .= $word; } } else { $output = $_; } ################################################################################ # plenk ################################################################################ $output =~ s/(\w+)([,;.:?!]+)(\s+|$)/ if (rand(10) <= 8 || $3 eq '') { "$1 $2$3" } else { "$1$2" } /egox; ################################################################################ # default behaviour: uppercase text ################################################################################ $output = uc($output) unless (return_option('moron', 'uppercase') eq 'off'); ################################################################################ # do something at EOL ################################################################################ if ($option_eol_style ne 'nothing') { my $random = int(rand(100)); $output .= ' ' unless ($output =~ /^\s*$/); # !!!!!!??????????!!!!!!!!!!11111 if ($random <= 70 || $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 =~ /\?$/) { if ($option{dau_language} eq 'de') { $output .= "ß" x int(rand(10)); } else { $output .= "/" x int(rand(10)); } } elsif ($output =~ /!$/) { $output .= "1" x int(rand(10)); } } # ?¿? elsif ($random <= 85) { $output .= '?¿?'; } # "=\n?" else { $output .= "=\n?"; } } return $output; } sub switch_nothing { my $data = shift; return $data; } sub switch_parse_special { my ($text, $channel) = @_; local $" = return_option('parse_special', 'list_delimiter', $option{dau_parse_special_list_delimiter}); # Build nick array with every nick in channel and # opnick array with every op in the channel my @nicks = (); my @opnicks = (); if (defined($channel) && $channel && $channel->{type} eq 'CHANNEL') { foreach my $nick ($channel->nicks()) { next if ($channel->{server}->{nick} eq $nick->{nick}); push(@nicks, $nick->{nick}); push(@opnicks, $nick->{nick}) if ($nick->{op}); } } @nicks = sort { lc($a) cmp lc($b) } @nicks; @opnicks = sort { lc($a) cmp lc($b) } @opnicks; # Substitution: \n to a real newline $text =~ s/(? [^{}]+ ) # Non-capture group w/o backtracking | (??{ $np }) # Group with matching parens )* } }x; while ($text =~ /(?{type} eq 'CHANNEL' || $channel->{type} eq 'QUERY')) && !(lc(return_option('parse_special', 'irssi_variables')) eq 'off')) { $text = $channel->parse_special($text); } return $text; } sub switch_reverse { my $data = shift; $data = reverse($data); return $data; } sub switch_stutter { my $data = shift; my $output; my @words = qw(eeeh oeeeh aeeeh); 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_substitute { $_ = shift; my $file = "$option{dau_files_root_directory}/$option{dau_files_substitute}"; if (-e $file && -r $file) { my $return = do $file; if ($@) { print_err("parsing $file failed: $@"); } unless (defined($return)) { print_err("'do $file' failed"); } } return $_; } sub switch_underline { my $data = shift; $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.'); 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 dau_words_range.'); return; } my $random = $numbers[rand(@numbers)]; while ($data =~ /((?:.*?(?:\s+|$)){1,$random})/g) { $output .= "$1\n" unless (length($1) == 0); $random = $numbers[rand(@numbers)]; } $output =~ s/\s*$//; return $output; } ################################################################################ # Subroutines (signals) ################################################################################ sub signal_channel_destroyed { my ($channel) = @_; my $channel_name = $channel->{name}; my $network_name = $channel->{server}->{tag}; $daumode{channels_in}{$network_name}{$channel_name} = 0; $daumode{channels_out}{$network_name}{$channel_name} = 0; $daumode{channels_in_modes}{$network_name}{$channel_name} = ''; $daumode{channels_out_modes}{$network_name}{$channel_name} = ''; } sub signal_channel_joined { my ($channel) = @_; # Resume babbles if (defined($babble{timer_writing})) { if ($babble{channel}->{name} eq $channel->{name} && $babble{channel}->{server}->{tag} eq $channel->{server}->{tag}) { $channel->print('%9dau.pl:%9 Continuing babble...'); timer_babble_writing(); } } # Automatically set daumode daumode_channels(); } sub signal_command_msg { my ($args, $server, $witem) = @_; $args =~ /^(?:-\S+\s)?(?:\S*)\s(.*)/; my $data = $1; $command_in .= "$data\n"; Irssi::signal_stop(); } 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, $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+)(?: ('.*?(? 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/^(?: ('.*?(? 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/^(?: ('.*?(? 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 @$list = (); 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), sort(@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), sort(@switches_combo), sort(@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), sort(@nicks))) { if($x =~ /^$word/i) { push(@$list, $x); } } } Irssi::signal_stop(); } sub signal_event_404 { my ($server, $message, $network_name) = @_; if ($message =~ /^(?:\S+) (\S+) :Cannot send to channel$/) { my $channel_name = $1; if ($server->{tag} eq $babble{channel}->{server}->{tag} && $babble{channel}->{name} eq $channel_name && defined($babble{timer_writing})) { Irssi::timeout_remove($babble{timer_writing}); undef($babble{timer_writing}); print_out("%9dau.pl:%9 Could not send message to $babble{channel}->{name}/$babble{channel}->{server}->{tag}. Cancelling babble."); return; } } if ($message =~ /^(?:\S+) (\S+) :(.*)/) { Irssi::print("$1 $2"); } else { Irssi::print($message); } } 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; 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; } # Remove formatting so dau.pl can reply to a colored, underlined, ... # question $text =~ s/\003\d?\d?(?:,\d?\d?)?|\002|\006|\007|\016|\01f|\037//g; my $regexp = switch_parse_special($option{dau_remote_question_regexp}, $channel_rec); if ($text =~ /$regexp/) { my $reply = return_random_list_item($option{dau_remote_question_reply}); $reply =~ s/(?{name}); my $network_name = lc($channel->{server}->{tag}); my $op = $nick_mode{$network_name}{$channel_name}{op}; # mode before nick change my $voice = $nick_mode{$network_name}{$channel_name}{voice}; # mode before nick change return if ($channel->{server}->{nick} ne $nick->{nick}); if ($nick->{nick} eq $setby || $setby eq 'irc.psychoid.net') { build_nick_mode_struct(); return; } # Only act in channels where the user wants dau.pl to act 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') { if ($lookup{$network_name}{$channel_name}) { build_nick_mode_struct(); return; } } elsif (lc($option{dau_remote_channelpolicy}) eq 'deny') { unless ($lookup{$network_name}{$channel_name}) { build_nick_mode_struct(); return; } } else { build_nick_mode_struct(); return; } # Now we are in the right channel if ($option{dau_remote_permissions} =~ /^[01]1[01][01][01][01]$/) { if ($mode eq '+' && $type eq '+' && (!$voice && !$op)) { $reply = return_random_list_item($option{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 ($daumode{channels_out}{$server->{tag}}{$witem->{name}} == 1) { if ($daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} eq '') { $output = parse_text($daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} . $data, $witem); } else { $output = parse_text($daumode{channels_out_modes}{$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'); # babble history if (defined($babble{history}) && ref($babble{history}) eq 'ARRAY') { my @history; my $i = 1; foreach (@{ $babble{history} } ) { if ($i++ <= $option{dau_babble_history_size}) { push(@history, $_); } } @{ $babble{history} } = @history; } # setting dau_cowsay_cowpath cowsay_cowlist($option{dau_cowsay_cowpath}); # setting dau_figlet_fontpath figlet_fontlist($option{dau_figlet_fontpath}); # setting dau_daumode_channels daumode_channels(); # setting dau_statusbar_daumode_hide_when_off Irssi::statusbar_items_redraw('daumode'); # timer for the babble feature timer_remote_babble_reset(); # signal handling signal_handling(); } sub signals_daumode_in { my ($server, $data, $nick, $hostmask, $target) = @_; my $channel_rec = $server->channel_find($target); my $i_channel = $daumode{channels_in}{$server->{tag}}{$target}; my $i_modes = $daumode{channels_in_modes}{$server->{tag}}{$target}; my $modified_msg; return unless (defined($server) && $server && $server->{connected}); # Not one of the channels where daumode for incoming messages is turned on. # In those channels print out the message as it is and leave the subroutine if (!$i_channel) { return; } # Evil Hack? # I had to dauify every incoming messages. Using &signal_continue was # not possible because --words f.e. generates output over multiple lines. So I # had to create multiple messages using &signal_emit. Those just created # messages shouldn't be dauified again when entering this subroutine. I # couldn't prevent irssi from entering this subroutine again after # dauifying the text so the messages had to be 'marked'. Marked # messages will not be dauified again. I think \x02 at the beginning of the # message is ok for that. if ($data =~ s/^\x02//) { Irssi::signal_continue($server, $data, $nick, $hostmask, $target); } else { if ($i_modes ne '') { $modified_msg = parse_text($i_modes . ' ' . $data, $channel_rec); } else { $modified_msg = parse_text($data, $channel_rec); } if ($modified_msg =~ /\n/) { for my $line (split /\n/, $modified_msg) { Irssi::signal_emit(Irssi::signal_get_emitted(), $server, "\x02$line", $nick, $hostmask, $target); Irssi::signal_stop(); } } else { Irssi::signal_emit(Irssi::signal_get_emitted(), $server, "\x02$modified_msg", $nick, $hostmask, $target); Irssi::signal_stop(); } } } ################################################################################ # Subroutines (statusbar) ################################################################################ sub statusbar_daumode { my ($item, $get_size_only) = @_; my ($status_in, $status_out, $modes_in, $modes_out); my $server = Irssi::active_server(); my $witem = Irssi::active_win()->{active}; my $theme = Irssi::current_theme(); my $format = $theme->format_expand('{sb_daumode}'); if ($witem && ref($witem) && $server && ref($server) && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) { if (defined($daumode{channels_in}{$server->{tag}}{$witem->{name}}) && $daumode{channels_in}{$server->{tag}}{$witem->{name}} == 1) { $status_in = 'ON'; } else { $status_in = 'OFF'; } if (defined($daumode{channels_out}{$server->{tag}}{$witem->{name}}) && $daumode{channels_out}{$server->{tag}}{$witem->{name}} == 1) { $status_out = 'ON'; } else { $status_out = 'OFF'; } # Hide statusbaritem if setting dau_statusbar_daumode_hide_when_off # is turned on and daumode is turned off if ($status_in eq 'OFF' && $status_out eq 'OFF' && $option{dau_statusbar_daumode_hide_when_off}) { $item->{min_size} = $item->{max_size} = 0; return; } if ($status_in eq 'ON') { $modes_in = $daumode{channels_in_modes}{$server->{tag}}{$witem->{name}} || $option{dau_standard_options}; } else { $modes_in = ''; } if ($status_out eq 'ON') { $modes_out = $daumode{channels_out_modes}{$server->{tag}}{$witem->{name}} || $option{dau_standard_options}; } else { $modes_out = ''; } if ($format) { $format = $theme->format_expand("{sb_daumode $status_out $modes_out $status_in $modes_in}"); } else { if ($status_in eq 'OFF' && $status_out eq 'OFF') { $format = $theme->format_expand("{sb daumode: <- $status_in | -> $status_out}"); } elsif ($status_in eq 'OFF' && $status_out eq 'ON') { $format = $theme->format_expand("{sb daumode: <- $status_in | -> $status_out ($modes_out)}"); } elsif ($status_in eq 'ON' && $status_out eq 'OFF') { $format = $theme->format_expand("{sb daumode: <- $status_in ($modes_in) | -> $status_out}"); } elsif ($status_in eq 'ON' && $status_out eq 'ON') { $format = $theme->format_expand("{sb daumode: <- $status_in ($modes_in) | -> $status_out ($modes_out)}"); } } } else { $item->{min_size} = $item->{max_size} = 0; return; } $item->default_handler($get_size_only, $format, '', 1); } ################################################################################ # Subroutines (timer) ################################################################################ # for the babble remote feature sub timer_away_reminder { my $id = shift; $id =~ m{^([^/]+)/(.+)}; my $channel = $1; my $network = $2; my $server_rec = Irssi::server_find_tag($network); unless (defined($server_rec) && $server_rec) { return; } my $channel_rec = $server_rec->channel_find($channel); unless (defined($channel_rec) && $channel_rec && ($channel_rec->{type} eq 'CHANNEL' || $channel_rec->{type} eq 'QUERY')) { return; } ################################################################################ # Open file ################################################################################ my $file = "$option{dau_files_root_directory}/$option{dau_files_away}"; my @file; unless (tie(@file, 'Tie::File', $file)) { print_err("Cannot tie $file!"); return; } ################################################################################ # Go through file ################################################################################ # Format: # channel | network | time | options | reminder | interval | reason my ($time, $options, $reminder, $interval, $reason); foreach my $line (@file) { if ($line =~ m{^$channel\x02$network\x02(\d+)\x02([^\x02]*)\x02(\d)\x02(\d+)\x02(.*)}) { $time = $1; $options = $2; $reminder = $3; $interval = $4; $reason = $5; last; } } ################################################################################ # Special variables ################################################################################ my $output = $option{dau_away_reminder_text}; # $time my $difference = time_diff_verbose(time, $time); $output =~ s/\$time/$difference/g; # $reason if ($option{dau_away_quote_reason}) { $reason =~ s/\\/\\\\/g; $reason =~ s/\$/\\\$/g; } $output =~ s/\$reason/$reason/g; ################################################################################ # Write text to channels. Write changes back to file ################################################################################ untie(@file); $output = parse_text("$options $output", $channel_rec); output_text($channel_rec, $channel_rec->{name}, $output); } # all babbles: the writing to the channel sub timer_babble_writing { # check if we are still on the channel my $onChannel = 0; foreach my $server (Irssi::servers()) { if ($server->{tag} eq $babble{channel}->{server}->{tag}) { foreach my $channel ($server->channels()) { if ($babble{channel}->{name} eq $channel->{name}) { if ($babble{channel} != $channel) { $babble{channel} = $channel; } $onChannel = 1; } } } } if (!$onChannel) { Irssi::timeout_remove($babble{timer_writing}); print_out("%9dau.pl:%9 You are not on $babble{channel}->{name}/$babble{channel}->{server}->{tag}. Stalling babble."); return; } # restore the variables $command_out = $babble{command_out_history}{$babble{counter}}; $command_out_activated = $babble{command_out_history_switch}{$babble{counter}}; # then output text output_text($babble{channel}, $babble{channel}->{name}, $babble{line}); # And go to the "managing" subroutine... timer_babble_writing_reset(); } # all babbles: the timer for the next writing sub timer_babble_writing_reset { my $interval = 0; # Remove used writing timer, if existent (at the first run we don't have any timer) Irssi::timeout_remove($babble{timer_writing}) if (defined($babble{timer_writing})); # At each run of this managing subroutine remove one line of text $babble{text} =~ s/^(.*?)\n//; $babble{line} = $1; if ($babble{line} =~ s/^BABBLE_INTERVAL=(\d+)\x02//) { $interval = $1; $babble{line} = parse_text("$option{dau_babble_options_line_by_line} $babble{line}"); my $counter = $babble{counter} + 1; $babble{command_out_history}{$counter} = $command_out; $babble{command_out_history_switch}{$counter} = $command_out_activated; } # If there is still some text left, add a new timer for the next line if (length($babble{text}) != 0 || length($babble{line}) != 0) { if ($babble{counter}++ == 0) { if ($option{dau_babble_verbose} && $babble{numberoflines} >= $option{dau_babble_verbose_minimum_lines}) { $babble{channel}->print("%9dau.pl:%9 Babbling $babble{numberoflines} line" . ($babble{numberoflines} > 1 ? 's' : '') . ' now:'); } $interval = 50; } if ($interval < 10) { # Calculate the writing breaks # The longer the next line is the longer the break will be $interval = 1000 + rand(2000) + 50 * length($babble{line}) + rand(25 * length($babble{line})); # Some characters need more time to write while ($babble{line} =~ /[^a-z ]/gio) { $interval += (75 + rand(25)); } $interval = int($interval); } # Set timer $babble{timer_writing} = Irssi::timeout_add($interval, \&timer_babble_writing, ''); } # No text left? else { if ($option{dau_babble_verbose} && $babble{numberoflines} >= $option{dau_babble_verbose_minimum_lines}) { $babble{channel}->print('%9dau.pl:%9 Finished babbling.'); } # remove the timer undef($babble{timer_writing}); if ($babble{remote}) { timer_remote_babble_reset(); } } } # remote babble: initialize sub timer_remote_babble { my $text; # Push all channels where it's ok to babble text in @channels my %lookup; while ($option{dau_remote_babble_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_babble_channelpolicy}) eq 'allow' && !$lookup{$server_name}{$channel_name}) { push(@channels, $channel); } elsif (lc($option{dau_remote_babble_channelpolicy}) eq 'deny' && $lookup{$server_name}{$channel_name}) { push(@channels, $channel); } } } # No channels found => return return if (@channels == 0); # Choose one of the @channels my $channel = $channels[rand(@channels)]; # If something is babbling right now, stop if (defined($babble{timer_writing})) { return; } # else get text from file else { my @filter = (); $text = &babble_get_text($channel, \@filter, undef, $option{dau_babble_history_size}); } # Stop the timer for the big breaks. Irssi::timeout_remove($babble{timer_remote}) if (defined($babble{timer_remote})); # Start the writing. babble_start($channel, $text, 1); } # remote babble: reset sub timer_remote_babble_reset { Irssi::timeout_remove($babble{timer_remote}) if (defined($babble{timer_remote})); # Do not set the timer, if the permission-bit is not set return unless ($option{dau_remote_permissions} =~ /^[01][01][01][01][01]1$/); # Calculate interval my $interval = babble_set_interval($option{dau_remote_babble_interval}, $option{dau_remote_babble_interval_accuracy}); # Set timer if ($interval != 0) { $babble{timer_remote} = Irssi::timeout_add($interval, \&timer_remote_babble, ''); } } ################################################################################ # Helper subroutines ################################################################################ sub babble_get_text { my ($channel, $filter, $nicks, $history_size) = @_; my $output; # Return a random line from the dau_files_babble_messages file my ($text, @file, @filterindex); my $file = "$option{dau_files_root_directory}/$option{dau_files_babble_messages}"; if (-e $file && -r $file) { unless (tie(@file, 'Tie::File', $file)) { print_err("Cannot tie $file!"); return; } } else { print_err("Couldn't access babble file '$file'!"); return; } my @nicks_channel = (); my @opnicks_channel = (); if (defined($channel) && $channel && $channel->{type} eq 'CHANNEL') { foreach my $nick ($channel->nicks()) { next if ($channel->{server}->{nick} eq $nick->{nick}); push(@nicks_channel, $nick->{nick}); push(@opnicks_channel, $nick->{nick}) if ($nick->{op}); } } my @compiled_patterns_filter; eval { # possible user input here @compiled_patterns_filter = map { qr/$_/i } @$filter; }; if ($@) { print_err("The %9-filter%9 you gave wasn't a valid regular expression."); print_err($@); return; } my $compiled_pattern_nicks = qr/(? $minimum_number_nicks) { $minimum_number_nicks = $1; } } if (defined($nicks) && @$nicks > 0) { if (scalar(@$nicks) < $minimum_number_nicks) { $add = 0; } } else { if (scalar(@nicks_channel) < $minimum_number_nicks) { $add = 0; } } } # Don't babble at non-existent channel operators if ($add) { if ($line =~ /$compiled_pattern_ops/) { my $minimum_number_ops = 0; while ($line =~ /$compiled_pattern_ops/g) { if ($1 > $minimum_number_ops) { $minimum_number_ops = $1; } } if (defined($nicks) && @$nicks > 0) { if (scalar(@$nicks) < $minimum_number_ops) { $add = 0; } } else { if (scalar(@opnicks_channel) < $minimum_number_ops) { $add = 0; } } } } # Add the line as it passed all the tests if ($add) { push(@filterindex, $i); } $i++; } $text = $file[$filterindex[int(rand(@filterindex))]]; if (@filterindex == 0) { 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"); return; } if (!$text) { print_err("No text to babble."); return; } # Put babble in global history and shorten it, if necessary @{ $babble{history} } = ($text, @{ $babble{history} }); if (scalar(@{ $babble{history} }) > $option{dau_babble_history_size}) { pop(@{ $babble{history} }); } # dauify $text and return the dauified $output my $options = $option{dau_babble_options_line_by_line}; # We have to keep track of the command history. --me and the --command # switch change the variables $command_out and $command_out_activated. # Because they are reset after every run of parse_text() they have to be kept # in a struct so that the writing timers later can do their job correctly. my $counter = 1; $babble{command_out_history} = (); $babble{command_out_history_switch} = (); # parse for special characters and substitute them if (defined($nicks)) { if (@$nicks > 0) { for (my $i = 1; $i <= @$nicks; $i++) { $text =~ s/(? 0 && $accuracy < 100) { $addend = rand($interval - ($interval * ($accuracy / 100))); } else { print_err('Invalid accuracy value'); return; } if (int(rand(2))) { $interval = $interval + $addend; } else { $interval = $interval - $addend; } $interval = int($interval); if ($interval < 10 || $interval > 1000000000) { print_err('Invalid interval value'); return 0; } return $interval; } sub babble_start { my ($channel_rec, $text, $remote) = @_; # These are some global variables for the writing timer $babble{channel} = $channel_rec; $babble{counter} = 0; $babble{text} = "$text\n"; $babble{numberoflines} = 0; $babble{numberoflines}++ while ($babble{text} =~ /\n/g); $babble{numberoflines} -= 1; $babble{remote} = $remote; Irssi::timeout_remove($babble{timer_writing}) if (defined($babble{timer_writing})); timer_babble_writing_reset(); } sub build_nick_mode_struct { undef(%nick_mode); foreach my $server (Irssi::servers()) { my $network_name = lc($server->{tag}); foreach my $channel ($server->channels()) { my $channel_name = lc($channel->{name}); my $op = $channel->{ownnick}{op}; my $voice = $channel->{ownnick}{voice}; $nick_mode{$network_name}{$channel_name}{op} = $op; $nick_mode{$network_name}{$channel_name}{voice} = $voice; } } } sub daumode_channels { my @items; my $item; while ($option{dau_daumode_channels} =~ /([^,]+)/g) { my $match = $1; if ($match =~ s/\\$//) { $item .= "$match,"; } else { $item .= $match; $item =~ s/^\s*//; $item =~ s/\s*$//; push @items, $item unless ($item =~ /^\s*$/); $item = ""; } } foreach my $server (Irssi::servers()) { my $network_name = $server->{tag}; foreach my $channel ($server->channels()) { my $channel_name = $channel->{name}; foreach my $daumode (@items) { $daumode =~ m#^([^/]+)/([^:]+):(.*)#; my $item_channel = $1; my $item_network = $2; my $item_switches = $3; if (lc($item_channel) eq lc($channel_name) && lc($item_network) eq lc($network_name)) { unless ($daumode{channels_in}{$network_name}{$channel_name} || $daumode{channels_out}{$network_name}{$channel_name}) { $channel->print("%9dau.pl%9: Activating daumode according to setting dau_daumode_channels"); } $channel->command("dau --daumode $item_switches"); } } } } } sub def_dau_cowsay_cowpath { my $cowsay = $ENV{COWPATH} || '/usr/share/cowsay/cows'; chomp($cowsay); return $cowsay; } sub def_dau_cowsay_cowsay_path { my $cowsay = `which cowsay`; chomp($cowsay); return $cowsay; } sub def_dau_cowsay_cowthink_path { my $cowthink = `which cowthink`; chomp($cowthink); return $cowthink; } 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 cowsay_cowlist { my $cowsay_cowpath = shift; # clear cowlist %{ $switches{combo}{cowsay}{cow} } = (); # generate new list while (<$cowsay_cowpath/*.cow>) { my $cow = (fileparse($_, qr/\.[^.]*/))[0]; $switches{combo}{cowsay}{cow}{$cow} = 1; } } 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) { # prevent "-!- Irssi: Not enough parameters given" $line = ' ' if ($line eq ''); # --command -out ? if ($command_out_activated) { if (defined($thing) && $thing) { $thing->command("$command_out $line"); } else { my $server = Irssi::active_server(); if (defined($server) && $server && $server->{connected}) { $server->command("$command_out $line"); } else { print CLIENTCRAP $line; } } } # Not a channel/query window, --help, --changelog, ... elsif ($print_message) { print CLIENTCRAP $line; } # MSG or ACTION to channel or query elsif ($command_out eq 'ACTION' || $command_out eq 'MSG') { $thing->command("$command_out $target $line"); } # weird things happened... else { print CLIENTCRAP $line; } } } sub parse_text { my ($data, $channel_rec) = @_; my $output; $command_out_activated = 0; $command_out = 'MSG'; $counter_switches = 0; $daumode_activated = 0; $print_message = 0; %queue = (); 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'}) && $counter_switches == 0) { $data =~ s/^--\w+ ?//; # found a first level option $queue{$counter_switches}{$first_level_option} = { }; # Check for second level options and third level options. # Get all of them and put theme in the # $queue hash while ($data =~ /^-(\w+) ('.*?(? Put it in the hash if ($switches{combo}{$first_level_option}{$second_level_option}{$third_level_option} || $any_option) { $queue{$counter_switches}{$first_level_option}{$second_level_option} = $third_level_option; $data =~ s/^-(\w+) ('.*?(?print($message); } else { print CLIENTCRAP $message; } } } # return_option('firstlevel', 'secondlevel'): # # If "--firstlevel -secondlevel value" given on the commandline, return 'value'. # # return_option('firstlevel', 'secondlevel', 'default value'): # # If "--firstlevel -secondlevel value" not given on the commandline, return # 'default value'. sub return_option { if (@_ == 2) { return $queue{$counter_switches}{$_[0]}{$_[1]}; } elsif (@_ == 3) { if (length($queue{$counter_switches}{$_[0]}{$_[1]}) > 0) { return $queue{$counter_switches}{$_[0]}{$_[1]}; } else { return $_[2]; } } else { return 0; } } sub return_random_list_item { my $arg = shift; my @strings; my $item; while ($arg =~ /([^,]+)/g) { my $match = $1; if ($match =~ s/\\$//) { $item .= "$match,"; } else { $item .= $match; $item =~ s/^\s*//; $item =~ s/\s*$//; push @strings, $item; $item = ""; } } if (@strings == 0) { return; } else { return $strings[rand(@strings)]; } } sub set_settings { # setting changed/added => change/add it here # boolean $option{dau_away_quote_reason} = Irssi::settings_get_bool('dau_away_quote_reason'); $option{dau_away_reminder} = Irssi::settings_get_bool('dau_away_reminder'); $option{dau_babble_verbose} = Irssi::settings_get_bool('dau_babble_verbose'); $option{dau_color_choose_colors_randomly} = Irssi::settings_get_bool('dau_color_choose_colors_randomly'); $option{dau_cowsay_print_cow} = Irssi::settings_get_bool('dau_cowsay_print_cow'); $option{dau_figlet_print_font} = Irssi::settings_get_bool('dau_figlet_print_font'); $option{dau_silence} = Irssi::settings_get_bool('dau_silence'); $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_babble_history_size} = Irssi::settings_get_int('dau_babble_history_size'); $option{dau_babble_verbose_minimum_lines} = Irssi::settings_get_int('dau_babble_verbose_minimum_lines'); $option{dau_cool_maximum_line} = Irssi::settings_get_int('dau_cool_maximum_line'); $option{dau_cool_probability_eol} = Irssi::settings_get_int('dau_cool_probability_eol'); $option{dau_cool_probability_word} = Irssi::settings_get_int('dau_cool_probability_word'); $option{dau_remote_babble_interval_accuracy} = Irssi::settings_get_int('dau_remote_babble_interval_accuracy'); # String $option{dau_away_away_text} = Irssi::settings_get_str('dau_away_away_text'); $option{dau_away_back_text} = Irssi::settings_get_str('dau_away_back_text'); $option{dau_away_options} = Irssi::settings_get_str('dau_away_options'); $option{dau_away_reminder_interval} = Irssi::settings_get_str('dau_away_reminder_interval'); $option{dau_away_reminder_text} = Irssi::settings_get_str('dau_away_reminder_text'); $option{dau_babble_options_line_by_line} = Irssi::settings_get_str('dau_babble_options_line_by_line'); $option{dau_babble_options_preprocessing} = Irssi::settings_get_str('dau_babble_options_preprocessing'); $option{dau_color_codes} = Irssi::settings_get_str('dau_color_codes'); $option{dau_cool_eol_style} = Irssi::settings_get_str('dau_cool_eol_style'); $option{dau_cowsay_cowlist} = Irssi::settings_get_str('dau_cowsay_cowlist'); $option{dau_cowsay_cowpath} = Irssi::settings_get_str('dau_cowsay_cowpath'); $option{dau_cowsay_cowpolicy} = Irssi::settings_get_str('dau_cowsay_cowpolicy'); $option{dau_cowsay_cowsay_path} = Irssi::settings_get_str('dau_cowsay_cowsay_path'); $option{dau_cowsay_cowthink_path} = Irssi::settings_get_str('dau_cowsay_cowthink_path'); $option{dau_daumode_channels} = Irssi::settings_get_str('dau_daumode_channels'); $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_away} = Irssi::settings_get_str('dau_files_away'); $option{dau_files_babble_messages} = Irssi::settings_get_str('dau_files_babble_messages'); $option{dau_files_cool_suffixes} = Irssi::settings_get_str('dau_files_cool_suffixes'); $option{dau_files_root_directory} = Irssi::settings_get_str('dau_files_root_directory'); $option{dau_files_substitute} = Irssi::settings_get_str('dau_files_substitute'); $option{dau_language} = Irssi::settings_get_str('dau_language'); $option{dau_moron_eol_style} = Irssi::settings_get_str('dau_moron_eol_style'); $option{dau_parse_special_list_delimiter} = Irssi::settings_get_str('dau_parse_special_list_delimiter'); $option{dau_random_options} = Irssi::settings_get_str('dau_random_options'); $option{dau_remote_babble_channellist} = Irssi::settings_get_str('dau_remote_babble_channellist'); $option{dau_remote_babble_channelpolicy} = Irssi::settings_get_str('dau_remote_babble_channelpolicy'); $option{dau_remote_babble_interval} = Irssi::settings_get_str('dau_remote_babble_interval'); $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_regexp} = Irssi::settings_get_str('dau_remote_question_regexp'); $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 { # complete word if ($option{dau_tab_completion}) { if ($signal{'complete word'} != 1) { Irssi::signal_add_last('complete word', 'signal_complete_word'); } $signal{'complete word'} = 1; } else { if ($signal{'complete word'} != 0) { Irssi::signal_remove('complete word', 'signal_complete_word'); } $signal{'complete word'} = 0; } # event privmsg if ($option{dau_remote_permissions} =~ /^1[01][01][01][01][01]$/) { if ($signal{'event privmsg'} != 1) { Irssi::signal_add_last('event privmsg', 'signal_event_privmsg'); } $signal{'event privmsg'} = 1; } else { if ($signal{'event privmsg'} != 0) { Irssi::signal_remove('event privmsg', 'signal_event_privmsg'); } $signal{'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 ($signal{'nick mode changed'} != 1) { Irssi::signal_add_last('channel joined', 'build_nick_mode_struct'); Irssi::signal_add_last('nick mode changed', 'signal_nick_mode_changed'); } $signal{'nick mode changed'} = 1; } else { if ($signal{'nick mode changed'} != 0) { Irssi::signal_remove('channel joined', 'build_nick_mode_struct'); Irssi::signal_remove('nick mode changed', 'signal_nick_mode_changed'); } $signal{'nick mode changed'} = 0; } # daumode: outgoing messages my $daumode_out = 0; foreach my $server (keys %{ $daumode{channels_out} }) { foreach my $channel (keys %{ $daumode{channels_out}{$server} }) { if ($daumode{channels_out}{$server}{$channel} == 1) { $daumode_out = 1; } } } if ($daumode_out) { if ($signal{'send text'} != 1) { Irssi::signal_add_first('send text', 'signal_send_text'); } $signal{'send text'} = 1; } else { if ($signal{'send text'} != 0) { Irssi::signal_remove('send text', 'signal_send_text'); } $signal{'send text'} = 0; } # daumode: incoming messages my $daumode_in = 0; foreach my $server (keys %{ $daumode{channels_in} }) { foreach my $channel (keys %{ $daumode{channels_in}{$server} }) { if ($daumode{channels_in}{$server}{$channel} == 1) { $daumode_in = 1; } } } if ($daumode_in) { if ($signal{'daumode in'} != 1) { Irssi::signal_add_last('message public', 'signals_daumode_in'); Irssi::signal_add_last('message irc action', 'signals_daumode_in'); } $signal{'daumode in'} = 1; } else { if ($signal{'daumode in'} != 0) { Irssi::signal_remove('message public', 'signals_daumode_in'); Irssi::signal_remove('message irc action', 'signals_daumode_in'); } $signal{'daumode in'} = 0; } # continuing babbles, setting daumode if ($signal{'channel joined'} != 1) { Irssi::signal_add_last('channel joined', 'signal_channel_joined'); Irssi::signal_add_last('channel destroyed', 'signal_channel_destroyed'); $signal{'channel joined'} = 1; } # Cancel babble when message could not be sent to channel if ($signal{'event 404'} != 1) { Irssi::signal_add_last('event 404', 'signal_event_404'); $signal{'event 404'} = 1; } } sub time_diff_verbose { my ($sub1, $sub2) = @_; my $difference = $sub1 - $sub2; $difference *= (-1) if ($difference < 0); my $seconds = $difference % 60; $difference = ($difference - $seconds) / 60; my $minutes = $difference % 60; $difference = ($difference - $minutes) / 60; my $hours = $difference % 24; $difference = ($difference - $hours) / 24; my $days = $difference % 7; my $weeks = ($difference - $days) / 7; my $time; $time = "$weeks week" . ($weeks == 1 ? "" : "s") . ", " if ($weeks); $time .= "$days day" . ($days == 1 ? "" : "s") . ", " if ($weeks || $days); $time .= "$hours hour" . ($hours == 1 ? "" : "s") . ", " if ($weeks || $days || $hours); $time .= "$minutes minute" . ($minutes == 1 ? "" : "s") . ", " if ($weeks || $days || $hours || $minutes); $time .= "$seconds second" . ($seconds == 1 ? "" : "s") if ($weeks || $days || $hours || $minutes || $seconds); return $time; } sub time_parse { my $time = $_[0]; my $parsed_time = 0; # milliseconds while ($time =~ s/(\d+)\s*(?:milliseconds|ms)//g) { $parsed_time += $1; } # seconds while ($time =~ s/(\d+)\s*s(?:econds?)?//g) { $parsed_time += $1 * 1000; } # minutes while ($time =~ s/(\d+)\s*m(?:inutes?)?//g) { $parsed_time += $1 * 1000 * 60; } # hours while ($time =~ s/(\d+)\s*h(?:ours?)?//g) { $parsed_time += $1 * 1000 * 60 * 60; } # days while ($time =~ s/(\d+)\s*d(?:ays?)?//g) { $parsed_time += $1 * 1000 * 60 * 60 * 24; } # weeks while ($time =~ s/(\d+)\s*w(?:eeks?)?//g) { $parsed_time += $1 * 1000 * 60 * 60 * 24 * 7; } if ($time !~ /^\s*$/) { print_err('Error while parsing the date!'); return 0; } return $parsed_time; } ################################################################################ # Debugging ################################################################################ sub debug_message { open(DEBUG, ">>", "$ENV{HOME}/.dau/.debug"); print DEBUG $_[0]; close (DEBUG); } #BEGIN { # use warnings; # # open(STDERR, ">>", $ENV{HOME}/.dau/.STDERR"); #}