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