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