Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
5751 lines (4606 sloc) 165 KB
################################################################################
# $Id: dau.pl 273 2008-02-03 15:27:25Z heidinger $
################################################################################
#
# dau.pl - write like an idiot
#
################################################################################
# Author
################################################################################
#
# Clemens Heidinger <heidinger@dau.pl>
#
################################################################################
# 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} = <<END;
%9--away%9
Toggle away mode
%9-channels%9 %U'#channel1/network1, #channel2/network2, ...'%U:
Say away message in all those %Uchannels%U
%9-interval%9 %Utime%U:
Remind channel now and then that you're away
%9-reminder%9 %Uon|off%U:
Turn reminder on or off
%9--babble%9
Babble a message.
%9-at%9 %Unicks%U:
Comma separated list of nicks to babble at.
\$nick1, \$nick2 and so forth of the babble line will be replaced
by those nicks.
%9-cancel%9 %Uon|off%U:
Cancel active babble
%9-filter%9 %Uregular expression%U:
Only let through if the babble matches the %Uregular expression%U
%9-history_size%9 %Un%U:
Set the size of the history for this one babble to %Un%U
%9--boxes%9
Put words in boxes
%9--bracket%9
Bracket the text
%9-left%9 %Ustring%U:
Left bracket
%9-right%9 %Ustring%U:
Right bracket
%9--changelog%9
Print the changelog
%9--chars%9
Only one character each line
%9--color%9
Write in colors
%9-codes%9 %Ucodes%U:
Overrides setting dau_color_codes
%9-random%9 %Uon|off%U:
Choose color randomly from setting dau_color_codes resp.
%9--color -codes%9 or take one by one in the exact order given.
%9-split%9
%Ucapitals%U: Split by capitals
%Uchars%U: Every character another color
%Ulines%U: Every line another color
%Uparagraph%U: The whole paragraph in one color
%Urchars%U: Some characters one color
%Uwords%U: Every word another color
%9--command%9
%9-in%9 %Ucommand%U:
Feed dau.pl with the output (the public message)
that %Ucommand%U produces
%9-out%9 %Ucommand%U:
%Utopic%U for example will set a dauified topic
%9--cool%9
Be \$cool[tm]!!!!11one
%9-eol_style%9 %Ustring%U:
Override setting dau_cool_eol_style
%9-max%9 %Un%U:
\$Trademarke[tm] only %Un%U words per line tops
%9-prob_eol%9 %U0-100%U:
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.
%9-prob_word%9 %U0-100%U:
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.
%9--cowsay%9
Use cowsay to write
%9-arguments%9 %Uarguments%U:
Pass any option to cowsay, f.e. %U'-b'%U or %U'-e XX'%U.
Look in the cowsay manualpage for details.
%9-cow%9 %Ucow%U:
The cow to use
%9-think%9 %Uon|off%U:
Thinking instead of speaking
%9--create_files%9
Create files and directories of all dau_files_* settings
%9--daumode%9
Toggle daumode.
Works on a per channel basis!
%9-modes_in%9 %Umodes%U:
All incoming messages will be dauified and the
specified modes are used by dau.pl.
%9-modes_out%9 %Umodes%U:
All outgoing messages will be dauified and the
specified modes are used by dau.pl.
%9-perm%9 %U[01][01]%U:
Dauify incoming/outgoing messages?
%9--delimiter%9
Insert a delimiter-string after each character
%9-string%9 %Ustring%U:
Override setting dau_delimiter_string. If this string
contains whitespace, you should quote the string with
single quotes.
%9--dots%9
Put dots... after words...
%9--figlet%9
Use figlet to write
%9-font%9 %Ufont%U:
The font to use
%9--help%9
Print help
%9-setting%9 %Usetting%U:
More information about a specific setting
%9--leet%9
Write in leet speech
%9--long_help%9
Long help, i.e. examples, more about some features, ...
%9--me%9
Send a CTCP ACTION instead of a PRIVMSG
%9--mix%9
Mix all the characters in a word except for the first and last
%9--mixedcase%9
Write in mixed case
%9--moron%9
Write in uppercase, mix in some typos, perform some
substitutions on the text, ... Just write like a
moron
%9-eol_style%9 %Ustring%U:
Override setting dau_moron_eol_style
%9-level%9 %Un%U:
%Un%U gives the level of stupidity applied to text,
the higher the stupider.
%U0%U is the minimum, %U1%U currently only implemented for dau_language = de.
%9-omega%9 %Uon|off%U:
The fantastic omega mode
%9-typo%9 %Uon|off%U:
Mix in random typos
%9-uppercase%9 %Uon|off%U:
Uppercase text
%9--nothing%9
Do nothing
%9--parse_special%9
Parse for special metasequences and substitute them.
%9-irssi_variables%9 %Uon|off%U:
Parse irssi special variables like \$N
%9-list_delimiter%9 %Ustring%U:
Set the list delimiter used for \@nicks and \@opnicks to %Ustring%U.
The special metasequences are:
- \\n:
real newline
- \$nick1 .. \$nickN:
N different randomly selected nicks
- \@nicks:
All nicks in channel
- \$opnick1 .. \$opnickN:
N different randomly selected opnicks
- \@opnicks:
All nicks in channel with operator status
- \$?{ code }:
the (perl)code will be evaluated and the last expression
returned will replace that metasequence
- irssis special variables like \$C for the current
channel and \$N for your current nick
Quoting:
- \\\$: literal \$
- \\\\: literal \\
%9--random%9
Let dau.pl choose the options randomly. Get these options from the setting
dau_random_options.
%9-verbose%9 %Uon|off%U:
Print what options --random has chosen
%9--reverse%9
Reverse the input string
%9--stutter%9
Stutter a bit
%9--substitute%9
Apply own substitutions from file
%9--underline%9
Underline text
%9--uppercase%9
Write in upper case
%9--words%9
Only a few words each line
END
# Containing irssi's 'cmdchars'
our $k = Irssi::parse_special('$k');
# Remember your nick mode
our %nick_mode;
# All the options
our %option;
# print() the message or not?
our $print_message;
# Queue holding the switches
our %queue;
# Remember the last switches used by --random so that they don't repeat
our $random_last;
# Signals
our %signal = (
'complete word' => 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 <interval>" resp. dau_away_reminder_interval setting
################################################################################
# If called from command line, i.e. not by the
# "/dau --away -channels '<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 <on|off>" resp. dau_away_reminder setting
################################################################################
# If called from command line, i.e. not by "/dau --away -channels '<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 '<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 '<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 <zond\@troja.ath.cx>)
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<channel>/<network>:<switches>, ...%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 <bar> add [-alignment <left|right>] 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>
$command_out = return_option('command', 'out');
$command_out_activated = 1;
# -in <command>
$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
################################################################################
# <color code>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 = <HIS_ERR>;
my @outlines = <HIS_OUT>;
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 = <HIS_ERR>;
my @outlines = <HIS_OUT>;
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 <zond@troja.ath.cx>
# 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