1# unleash the gay!!! shoutz to #insub 2# author: cj_ <rover@gruntle.org> 3# type /gay help for usage after loading 4# 5# "If used sparingly, and in good taste, ASCII art generally 6# is very well-received !" 7# -- Some Sucker 8 9use Irssi; 10use Irssi::Irc; 11use Text::Wrap; 12use strict; 13use vars qw($VERSION %IRSSI $SPLASH); 14 15$VERSION = "4.1"; 16%IRSSI = ( 17 author => 'cj_', 18 contact => 'rover@gruntle.org', 19 download => 'http://gruntle.org/projects/irssi/gay', 20 name => 'gay', 21 description => 'a lot of annoying ascii color/art text filters', 22 license => 'Public Domain', 23 changed => 'Thu Aug 14 15:21:02 PDT 2003', 24 version => $VERSION, 25); 26 27############################################################ 28# this is for displaying in various places to bug the user # 29############################################################ 30 31# usage/contact info 32$SPLASH = "$IRSSI{name} $IRSSI{version} by $IRSSI{author} <$IRSSI{contact}>"; 33 34# quick help 35my $USAGE = <<EOU; 36/COMMAND [-123456] [-blink] [-msg <target>] [-pre <text>] 37 [-fig] [-font <font>] [-cow] [-cowfile <file>] 38 [-matrix] [-box|-3d|-arrow] [-check|capchk] 39 [-spook] [-rev] [-leet] <text> 40EOU 41 42# for /gay col, list colormap 43my $COLMAP = <<COLMAP; 440,1\26\26 0 = white 451,0\26\26 1 = black 462,1\26\26 2 = blue 473,1\26\26 3 = green 484,1\26\26 4 = orange 495,1\26\26 5 = red (yellow in epic/bx) 506,1\26\26 6 = magenta 517,1\26\26 7 = yellow (red in epic/bx) 528,1\26\26 8 = bright yellow 539,1\26\26 9 = bright green 5410,1\26\26 10 = cyan 5511,1\26\26 11 = gray 5612,1\26\26 12 = bright blue 5713,1\26\26 13 = bright purple 5814,1\26\26 14 = dark gray 5915,1\26\26 15 = light gray 60COLMAP 61 62# spook array.. in a perfect world this would 63# be in its own file. this is stolen right out of emacs. gg 64 65my @spook_lines = ( 66 "\$400 million in gold bullion", 67 "[Hello to all my fans in domestic surveillance]", "AK-47", 68 "ammunition", "arrangements", "assassination", "BATF", "bomb", "CIA", 69 "class struggle", "Clinton", "Cocaine", "colonel", 70 "counter-intelligence", "cracking", "Croatian", "cryptographic", 71 "Delta Force", "DES", "domestic disruption", "explosion", "FBI", "FSF", 72 "fissionable", "Ft. Bragg", "Ft. Meade", "genetic", "Honduras", 73 "jihad", "Kennedy", "KGB", "Khaddafi", "kibo", "Legion of Doom", 74 "Marxist", "Mossad", "munitions", "Nazi", "Noriega", "North Korea", 75 "NORAD", "NSA", "nuclear", "Ortega", "Panama", "Peking", "PLO", 76 "plutonium", "Qaddafi", "quiche", "radar", "Rule Psix", 77 "Saddam Hussein", "SDI", "SEAL Team 6", "security", "Semtex", 78 "Serbian", "smuggle", "South Africa", "Soviet ", "spy", "strategic", 79 "supercomputer", "terrorist", "Treasury", "Uzi", "Waco, Texas", 80 "World Trade Center", 81); 82 83# leet mapping 84my $leet_map = { 85 a => [ "4", "/\\", "@", "a", "A" ], 86 b => [ "|o", "b", "B" ], 87 c => [ "C", "c", "<" ], 88 d => [ "d", "D", "|)" ], 89 e => [ "e", "E", "3" ], 90 f => [ "f", "F", "/=" ], 91 g => [ "g", "G", "6" ], 92 h => [ "h", "H", "|-|" ], 93 i => [ "i", "I", "|", "1" ], 94 j => [ "j", "J" ], 95 k => [ "keke", "x", "X", "k", "K", "|<" ], 96 l => [ "l", "L", "7", "|_" ], 97 m => [ "|V|", "|\\/|", "m", "M" ], 98 n => [ "n", "N", "|\\|" ], 99 o => [ "0", "o", "O", "()", "[]", "<>" ], 100 p => [ "p", "P", "9" ], 101 q => [ "q", "Q" ], 102 r => [ "r", "R" ], 103 s => [ "s", "S", "5" ], 104 t => [ "t", "T", "7" ], 105 u => [ "|_|", "u", "U", "\\/" ], 106 v => [ "v", "V", "\\/" ], 107 w => [ "w", "W", "uu", "UU", "uU", "Uu", "\\/\\/" ], 108 x => [ "x", "X", "><" ], 109 y => [ "y", "Y" ], 110 z => [ "z", "Z", "5" ], 111}; 112 113 114# handler to reap dead children 115# need this to avoid zombie/defunt processes 116# waiting around to have their exit status read 117my $child_pid; 118sub sigchild_handler { 119 waitpid($child_pid, 0); 120} 121 122# declar this a global to prevent gay.pl 123# from constantly checking 124my $cowpath; 125 126# markup stuff 127my $COWCUT = "---COWCUT---"; 128 129############################### 130# these are the main commands # 131############################### 132 133# these are aliases that use a predefined set of filters 134sub gv { process("v", @_) } # display version info 135sub colcow { process("cr", @_) } # cowsay -> rainbow 136sub figcow { process("cf", @_) } # figlet -> cowsay 137sub figcolcow { process("crf", @_) } # figlet -> cowsay -> rainbow 138sub colfig { process("rf", @_) } # figlet -> rainbow 139sub gayexec { process("e", @_) } # execute 140sub gaycat { process("x", @_) } # gaycat w/ byte restriction 141sub spook { process("s", @_) } # spook 142 143# main interface command. without switches, it's 144# just like /say 145sub gay { 146 my $text = shift; 147 if ($text =~ /^help/i) { 148 # show help 149 show_help(); 150 } elsif ($text =~ /^vers/i) { 151 # just show version 152 Irssi::print($SPLASH); 153 } elsif ($text =~ /^update/i) { 154 # contact mothership and update 155 update(); 156 } elsif ($text =~ /^usage/i) { 157 show_error($USAGE); 158 } elsif ($text =~ /^col/i) { 159 show_error($COLMAP); 160 } else { 161 # raw command. w/o switches, will just 162 # be a /say 163 process(undef, $text, @_); 164 } 165} 166 167############################### 168# this handles the processing # 169############################### 170 171sub process { 172 my ($flags, $text, $server, $dest) = @_; 173 174 if (!$server || !$server->{connected}) { 175 Irssi::print("Not connected to server"); 176 return; 177 } 178 179 return unless $dest; 180 181 # set up defaults 182 my @text; 183 my $prefix; 184 my $style = Irssi::settings_get_int("gay_default_style"); 185 my $cowfile = Irssi::settings_get_str("cowfile"); 186 my $figfont = Irssi::settings_get_str("figfont"); 187 my $sendto = $dest->{name}; 188 189 # parse args 190 my @args = shell_args($text); 191 while (my $arg = shift(@args)) { 192 if ($arg =~ /^-msg/) { $sendto = shift(@args); next } 193 if ($arg =~ /^-pre/) { $prefix = shift(@args); next } 194 if ($arg =~ /^-blink/) { $flags .= "b"; next } 195 if ($arg =~ /^-jive/) { $flags .= "j"; next } 196 if ($arg =~ /^-cowfile/) { $cowfile = shift(@args); next } 197 if ($arg =~ /^-cow/) { $flags .= "c"; next } 198 if ($arg =~ /^-fig/) { $flags .= "f"; next } 199 if ($arg =~ /^-font/) { $figfont = shift(@args); next } 200 if ($arg =~ /^-box/) { $flags .= "o"; next } 201 if ($arg =~ /^-3d/) { $flags .= "3"; next } 202 if ($arg =~ /^-arrow/) { $flags .= "a"; next } 203 if ($arg =~ /^-check/) { $flags .= "C"; next } 204 if ($arg =~ /^-capchk/) { $flags .= "h"; next } 205 if ($arg =~ /^-matrix/) { $flags .= "m"; next } 206 if ($arg =~ /^-spook/) { $flags .= "s"; next } 207 if ($arg =~ /^-rev/) { $flags .= "R"; next } 208 if ($arg =~ /^-leet/) { $flags .= "l"; next } 209 if ($arg =~ /^-(\d)$/) { $flags .= "r"; $style = $1; next } 210 211 # doesn't match arguments, must be text! 212 push(@text, $arg); 213 } 214 $text = join(" ", @text); 215 $text =~ s/\\n/\n/sg; 216 217 # for outlining, precedence must be set 218 # 3dbox > arrow > box 219 $flags =~ s/(o|a)//g if $flags =~ /3/; 220 $flags =~ s/o//g if $flags =~ /a/; 221 222 # check should override rainbow for now 223 $flags =~ s/r//g if $flags =~ /C/; 224 225 # ... so should capchk, unless it's a cow, in which case 226 # we invoke cowcut-fu 227 my $cowcut = 0; 228 if ($flags =~ /h/) { 229 # yes, capchk was specified 230 if ($flags =~ /c/ and $flags =~ /r/) { 231 $cowcut = 1; 232 } else { 233 $flags =~ s/r//g; 234 } 235 } 236 237 # capchk takes precedence over check 238 $flags =~ s/C//g if $flags =~ /h/; 239 240 241 ############################## 242 # filter text based on flags # 243 ############################## 244 245 # where to get text 246 $text = "$IRSSI{name} $IRSSI{version} - $IRSSI{download}" if $flags =~ /v/; 247 $text = execute($text) if $flags =~ /e/; 248 $text = slurp($text) if $flags =~ /x/; 249 $text = spookify($text) if $flags =~ /s/; 250 251 # change the text contents itself 252 $text = jive($text) if $flags =~ /j/; 253 $text = leet($text) if $flags =~ /l/; 254 $text = reverse($text) if $flags =~ /R/; 255 $text = matrix($text) if $flags =~ /m/; 256 257 # change the text appearance 258 $text = figlet($text, $figfont) if $flags =~ /f/; 259 $text = wrap($text) if $flags !~ /f/; 260 261 # change the text presentation 262 $text = checker($text) if $flags =~ /h/; 263 $text = cowsay($text, $cowfile, $cowcut) if $flags =~ /c/; 264 $text = checker($text) if $flags =~ /C/; 265 266 # draw a box, pass a style flag 267 $text = outline($text, 0) if $flags =~ /o/; 268 $text = outline($text, 1) if $flags =~ /3/; 269 $text = outline($text, 2) if $flags =~ /a/; 270 271 # change the final products visual appearance 272 $text = rainbow($text, $style) if $flags =~ /r/; 273 $text = blink($text) if $flags =~ /b/; 274 275 ######################## 276 # output final product # 277 ######################## 278 279 foreach my $line (split(/\n/, $text)) { 280 $line = "$prefix $line" if ($prefix); 281 $server->command("msg $sendto $line"); 282 } 283} 284 285###################################################### 286# these filters pass text through various gayalizers # 287###################################################### 288 289sub find_cowpath { 290 # see if we can find the program 291 my $cowsay_cmd = Irssi::settings_get_str('cowsay_cmd'); 292 $cowsay_cmd = -x $cowsay_cmd ? $cowsay_cmd : whereis("cowsay"); 293 unless (-x $cowsay_cmd) { 294 Irssi::print("$cowsay_cmd not found or not executable!"); 295 return; 296 } 297 298 unless (open(COWSAY, "<$cowsay_cmd")) { 299 Irssi::print("problem reading $cowsay_cmd"); 300 return; 301 } 302 303 my $find_cowpath; 304 while (my $line = <COWSAY>) { 305 if ($line =~ m!^\$cowpath = \$ENV\{'COWPATH'\} \|\| '(.*?)';!) { 306 $find_cowpath = $1; 307 last; 308 } 309 } 310 311 close COWSAY; 312 313 if (!$find_cowpath) { Irssi::print("I was unable to find the cowpath!") } 314 return $find_cowpath; 315} 316 317sub cowsay { 318 # my cowsay implementation.. because normal cowsay 319 # messes up bubble-size if you have imbedded 320 # color codes.. this works pretty much the same, 321 # except it doesn't have support for stuff like 322 # tongue and eyes. 323 324 my $text = shift; 325 my $cowfile = shift || "default"; 326 my $cowcut = shift; 327 328 # my mother tried to find my cowpath once.. once. 329 if (!$cowpath) { $cowpath = $ENV{COWPATH} || find_cowpath() } 330 331 my @output; 332 333 # this is the whole point of doing my own cowsay 334 my $length = 0; 335 my @text = split(/\n/, $text); 336 foreach my $line (@text) { 337 my $l = clean_length($line); 338 $length = $l if $l > $length; 339 } 340 341 # add filler to the end 342 foreach my $line (@text) { 343 $line .= (" " x ($length - clean_length($line))); 344 } 345 346 my $div = " " . ("-" x ($length+2)); 347 push(@output, $div); 348 push(@output, $COWCUT) if $cowcut; 349 my $count = 0; 350 my $total = scalar(@text) - 1; 351 foreach my $line (@text) { 352 if ($total == 0) { 353 push(@output, "< $line >"); 354 } elsif ($count == 0) { 355 push(@output, "/ $line \\"); 356 } elsif ($count == $total) { 357 push(@output, "\\ $line /"); 358 } else { 359 push(@output, "| $line |"); 360 } 361 $count++; 362 } 363 364 # this is rainbow() markup for toggling colorize 365 push(@output, $COWCUT) if $cowcut; 366 push(@output, $div); 367 368 369 my $full; 370 $cowfile .= ".cow" unless ($cowfile =~ /\.cow$/); 371 if ($cowfile =~ m!/!) { 372 $full = $cowfile; 373 } else { 374 foreach my $path (split(/:/, $cowpath)) { 375 if (-f "$path/$cowfile") { 376 $full = "$path/$cowfile"; 377 last; 378 } 379 } 380 } 381 382 unless (-f $full) { 383 Irssi::print("could not find cowfile: $cowfile"); 384 return; 385 } 386 387 my $the_cow = ""; 388 my $thoughts = '\\'; 389 my $eyes = "oo"; 390 my $tongue = " "; 391 392 393 unless (open(IN, "<$full")) { 394 Irssi::print("couldn't read $full: $!"); 395 return; 396 } 397 my $cow_code = join('', <IN>); 398 close IN; 399 400 eval $cow_code; 401 402 push(@output, split(/\n/, $the_cow)); 403 return join("\n", @output); 404} 405 406sub figlet { 407 # pass text through figlet 408 my $text = shift; 409 my $figlet_font = shift || 'standard'; 410 my $figlet_wrap = Irssi::settings_get_int('linewrap'); 411 412 # see if we can find the program 413 my $figlet_cmd = Irssi::settings_get_str('figlet_cmd'); 414 $figlet_cmd = -x $figlet_cmd ? $figlet_cmd : whereis("figlet"); 415 unless (-x $figlet_cmd) { 416 Irssi::print("$figlet_cmd not found or not executable!"); 417 return; 418 } 419 420 open3(*READ, *WRITE, *ERR, "$figlet_cmd -f $figlet_font -w $figlet_wrap"); 421 print WRITE $text; 422 close WRITE; 423 424 $text = join('', <READ>); 425 close READ; 426 427 # check for errors 428 show_error(join('', <ERR>)); 429 close ERR; 430 431 $text =~ s/^\s+\n//g; # sometime sit leaves leading blanks too! 432 $text =~ s/\n\s+\n$//s; # figlet leaves a trailing blank line.. sometimes 433 434 return $text; 435} 436 437sub jive { 438 # pass text through jive filter 439 my $text = shift; 440 441 # see if we can find the program 442 my $jive_cmd = Irssi::settings_get_str('jive_cmd'); 443 $jive_cmd = -x $jive_cmd ? $jive_cmd : whereis("jive"); 444 unless (-x $jive_cmd) { 445 Irssi::print("$jive_cmd not found or not executable!"); 446 return; 447 } 448 449 open3(*READ, *WRITE, *ERR, "$jive_cmd"); 450 print WRITE $text; 451 close WRITE; 452 453 $text = join('', <READ>); 454 close READ; 455 456 # check for errors 457 show_error(join('', <ERR>)); 458 close ERR; 459 460 return $text; 461} 462 463sub checker { 464 # checker filter. thanks to uke, my gay competition 465 my $text = shift; 466 my $checksize = Irssi::settings_get_int('check_size'); 467 my $checktext = Irssi::settings_get_int('check_text'); 468 469 my @colors = split(/\s*,\s*/, Irssi::settings_get_str("check_colors")); 470 471 my $rownum = 0; 472 my $offset = 0; 473 my @text = split(/\n/, $text); 474 475 # what is the longest line? 476 my $length = 0; 477 foreach my $line (@text) { 478 $length = length($line) if length($line) > $length; 479 } 480 481 foreach my $line (@text) { 482 # pad line with whitespace 483 $line .= (" " x ($length - length($line))); 484 485 my $newline; 486 my $state = 0; 487 for (my $i = 0; $i < length($line); $i = $i + $checksize) { 488 my $chunk = substr($line, $i, $checksize); 489 my $index = ($state + $offset); $index -= scalar(@colors) if $index >= scalar(@colors); 490 491 # figure out color code 492 my $code = "\x03" . $checktext . "," . $colors[$index] . "\26\26"; 493 494 $newline .= "$code$chunk"; 495 $state++; $state = 0 if $state >= scalar(@colors); 496 } 497 # make sure it is reset to default so colors don't "leak" 498 # into the outline() routine 499 $line = $newline . "[0m"; 500 501 # increment rowcount/swap offset 502 $rownum++; 503 if ($rownum == $checksize) { 504 $rownum = 0; 505 $offset++; $offset = 0 if $offset >= scalar(@colors); 506 } 507 } 508 return join("\n", @text); 509} 510 511sub rainbow { 512 # make colorful text 513 my ($text, $style) = @_; 514 515 # calculate stateful color offset 516 my $state_offset = 0; 517 if (Irssi::settings_get_bool("rainbow_keepstate")) { 518 $state_offset = Irssi::settings_get_int("rainbow_offset"); 519 if ($state_offset < 0 or $state_offset > 20) { 520 $state_offset = 0; 521 } else { 522 $state_offset++; 523 } 524 525 Irssi::settings_set_int("rainbow_offset", $state_offset); 526 } 527 528 # generate colormap based on style 529 my @colormap; 530 if ($style == 1) { 531 # rainbow 532 @colormap = (4,4,7,7,5,5,8,8,9,9,3,3,10,10,11,11,12,12,2,2,6,6,13,13); 533 } elsif ($style == 2) { 534 # patriotic 535 @colormap = (4,4,0,0,12,12,4,4,0,0,12,12,4,4,0,0,12,12,4,4,0,0,12,12); 536 } elsif ($style == 3) { 537 # random colors 538 while (scalar(@colormap) < 24) { 539 my $color = int(rand(0) * 15) + 1; 540 $color = 0 if $color == 1; 541 push(@colormap, $color); 542 } 543 } elsif ($style == 4) { 544 # alternating colors shade, color is random 545 my $rand = int(rand(0) * 6) + 1; 546 if ($rand == 1) { 547 # blue 548 @colormap = (2,12,2,12,2,12,2,12,2,12,2,12,2,12,2,12,2,12,2,12,2,12,2,12); 549 } elsif ($rand == 2) { 550 # green 551 @colormap = (3,9,3,9,3,9,3,9,3,9,3,9,3,9,3,9,3,9,3,9,3,9,3,9); 552 } elsif ($rand == 3) { 553 # purple 554 @colormap = (6,13,6,13,6,13,6,13,6,13,6,13,6,13,6,13,6,13,6,13,6,13,6,13); 555 } elsif ($rand == 4) { 556 # gray 557 @colormap = (14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15); 558 } elsif ($rand == 5) { 559 # yellow 560 @colormap = (7,8,7,8,7,8,7,8,7,8,7,8,7,8,7,8,7,8,7,8,7,8,7,8); 561 } elsif ($rand == 6) { 562 # red 563 @colormap = (4,5,4,5,4,5,4,5,4,5,4,5,4,5,4,5,4,5,4,5,4,5,4,5); 564 } 565 } elsif ($style == 5) { 566 # alternating shades of grey. i liked this one so much i gave 567 # it its own style. does NOT like to blink, though 568 @colormap = (14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15,14,15); 569 } elsif ($style == 6) { 570 # greyscale 571 @colormap = (0,0,15,15,11,11,14,14,11,11,15,15,0,0,15,15,11,11,14,14,11,11,15,15); 572 } else { 573 # invalid style setting 574 Irssi::print("invalid style setting: $style"); 575 return; 576 } 577 578 # this gets toggle if cowcut markup is seen 579 my $colorize = 1; 580 581 # colorize.. thanks 2 sisko 582 my $newtext; 583 my $row = 0; 584 foreach my $line (split(/\n/, $text)) { 585 if ($line =~ /$COWCUT/) { 586 # toggle state when we see this 587 $colorize++; 588 $colorize = 0 if $colorize == 2; 589 next; 590 } 591 592 if ($colorize == 0) { 593 $newtext .= "$line\n"; 594 next; 595 } 596 597 for (my $i = 0; $i < length($line); $i++) { 598 my $chr = substr($line, $i, 1); 599 my $color = $i + $row + $state_offset; 600 $color = $color ? $colormap[$color %($#colormap-1)] : $colormap[0]; 601 $newtext .= "\003$color" unless ($chr =~ /\s/); 602 my $ord = ord($chr); 603 if (($ord >= 48 and $ord <= 57) or $ord == 44) { 604 $newtext .= "\26\26"; 605 } 606 $newtext .= $chr; 607 } 608 $newtext .= "\n"; 609 $row++; 610 } 611 612 return $newtext; 613} 614 615sub blink { 616 # make the text blink 617 my $text = shift; 618 my @newtext; 619 foreach my $line (split(/\n/, $text)) { 620 push(@newtext, "[5m$line[0m"); 621 } 622 return join("\n", @newtext); 623} 624 625sub clean_length { 626 my $text = shift; 627 $text =~ s/\x03\d+(,\d+)?(\26\26)?//g; 628 $text =~ s/\[0m//g; 629 return length($text); 630} 631 632sub matrix { 633 # 0-day greetz to EnCapSulaTE1!11!one 634 my $text = shift; 635 my $size = Irssi::settings_get_int("matrix_size"); 636 my $spacing = Irssi::settings_get_int("matrix_spacing"); 637 638 $size = 1 if ($size < 1); 639 640 # first, let's dispense with the newlinesa 641 # because they have no meaning up/down 642 $text =~ s/\n/ /sg; 643 644 my @text; 645 for (my $i = 0; $i < length($text); $i += $size) { 646 my $chunk = substr($text, $i, $size); 647 for (my $j = 0; $j < length($chunk); $j++) { 648 $text[$j] .= substr($chunk, $j, 1) . (" " x $spacing); 649 } 650 } 651 return join("\n", @text); 652} 653 654sub outline { 655 # draw a box around text.. thanks 2 twid 656 # for the idea 657 my ($text, $style) = @_; 658 my ($_3d, $_arrow); 659 660 if ($style == 1) { 661 $_3d = 1; 662 } elsif ($style == 2) { 663 # arrow-style, thanks to rob 664 $_arrow = 1; 665 } 666 667 my @text = split(/\n/, $text); 668 669 # what is the longest line 670 my $length = 0; 671 672 foreach my $line (@text) { 673 $length = clean_length($line) if clean_length($line) > $length; 674 } 675 676 # add box around each line 677 my $lc = "|"; my $rc = "|"; 678 if ($_arrow) { $lc = ">"; $rc = "<" } 679 foreach my $line (@text) { 680 $line = "$lc $line" . (" " x ($length - clean_length($line) + 1)) . "$rc"; 681 $line .= " |" if ($_3d); 682 } 683 684 # top/bottom frame 685 my ($top_frame, $bottom_frame); 686 if ($_arrow) { 687 $top_frame = "\\" . ("^" x ($length + 2)) . "/"; 688 $bottom_frame = "/" . ("^" x ($length + 2)) . "\\"; 689 } else { 690 $top_frame = "+" . ("-" x ($length + 2)) . "+"; 691 $bottom_frame = $top_frame; 692 } 693 694 695 if ($_3d) { 696 push(@text, $bottom_frame . "/"); 697 unshift(@text, $top_frame . " |"); 698 } else { 699 push(@text, $bottom_frame); 700 unshift(@text, $top_frame); 701 } 702 703 if ($_3d) { 704 unshift(@text, " /" . (" " x ($length + 2)) . "/|"); 705 unshift(@text, " " . ("_" x ($length + 3))); 706 } 707 708 709 return join("\n", @text); 710} 711 712sub whereis { 713 # evaluate $PATH, since this doesn't seem to be inherited 714 # in sh subproccess in irssi.. odd 715 my $cmd = shift; 716 foreach my $path (split(/:/, $ENV{PATH})) { 717 my $test = "$path/$cmd"; 718 if (-x $test) { 719 return $test; 720 } 721 } 722} 723 724sub slurp { 725 # read in a file with max setting (useful for catting /dev/urandom :D ) 726 # maybe make this read in chunks, not by line, or something.. seems clumsy 727 my $file = shift; 728 729 # expand ~ 730 $file =~ s!^~([^/]*)!$1 ? (getpwnam($1))[7] : ($ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7])!ex; 731 732 unless (open(IN, "<$file")) { 733 Irssi::print("could not open $file: $!"); 734 return; 735 } 736 737 my $max = Irssi::settings_get_int("colcat_max"); 738 my $text; 739 while (my $line = <IN>) { 740 $text .= $line; 741 last if length($text) >= $max; 742 } 743 close IN; 744 745 return $text; 746} 747 748sub execute { 749 # execute command and return output 750 my $text = shift; 751 752 open3(*READ, *WRITE, *ERR, $text); 753 close WRITE; 754 755 $text = join('', <READ>); 756 close READ; 757 758 # check for errors 759 show_error(join('', <ERR>)); 760 close ERR; 761 762 return $text; 763} 764 765 766 767sub show_help { 768 my $help = <<EOH; 769$USAGE 770 771STYLES: 772-1 rainbow 773-2 red white and blue 774-3 random colors 775-4 random alternating colors 776-5 alternating gray 777-6 greyscale 778 779COMMANDS: 780/gay just like /say, but gay 781/gayexec like /exec, but gayer 782/gaycat pipe a file 783/gay help this help screen 784/gay version show version information 785/gay usage just show usage line 786/gay update check for new release & update 787/gv tell the world you're gay 788 789ALIASES: 790/colcow <text> color cowsay 791/figcow <text> cowsay w/ figlet fonts 792/figcolcow <text> color cow talking figlet 793/colfig <text> color figlet 794/spook interject spook stuff 795 796SETTINGS: 797 798/set cowfile <cowsay file> 799/set figfont <figlet file> 800/set linewrap <# to wrap at> 801/set cowsay_cmd <path to cowsay program> 802/set figlet_cmd <path to figlet program> 803/set jive_cmd <path to jive program> 804/set colcat_max # (max bytes to show for /colcat) 805/set gay_default_style # 806/set rainbow_keepstate <ON|OFF> 807/set check_size # 808/set check_colors #,#,... 809/set check_text # 810/set matrix_size, # 811/set matrix_spacing # 812/set spook_words # (# of words for spook to use) 813EOH 814 Irssi::print(draw_box($SPLASH, $help, undef, 1), MSGLEVEL_CLIENTCRAP); 815} 816 817sub draw_box { 818 # taken from a busted script distributed with irssi 819 # just a simple ascii line-art around help text 820 my ($title, $text, $footer, $color) = @_; 821 $footer = $title unless($footer); 822 my $box; 823 $box .= '%R,--[%n%9%U' . $title . '%U%9%R]%n' . "\n"; 824 foreach my $line (split(/\n/, $text)) { 825 $box .= '%R|%n ' . $line . "\n"; 826 } 827 $box .= '%R`--<%n' . $footer . '%R>->%n'; 828 $box =~ s/%.//g unless $color; 829 return $box; 830} 831 832sub show_error { 833 # take text gathered from STDERR and pass it here 834 # to display to the client 835 my $text = shift; 836 foreach my $line (split(/\n/, $text)) { 837 Irssi::print($line); 838 } 839} 840 841sub open3 { 842 my ($read, $write, $err, $command) = @_; 843 844 pipe($read, RTMP); 845 pipe($err, ETMP); 846 pipe(WTMP, $write); 847 848 select($read); $| = 1; 849 select($err); $| = 1; 850 select($write); $| = 1; 851 select(STDOUT); 852 853 return 0 unless defined $command; 854 855 # fork 856 my $pid = fork(); 857 if ($pid) { 858 # parent 859 $child_pid = $pid; 860 $SIG{CHLD} = \&sigchild_handler; 861 close RTMP; close WTMP; close ETMP; 862 return $pid; 863 } else { 864 # child 865 close $write; close $read; close $err; 866 open(STDIN, "<&WTMP"); close WTMP; 867 open(STDOUT, ">&RTMP"); close RTMP; 868 open(STDERR, ">&ETMP"); close ETMP; 869 exec($command); 870 exit 0; 871 } 872} 873 874sub update { 875 # automatically check for updates 876 my $baseURL = $IRSSI{download}; 877 878 # do we have useragent? 879 eval "use LWP::UserAgent"; 880 if ($@) { 881 Irssi::print("LWP::UserAgent failed to load: $!"); 882 return; 883 } 884 885 # first see what the latest version is 886 my $ua = LWP::UserAgent->new(); 887 my $req = HTTP::Request->new( 888 GET => "$baseURL/CURRENT", 889 ); 890 my $res = $ua->request($req); 891 if (!$res->is_success()) { 892 Irssi::print("Problem contacting the mothership"); 893 return; 894 } 895 896 my $latest_version = $res->content(); chomp $latest_version; 897 Irssi::print("Your version is: $VERSION"); 898 Irssi::print("Current version is: $latest_version"); 899 900 if ($VERSION >= $latest_version) { 901 Irssi::print("You are up to date"); 902 return; 903 } 904 905 # uh oh, old stuff! time to update 906 Irssi::print("You are out of date, fetching latest"); 907 $req = HTTP::Request->new( 908 GET => "$baseURL/gay-$latest_version.pl", 909 ); 910 $res = $ua->request($req); 911 if (!$res->is_success()) { 912 Irssi::print("Problem contacting the mothership"); 913 return; 914 } 915 916 my $src = $res->content(); 917 918 # check for integrity 919 if ($src !~ /(\$VERSION = "$latest_version";)/s) { 920 Irssi::print("Version mismatch, aborting"); 921 return; 922 } 923 924 # where should we save this? 925 my $script_dir = "$ENV{HOME}/.irssi/scripts"; 926 if (! -d $script_dir) { 927 Irssi::print("Could not determine script dir"); 928 return; 929 } 930 931 # save the shit already 932 unless (open(OUT, ">$script_dir/downloaded-gay.pl")) { 933 Irssi::print("Couldn't write to $script_dir/gay.pl: $!"); 934 return; 935 } 936 937 print OUT $src; 938 close OUT; 939 940 # copy to location 941 rename("$script_dir/gay.pl", "$script_dir/gay-$VERSION.pl"); 942 rename("$script_dir/downloaded-gay.pl", "$script_dir/gay.pl"); 943 944 Irssi::print("Updated successfully! '/run gay' to load"); 945} 946 947sub shell_args { 948 # take a command-line and parse 949 # it properly, return array ref 950 # of args 951 my $text = shift; 952 my $arg_hash = { 953 count => 1, 954 }; 955 my @post_cmd; 956 while ($text =~ /((["'])([^\2]*?)\2)/g) { 957 my $arg = $3; 958 my $string = $1; 959 $string =~ s!/!\/!g; 960 my $count = $arg_hash->{count}; 961 $arg_hash->{$count} = $arg; 962 push(@post_cmd, "\$text =~ s/$string/*ARG$count*/"); 963 $count++; 964 $arg_hash->{count} = $count; 965 } 966 967 foreach my $cmd (@post_cmd) { 968 eval $cmd; 969 } 970 971 my @args; 972 foreach my $arg (split(/\s+/, $text)) { 973 if ($arg =~ /^\*ARG(\d+)\*$/) { 974 my $count = $1; 975 if ($arg_hash->{$count}) { 976 $arg = $arg_hash->{$count}; 977 978 } 979 } 980 push(@args, $arg); 981 } 982 983 return @args; 984} 985 986sub spookify { 987 # add emacs spook text. if there is previously existing text, it appends 988 my $text = shift; 989 my $count = Irssi::settings_get_int('spook_words') || return $text; 990 my @spook_words; 991 for (my $i = 0; $i < $count; $i++) { 992 my $word = $spook_lines[int(rand(0) * scalar(@spook_lines))]; 993 push(@spook_words, $word); 994 } 995 my $text = join(" ", @spook_words) . " $text"; 996 return $text; 997} 998 999sub wrap { 1000 # fix that shit 1001 my $text = shift; 1002 my $wrap = Irssi::settings_get_int("linewrap") || return $text; 1003 $Text::Wrap::columns = $wrap; 1004 my @output; 1005 foreach my $line (split(/\n/, $text)) { 1006 if (length($line) > $wrap) { 1007 ($line) = Text::Wrap::wrap(undef, undef, $line); 1008 } 1009 push(@output, $line); 1010 } 1011 1012 $text = join("\n", @output); 1013 return $text; 1014} 1015 1016sub leet { 1017 # leet speak :( 1018 my $text = shift; 1019 my @output; 1020 foreach my $line (split(/\n/, $text)) { 1021 my $newline; 1022 for (my $i = 0; $i < length($line); $i++) { 1023 my $char = lc(substr($line, $i, 1)); 1024 if ($leet_map->{$char}) { 1025 my @possibles = @{$leet_map->{$char}}; 1026 $char = $possibles[int(rand(0) * scalar(@possibles))]; 1027 } 1028 $newline .= $char; 1029 } 1030 push(@output, $newline); 1031 } 1032 return join("\n", @output); 1033} 1034 1035 1036# command bindings 1037Irssi::command_bind("colcow", \&colcow); 1038Irssi::command_bind("figcow", \&figcow); 1039Irssi::command_bind("figcolcow", \&figcolcow); 1040Irssi::command_bind("colfig", \&colfig); 1041Irssi::command_bind("gay", \&gay); 1042Irssi::command_bind("gv", \&gv); 1043Irssi::command_bind("gayexec", \&gayexec); 1044Irssi::command_bind("gaycat", \&gaycat); 1045Irssi::command_bind("spook", \&spook); 1046 1047 1048############ 1049# settings # 1050############ 1051 1052# cowsay 1053Irssi::settings_add_str($IRSSI{name}, 'cowfile', 'default'); 1054Irssi::settings_add_str($IRSSI{name}, 'cowsay_cmd', 'cowsay'); 1055 1056# figlet 1057Irssi::settings_add_str($IRSSI{name}, 'figfont', 'standard'); 1058Irssi::settings_add_int($IRSSI{name}, 'linewrap', 50); 1059Irssi::settings_add_str($IRSSI{name}, 'figlet_cmd', 'figlet'); 1060 1061# rainbow 1062Irssi::settings_add_int($IRSSI{name}, 'rainbow_offset', 0); 1063Irssi::settings_add_bool($IRSSI{name}, 'rainbow_keepstate', 1); 1064Irssi::settings_add_int($IRSSI{name}, 'gay_default_style', 1); 1065 1066# checkers 1067Irssi::settings_add_int($IRSSI{name}, 'check_size', 3); 1068Irssi::settings_add_int($IRSSI{name}, 'check_text', 0); 1069Irssi::settings_add_str($IRSSI{name}, 'check_colors', "4,2"); 1070 1071# the matrix 1072Irssi::settings_add_int($IRSSI{name}, "matrix_size", 6); 1073Irssi::settings_add_int($IRSSI{name}, "matrix_spacing", 2); 1074 1075# misc 1076Irssi::settings_add_int($IRSSI{name}, 'colcat_max', 2048); 1077Irssi::settings_add_str($IRSSI{name}, 'jive_cmd', 'jive'); 1078Irssi::settings_add_int($IRSSI{name}, 'spook_words', 6); 1079 1080########### 1081# startup # 1082########### 1083 1084Irssi::print("$SPLASH. '/gay help' for usage"); 1085 1086 1087