1# unleash the gay!!! shoutz to #insub 2# author: cj_ <rover@gruntle.org> 3# type /gay help for usage after loading 4 5use Irssi; 6use Irssi::Irc; 7use strict; 8use vars qw($VERSION %IRSSI $SPLASH); 9 10$VERSION = "2.7"; 11%IRSSI = ( 12 author => 'cj_', 13 contact => 'rover@gruntle.org', 14 download => 'http://gruntle.org/projects/gay', 15 name => 'gay', 16 description => 'a lot of annoying ascii color/art text filters', 17 license => 'Public Domain', 18 changed => 'Wed Jul 16 18:41:52 PDT 2003', 19 version => $VERSION, 20); 21 22# this is for displaying in various places to bug the user 23$SPLASH = "$IRSSI{name} $IRSSI{version} by $IRSSI{author} <$IRSSI{contact}>"; 24 25# handler to reap dead children 26# need this to avoid zombie/defunt processes 27# waiting around to have their exit status read 28my $child_pid; 29sub sigchild_handler { 30 waitpid($child_pid, 0); 31} 32 33############################### 34# these are the main commands # 35############################### 36 37# these are aliases that use a predefined set of filters 38sub gv { process("v", @_) } # display version info 39sub colcow { process("cr", @_) } # cowsay -> rainbow 40sub figcow { process("cf", @_) } # figlet -> cowsay 41sub figcolcow { process("crf", @_) } # figlet -> cowsay -> rainbow 42sub colfig { process("rf", @_) } # figlet -> rainbow 43sub gayexec { process("e", @_) } # execute 44 45# main interface command. without switches, it's 46# just like /say 47sub gay { 48 my $text = shift; 49 if ($text =~ /^help/i) { 50 # show help 51 show_help(); 52 } elsif ($text =~ /^vers/i) { 53 # just show version 54 Irssi::print($SPLASH); 55 } elsif ($text =~ /^update/i) { 56 # contact mothership and update 57 update(); 58 } else { 59 # raw command. w/o switches, will just 60 # be a /say 61 process(undef, $text, @_); 62 } 63} 64 65############################### 66# this handles the processing # 67############################### 68 69sub process { 70 my ($flags, $text, $server, $dest) = @_; 71 72 if (!$server || !$server->{connected}) { 73 Irssi::print("Not connected to server"); 74 return; 75 } 76 77 return unless $dest; 78 79 # set up defaults 80 my @text; 81 my $prefix; 82 my $style = Irssi::settings_get_int("gay_default_style"); 83 my $cowfile = Irssi::settings_get_str("cowfile"); 84 my $figfont = Irssi::settings_get_str("figfont"); 85 my $sendto = $dest->{name}; 86 87 # parse args 88 my @args = shell_args($text); 89 while (my $arg = shift(@args)) { 90 if ($arg =~ /^-msg/) { $sendto = shift(@args); next } 91 if ($arg =~ /^-pre/) { $prefix = shift(@args); next } 92 if ($arg =~ /^-blink/) { $flags .= "b"; next } 93 if ($arg =~ /^-jive/) { $flags .= "j"; next } 94 if ($arg =~ /^-cowfile/) { $cowfile = shift(@args); next } 95 if ($arg =~ /^-cow/) { $flags .= "c"; next } 96 if ($arg =~ /^-fig/) { $flags .= "f"; next } 97 if ($arg =~ /^-font/) { $figfont = shift(@args); next } 98 if ($arg =~ /^-box/) { $flags .= "o"; next } 99 if ($arg =~ /^-(\d)$/) { $flags .= "r"; $style = $1; next } 100 101 # doesn't match arguments, must be text! 102 push(@text, $arg); 103 } 104 $text = join(" ", @text); 105 106 107 ############################## 108 # filter text based on flags # 109 ############################## 110 111 # where to get text 112 $text = "$IRSSI{name} $IRSSI{version} - $IRSSI{download}" if $flags =~ /v/; 113 $text = execute($text) if $flags =~ /e/; 114 $text = slurp($text) if $flags =~ /x/; 115 116 # change the text contents itself 117 $text = jive($text) if $flags =~ /j/; 118 119 # change the text appearance 120 $text = figlet($text, $figfont) if $flags =~ /f/; 121 122 # change the text presentation 123 $text = cowsay($text, $cowfile) if $flags =~ /c/; 124 $text = outline($text) if $flags =~ /o/; 125 126 # change the final products visual appearance 127 $text = rainbow($text, $style) if $flags =~ /r/; 128 $text = blink($text) if $flags =~ /b/; 129 130 ######################## 131 # output final product # 132 ######################## 133 134 foreach my $line (split(/\n/, $text)) { 135 $line = "$prefix $line" if ($prefix); 136 $server->command("msg $sendto $line"); 137 } 138} 139 140###################################################### 141# these filters pass text through various gayalizers # 142###################################################### 143 144sub cowsay { 145 # pass text through cowsay 146 my $text = shift; 147 my $cowsay_font = shift || 'default'; 148 149 # see if we can find the program 150 my $cowsay_cmd = Irssi::settings_get_str('cowsay_cmd'); 151 $cowsay_cmd = -x $cowsay_cmd ? $cowsay_cmd : whereis("cowsay"); 152 unless (-x $cowsay_cmd) { 153 Irssi::print("$cowsay_cmd not found or not executable!"); 154 return; 155 } 156 157 open3(*READ, *WRITE, *ERR, "$cowsay_cmd -n -f $cowsay_font"); 158 print WRITE $text; 159 close WRITE; 160 161 $text = join('', <READ>); 162 close READ; 163 164 # check for errors 165 show_error(join('', <ERR>)); 166 close ERR; 167 168 return $text; 169} 170 171sub figlet { 172 # pass text through figlet 173 my $text = shift; 174 my $figlet_font = shift || 'standard'; 175 my $figlet_wrap = Irssi::settings_get_int('figwrap'); 176 177 # see if we can find the program 178 my $figlet_cmd = Irssi::settings_get_str('figlet_cmd'); 179 $figlet_cmd = -x $figlet_cmd ? $figlet_cmd : whereis("figlet"); 180 unless (-x $figlet_cmd) { 181 Irssi::print("$figlet_cmd not found or not executable!"); 182 return; 183 } 184 185 open3(*READ, *WRITE, *ERR, "$figlet_cmd -f $figlet_font -w $figlet_wrap"); 186 print WRITE $text; 187 close WRITE; 188 189 $text = join('', <READ>); 190 close READ; 191 192 # check for errors 193 show_error(join('', <ERR>)); 194 close ERR; 195 196 $text =~ s/\n\s+\n$//s; # figlet leaves a trailing blank line.. sometimes 197 198 return $text; 199} 200 201sub jive { 202 # pass text through jive filter 203 my $text = shift; 204 205 # see if we can find the program 206 my $jive_cmd = Irssi::settings_get_str('jive_cmd'); 207 $jive_cmd = -x $jive_cmd ? $jive_cmd : whereis("jive"); 208 unless (-x $jive_cmd) { 209 Irssi::print("$jive_cmd not found or not executable!"); 210 return; 211 } 212 213 open3(*READ, *WRITE, *ERR, "$jive_cmd"); 214 print WRITE $text; 215 close WRITE; 216 217 $text = join('', <READ>); 218 close READ; 219 220 # check for errors 221 show_error(join('', <ERR>)); 222 close ERR; 223 224 return $text; 225} 226 227sub rainbow { 228 # take text and make it colorful 229 # 230 # 0 = white 231 # 1 = black 232 # 2 = blue 233 # 3 = green 234 # 4 = orange 235 # 5 = red (yellow in bx/epic/ircii :( ) 236 # 6 = magenta 237 # 7 = yellow (red in bx/epic/ircii :( ) 238 # 8 = bright yellow 239 # 9 = bright green 240 # 10 = cyan 241 # 11 = gray 242 # 12 = bright blue 243 # 13 = bright purple 244 # 14 = dark gray 245 # 15 = light gray 246 247 my ($text, $style) = @_; 248 249 # calculate stateful color offset 250 my $state_offset = 0; 251 if (Irssi::settings_get_bool("rainbow_keepstate")) { 252 $state_offset = Irssi::settings_get_int("rainbow_offset"); 253 if ($state_offset < 0 or $state_offset > 20) { 254 $state_offset = 0; 255 } else { 256 $state_offset++; 257 } 258 259 Irssi::settings_set_int("rainbow_offset", $state_offset); 260 } 261 262 # generate colormap based on style 263 my @colormap; 264 if ($style == 1) { 265 # rainbow 266 @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); 267 } elsif ($style == 2) { 268 # patriotic 269 @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); 270 } elsif ($style == 3) { 271 # random colors 272 while (scalar(@colormap) < 24) { 273 my $color = int(rand(0) * 15) + 1; 274 $color = 0 if $color == 1; 275 push(@colormap, $color); 276 } 277 } elsif ($style == 4) { 278 # alternating colors shade, color is random 279 my $rand = int(rand(0) * 6) + 1; 280 if ($rand == 1) { 281 # blue 282 @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); 283 } elsif ($rand == 2) { 284 # green 285 @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); 286 } elsif ($rand == 3) { 287 # purple 288 @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); 289 } elsif ($rand == 4) { 290 # gray 291 @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); 292 } elsif ($rand == 5) { 293 # yellow 294 @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); 295 } elsif ($rand == 6) { 296 # red 297 @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); 298 } 299 } elsif ($style == 5) { 300 # alternating shades of grey. i liked this one so much i gave 301 # it its own style. does NOT like to blink, though 302 @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); 303 } elsif ($style == 6) { 304 # greyscale 305 @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); 306 } else { 307 # invalid style setting 308 Irssi::print("invalid style setting: $style"); 309 return; 310 } 311 312 # colorize.. thanks 2 sisko 313 my $newtext; 314 my $row = 0; 315 foreach my $line (split(/\n/, $text)) { 316 for (my $i = 0; $i < length($line); $i++) { 317 my $chr = substr($line, $i, 1); 318 my $color = $i + $row + $state_offset; 319 $color = $color ? $colormap[$color %($#colormap-1)] : $colormap[0]; 320 $newtext .= "\003$color" unless ($chr =~ /\s/); 321 my $ord = ord($chr); 322 if (($ord >= 48 and $ord <= 57) or $ord == 44) { 323 $newtext .= "\26\26"; 324 } 325 $newtext .= $chr; 326 } 327 $newtext .= "\n"; 328 $row++; 329 } 330 331 return $newtext; 332} 333 334sub blink { 335 # make the text blink 336 my $text = shift; 337 my @newtext; 338 foreach my $line (split(/\n/, $text)) { 339 push(@newtext, "[5m$line[0m"); 340 } 341 return join("\n", @newtext); 342} 343 344sub outline { 345 # draw a box around text.. thanks 2 twid 346 my $text = shift; 347 my @text = split(/\n/, $text); 348 349 # what is the longest line 350 my $length = 0; 351 foreach my $line (@text) { 352 $length = length($line) if length($line) > $length; 353 } 354 355 # add box around each line 356 foreach my $line (@text) { 357 $line = "| $line" . (" " x ($length - length($line) + 1)) . "|"; 358 } 359 360 # top/bottom frame 361 my $frame = "+" . ("-" x ($length + 2)) . "+"; 362 push(@text, $frame); unshift(@text, $frame); 363 364 return join("\n", @text); 365} 366 367sub whereis { 368 # evaluate $PATH, since this doesn't seem to be inherited 369 # in sh subproccess in irssi.. odd 370 my $cmd = shift; 371 foreach my $path (split(/:/, $ENV{PATH})) { 372 my $test = "$path/$cmd"; 373 if (-x $test) { 374 return $test; 375 } 376 } 377} 378 379sub slurp { 380 # read in a file with max setting (useful for catting /dev/urandom :D ) 381 # maybe make this read in chunks, not by line, or something.. seems clumsy 382 my $file = shift; 383 384 # expand ~ 385 $file =~ s!^~([^/]*)!$1 ? (getpwnam($1))[7] : ($ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7])!ex; 386 387 unless (open(IN, "<$file")) { 388 Irssi::print("could not open $file: $!"); 389 return; 390 } 391 392 my $max = Irssi::settings_get_int("colcat_max"); 393 my $text; 394 while (my $line = <IN>) { 395 $text .= $line; 396 last if length($text) >= $max; 397 } 398 close IN; 399 400 return $text; 401} 402 403sub execute { 404 # execute command and return output 405 my $text = shift; 406 407 open3(*READ, *WRITE, *ERR, $text); 408 close WRITE; 409 410 $text = join('', <READ>); 411 close READ; 412 413 # check for errors 414 show_error(join('', <ERR>)); 415 close ERR; 416 417 return $text; 418} 419 420 421sub show_help { 422 my $help = <<EOH; 423/COMMAND [-123456] [-blink] [-msg <target>] [-pre <prefix text>] 424 [-fig] [-font <figlet font>] [-cow] [-cowfile <cowfile>] 425 [-box] <text> 426 427STYLES: 428-1 rainbow 429-2 red white and blue 430-3 random colors 431-4 random alternating colors 432-5 alternating gray 433-6 greyscale 434 435COMMANDS: 436/gay just like /say, but gay 437/gayexec like /exec, but gayer 438/gay help this help screen 439/gay version show version information 440/gay update check for new release & update 441/gv tell the world you're gay 442 443ALIASES: 444/colcow <text> color cowsay 445/figcow <text> cowsay w/ figlet fonts 446/figcolcow <text> color cow talking figlet 447/colfig <text> color figlet 448 449SETTINGS: 450 451/set cowfile <cowsay file> 452/set figfont <figlet file> 453/set figwrap <# to wrap at> 454/set cowsay_cmd <path to cowsay program> 455/set figlet_cmd <path to figlet program> 456/set jive_cmd <path to jive program> 457/set gay_default_style # 458/set rainbow_keepstate <ON|OFF> 459EOH 460 Irssi::print(draw_box($SPLASH, $help, undef, 1), MSGLEVEL_CLIENTCRAP); 461} 462 463sub draw_box { 464 # taken from a busted script distributed with irssi 465 # just a simple ascii line-art around help text 466 my ($title, $text, $footer, $color) = @_; 467 $footer = $title unless($footer); 468 my $box; 469 $box .= '%R,--[%n%9%U' . $title . '%U%9%R]%n' . "\n"; 470 foreach my $line (split(/\n/, $text)) { 471 $box .= '%R|%n ' . $line . "\n"; 472 } 473 $box .= '%R`--<%n' . $footer . '%R>->%n'; 474 $box =~ s/%.//g unless $color; 475 return $box; 476} 477 478sub show_error { 479 # take text gathered from STDERR and pass it here 480 # to display to the client 481 my $text = shift; 482 foreach my $line (split(/\n/, $text)) { 483 Irssi::print($line); 484 } 485} 486 487sub open3 { 488 my ($read, $write, $err, $command) = @_; 489 490 pipe($read, RTMP); 491 pipe($err, ETMP); 492 pipe(WTMP, $write); 493 494 select($read); $| = 1; 495 select($err); $| = 1; 496 select($write); $| = 1; 497 select(STDOUT); 498 499 return 0 unless defined $command; 500 501 # fork 502 my $pid = fork(); 503 if ($pid) { 504 # parent 505 $child_pid = $pid; 506 $SIG{CHLD} = \&sigchild_handler; 507 close RTMP; close WTMP; close ETMP; 508 return $pid; 509 } else { 510 # child 511 close $write; close $read; close $err; 512 open(STDIN, "<&WTMP"); close WTMP; 513 open(STDOUT, ">&RTMP"); close RTMP; 514 open(STDERR, ">&ETMP"); close ETMP; 515 exec($command); 516 exit 0; 517 } 518} 519 520sub update { 521 # automatically check for updates 522 my $baseURL = $IRSSI{download}; 523 524 # do we have useragent? 525 eval "use LWP::UserAgent"; 526 if ($@) { 527 Irssi::print("LWP::UserAgent failed to load: $!"); 528 return; 529 } 530 531 # first see what the latest version is 532 my $ua = LWP::UserAgent->new(); 533 my $req = HTTP::Request->new( 534 GET => "$baseURL/CURRENT", 535 ); 536 my $res = $ua->request($req); 537 if (!$res->is_success()) { 538 Irssi::print("Problem contacting the mothership"); 539 return; 540 } 541 542 my $latest_version = $res->content(); chomp $latest_version; 543 Irssi::print("Your version is: $VERSION"); 544 Irssi::print("Current version is: $latest_version"); 545 546 if ($VERSION >= $latest_version) { 547 Irssi::print("You are up to date"); 548 return; 549 } 550 551 # uh oh, old stuff! time to update 552 Irssi::print("You are out of date, fetching latest"); 553 $req = HTTP::Request->new( 554 GET => "$baseURL/gay-$latest_version.pl", 555 ); 556 $res = $ua->request($req); 557 if (!$res->is_success()) { 558 Irssi::print("Problem contacting the mothership"); 559 return; 560 } 561 562 my $src = $res->content(); 563 564 # check for integrity 565 if ($src !~ /(\$VERSION = "$latest_version";)/s) { 566 Irssi::print("Version mismatch, aborting"); 567 return; 568 } 569 570 # where should we save this? 571 my $script_dir = "$ENV{HOME}/.irssi/scripts"; 572 if (! -d $script_dir) { 573 Irssi::print("Could not determine script dir"); 574 return; 575 } 576 577 # save the shit already 578 unless (open(OUT, ">$script_dir/downloaded-gay.pl")) { 579 Irssi::print("Couldn't write to $script_dir/gay.pl: $!"); 580 return; 581 } 582 583 print OUT $src; 584 close OUT; 585 586 # copy to location 587 rename("$script_dir/gay.pl", "$script_dir/gay-$VERSION.pl"); 588 rename("$script_dir/downloaded-gay.pl", "$script_dir/gay.pl"); 589 590 Irssi::print("Updated successfully! '/run gay' to load"); 591} 592 593sub shell_args { 594 # take a command-line and parse 595 # it properly, return array ref 596 # of args 597 my $text = shift; 598 my $arg_hash = { 599 count => 1, 600 }; 601 my @post_cmd; 602 while ($text =~ /((["'])([^\2]*?)\2)/g) { 603 my $arg = $3; 604 my $string = $1; 605 $string =~ s!/!\/!g; 606 my $count = $arg_hash->{count}; 607 $arg_hash->{$count} = $arg; 608 push(@post_cmd, "\$text =~ s/$string/*ARG$count*/"); 609 $count++; 610 $arg_hash->{count} = $count; 611 } 612 613 foreach my $cmd (@post_cmd) { 614 eval $cmd; 615 } 616 617 my @args; 618 foreach my $arg (split(/\s+/, $text)) { 619 if ($arg =~ /^\*ARG(\d+)\*$/) { 620 my $count = $1; 621 if ($arg_hash->{$count}) { 622 $arg = $arg_hash->{$count}; 623 624 } 625 } 626 push(@args, $arg); 627 } 628 629 return @args; 630} 631 632# command bindings 633Irssi::command_bind("colcow", \&colcow); 634Irssi::command_bind("figcow", \&figcow); 635Irssi::command_bind("figcolcow", \&figcolcow); 636Irssi::command_bind("colfig", \&colfig); 637Irssi::command_bind("gay", \&gay); 638Irssi::command_bind("gv", \&gv); 639Irssi::command_bind("gayexec", \&gayexec); 640 641 642# settings 643Irssi::settings_add_str($IRSSI{name}, 'cowfile', 'default'); 644Irssi::settings_add_str($IRSSI{name}, 'figfont', 'standard'); 645Irssi::settings_add_int($IRSSI{name}, 'figwrap', 50); 646Irssi::settings_add_str($IRSSI{name}, 'cowsay_cmd', 'cowsay'); 647Irssi::settings_add_str($IRSSI{name}, 'figlet_cmd', 'figlet'); 648Irssi::settings_add_int($IRSSI{name}, 'colcat_max', 2048); 649Irssi::settings_add_int($IRSSI{name}, 'rainbow_offset', 0); 650Irssi::settings_add_bool($IRSSI{name}, 'rainbow_keepstate', 1); 651Irssi::settings_add_int($IRSSI{name}, 'gay_default_style', 1); 652Irssi::settings_add_str($IRSSI{name}, 'jive_cmd', 'jive'); 653 654# display splash text 655Irssi::print("$SPLASH. '/gay help' for usage"); 656 657 658