1# unleash the gay!!! shoutz to #insub 2# author: cj_ <rover@gruntle.org> 3# type /gay help for usage after loading 4# hugaluga 5 6use Irssi; 7use Irssi::Irc; 8use strict; 9use vars qw($VERSION %IRSSI $SPLASH); 10 11$VERSION = "2.1"; 12%IRSSI = ( 13 author => 'cj_', 14 contact => 'rover@gruntle.org', 15 name => 'gay', 16 description => 'a lot of annoying ascii color/art text filters', 17 license => 'Public Domain', 18 changed => 'Tue Jul 15 18:23:02 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 work by calling a single routine with flags indicating 38# which filters the text should be passed through. the order 39# they are parsed is not changeable. see the process() function 40# for an explanation of flags 41sub cow { process("c", @_) } # cowsay 42sub colcow { process("cr", @_) } # cowsay -> rainbow 43sub figcow { process("cf", @_) } # figlet -> cowsay 44sub figcolcow { process("crf", @_) } # figlet -> cowsay -> rainbow 45sub colcat { process("xr", @_) } # file -> rainbow 46sub figsay { process("f", @_) } # figlet 47sub colfig { process("rf", @_) } # figlet -> rainbow 48sub gaysay { process("r", @_) } # rainbow 49sub colexec { process("re", @_) } # exec -> rainbow 50sub blinksay { process("b", @_) } # blink 51 52# interface command. currently serves "help" and "version" 53# later add "raw" command to let user supply filter flags 54sub gay { 55 my $args = shift; 56 if ($args =~ /help/i) { 57 show_help(); 58 } elsif ($args =~ /vers/i) { 59 Irssi::print($SPLASH); 60 } elsif ($args =~ /update/i) { 61 update(); 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 # set up defaults 78 my @text; 79 my $prefix; 80 my $style = Irssi::settings_get_int("gay_default_style"); 81 my $cowfile = Irssi::settings_get_str("cowfile"); 82 my $figfont = Irssi::settings_get_str("figfont"); 83 my $sendto = $dest->{name}; 84 85 # parse args 86 my @args = split(/\s+/, $text); 87 while (my $arg = shift(@args)) { 88 if ($arg =~ /^-m/) { $sendto = shift(@args); next } 89 if ($arg =~ /^-p/) { $prefix = shift(@args); next } 90 if ($arg =~ /^-b/) { $flags .= "b"; next } 91 92 # conditional switches (for example, don't parse -c unless there's a cowsay 93 if ($flags =~ /c/ and $arg =~ /^-c/) { $cowfile = shift(@args); next } 94 if ($flags =~ /f/ and $arg =~ /^-f/) { $figfont = shift(@args); next } 95 if ($flags =~ /r/ and $arg =~ /^-(\d)$/) { $style = $1; next } 96 97 # doesn't match arguments, must be text! 98 push(@text, $arg); 99 } 100 $text = join(" ", @text); 101 102 return unless $dest; 103 104 # do the evil stuff based on flags passed in.. these 105 # routines are below 106 $text = execute($text) if $flags =~ /e/; 107 $text = slurp($text) if $flags =~ /x/; 108 $text = figlet($text, $figfont) if $flags =~ /f/; 109 $text = cowsay($text, $cowfile) if $flags =~ /c/; 110 $text = rainbow($text, $style) if $flags =~ /r/; 111 $text = blink($text) if $flags =~ /b/; 112 113 # output and then we're done 114 foreach my $line (split(/\n/, $text)) { 115 $line = "$prefix $line" if ($prefix); 116 $server->command("msg $sendto $line"); 117 } 118} 119 120###################################################### 121# these filters pass text through various gayalizers # 122###################################################### 123 124sub cowsay { 125 # pass text through cowsay 126 my $text = shift; 127 my $cowsay_font = shift || 'default'; 128 129 # see if we can find the program 130 my $cowsay_cmd = Irssi::settings_get_str('cowsay_cmd'); 131 $cowsay_cmd = -x $cowsay_cmd ? $cowsay_cmd : whereis("cowsay"); 132 unless (-x $cowsay_cmd) { 133 Irssi::print("$cowsay_cmd not found or not executable!"); 134 return; 135 } 136 137 open3(*READ, *WRITE, *ERR, "$cowsay_cmd -n -f $cowsay_font"); 138 print WRITE $text; 139 close WRITE; 140 141 $text = join('', <READ>); 142 close READ; 143 144 # check for errors 145 show_error(join('', <ERR>)); 146 close ERR; 147 148 return $text; 149} 150 151sub figlet { 152 # pass text through figlet 153 my $text = shift; 154 my $figlet_font = shift || 'standard'; 155 my $figlet_wrap = Irssi::settings_get_int('figwrap'); 156 157 # see if we can find the program 158 my $figlet_cmd = Irssi::settings_get_str('figlet_cmd'); 159 $figlet_cmd = -x $figlet_cmd ? $figlet_cmd : whereis("figlet"); 160 unless (-x $figlet_cmd) { 161 Irssi::print("$figlet_cmd not found or not executable!"); 162 return; 163 } 164 165 open3(*READ, *WRITE, *ERR, "$figlet_cmd -f $figlet_font -w $figlet_wrap"); 166 print WRITE $text; 167 close WRITE; 168 169 $text = join('', <READ>); 170 close READ; 171 172 # check for errors 173 show_error(join('', <ERR>)); 174 close ERR; 175 176 $text =~ s/\n\s+\n$//s; # figlet leaves a trailing blank line.. sometimes 177 178 return $text; 179} 180 181sub rainbow { 182 # take text and make it colorful 183 # 184 # 0 = white 185 # 1 = black 186 # 2 = blue 187 # 3 = green 188 # 4 = orange 189 # 5 = red (yellow in bx/epic/ircii :( ) 190 # 6 = magenta 191 # 7 = yellow (red in bx/epic/ircii :( ) 192 # 8 = bright yellow 193 # 9 = bright green 194 # 10 = cyan 195 # 11 = gray 196 # 12 = bright blue 197 # 13 = bright purple 198 # 14 = dark gray 199 # 15 = light gray 200 201 my ($text, $style) = @_; 202 203 # calculate stateful color offset 204 my $state_offset = 0; 205 if (Irssi::settings_get_bool("rainbow_keepstate")) { 206 $state_offset = Irssi::settings_get_int("rainbow_offset"); 207 if ($state_offset < 0 or $state_offset > 20) { 208 $state_offset = 0; 209 } else { 210 $state_offset++; 211 } 212 213 Irssi::settings_set_int("rainbow_offset", $state_offset); 214 } 215 216 # generate colormap based on style 217 my @colormap; 218 if ($style == 1) { 219 # rainbow 220 @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); 221 } elsif ($style == 2) { 222 # patriotic 223 @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); 224 } elsif ($style == 3) { 225 # random colors 226 while (scalar(@colormap) < 24) { 227 my $color = int(rand(0) * 15) + 1; 228 $color = 0 if $color == 1; 229 push(@colormap, $color); 230 } 231 } elsif ($style == 4) { 232 # alternating colors shade, color is random 233 my $rand = int(rand(0) * 6) + 1; 234 if ($rand == 1) { 235 # blue 236 @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); 237 } elsif ($rand == 2) { 238 # green 239 @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); 240 } elsif ($rand == 3) { 241 # purple 242 @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); 243 } elsif ($rand == 4) { 244 # gray 245 @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); 246 } elsif ($rand == 5) { 247 # yellow 248 @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); 249 } elsif ($rand == 6) { 250 # red 251 @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); 252 } 253 } elsif ($style == 5) { 254 # alternating shades of grey. i liked this one so much i gave 255 # it its own style. does NOT like to blink, though 256 @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); 257 } elsif ($style == 6) { 258 # greyscale 259 @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); 260 } else { 261 # invalid style setting 262 Irssi::print("invalid style setting: $style"); 263 return; 264 } 265 266 # colorize.. thanks 2 sisko 267 my $newtext; 268 my $row = 0; 269 foreach my $line (split(/\n/, $text)) { 270 for (my $i = 0; $i < length($line); $i++) { 271 my $chr = substr($line, $i, 1); 272 my $color = $i + $row + $state_offset; 273 $color = $color ? $colormap[$color %($#colormap-1)] : $colormap[0]; 274 $newtext .= "\003$color" unless ($chr =~ /\s/); 275 my $ord = ord($chr); 276 if (($ord >= 48 and $ord <= 57) or $ord == 44) { 277 $newtext .= "\26\26"; 278 } 279 $newtext .= $chr; 280 } 281 $newtext .= "\n"; 282 $row++; 283 } 284 285 return $newtext; 286} 287 288sub blink { 289 # make the text blink 290 my $text = shift; 291 my @newtext; 292 foreach my $line (split(/\n/, $text)) { 293 push(@newtext, "[5m$line[0m"); 294 } 295 return join("\n", @newtext); 296} 297 298sub whereis { 299 # evaluate $PATH, since this doesn't seem to be inherited 300 # in sh subproccess in irssi.. odd 301 my $cmd = shift; 302 foreach my $path (split(/:/, $ENV{PATH})) { 303 my $test = "$path/$cmd"; 304 if (-x $test) { 305 return $test; 306 } 307 } 308} 309 310sub slurp { 311 # read in a file with max setting (useful for catting /dev/urandom :D ) 312 # maybe make this read in chunks, not by line, or something.. seems clumsy 313 my $file = shift; 314 315 # expand ~ 316 $file =~ s!^~([^/]*)!$1 ? (getpwnam($1))[7] : ($ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7])!ex; 317 318 unless (open(IN, "<$file")) { 319 Irssi::print("could not open $file: $!"); 320 return; 321 } 322 323 my $max = Irssi::settings_get_int("colcat_max"); 324 my $text; 325 while (my $line = <IN>) { 326 $text .= $line; 327 last if length($text) >= $max; 328 } 329 close IN; 330 331 return $text; 332} 333 334sub execute { 335 # execute command and return output 336 my $text = shift; 337 338 open3(*READ, *WRITE, *ERR, $text); 339 close WRITE; 340 341 $text = join('', <READ>); 342 close READ; 343 344 # check for errors 345 show_error(join('', <ERR>)); 346 close ERR; 347 348 return $text; 349} 350 351sub show_help { 352 my $help = <<EOH; 353/COMMAND [-12345] [-b] [-m <target>] [-p <prefix text>] 354 [-f <figlet font>] [-c <cowfile>] <text> 355 356STYLES: 357-1 rainbow (default, changeable) 358-2 red white and blue 359-3 random colors 360-4 random alternating colors 361-5 alternating gray 362-6 greyscale 363-b blinking (can be combined) 364 365COMMANDS: 366 367/cow <text> regular cowsay 368/colcow <text> color cowsay 369/figcow <text> cowsay w/ figlet fonts 370/figcolcow <text> d) all of the above!!oneone 371/colcat <text> output file in color 372/colexec <command> execute command in color 373/gaysay <text> say in color 374/figlet <text> output in figlet 375/colfig <text> color figlet 376/blink <text> just say something, blinking 377/gay help this help screen 378/gay version show version information 379 380SETTINGS: 381 382/set cowfile <cowsay file> 383/set figfont <figlet file> 384/set figwrap <# to wrap at> 385/set cowsay_cmd <path to cowsay program> 386/set figlet_cmd <path to figlet program> 387/set gay_default_style # 388/set rainbow_keepstate <ON|OFF> 389EOH 390 Irssi::print(draw_box($SPLASH, $help, undef, 1), MSGLEVEL_CLIENTCRAP); 391} 392 393sub draw_box { 394 # taken from a busted script distributed with irssi 395 # just a simple ascii line-art around help text 396 my ($title, $text, $footer, $color) = @_; 397 $footer = $title unless($footer); 398 my $box; 399 $box .= '%R,--[%n%9%U' . $title . '%U%9%R]%n' . "\n"; 400 foreach my $line (split(/\n/, $text)) { 401 $box .= '%R|%n ' . $line . "\n"; 402 } 403 $box .= '%R`--<%n' . $footer . '%R>->%n'; 404 $box =~ s/%.//g unless $color; 405 return $box; 406} 407 408sub show_error { 409 # take text gathered from STDERR and pass it here 410 # to display to the client 411 my $text = shift; 412 foreach my $line (split(/\n/, $text)) { 413 Irssi::print($line); 414 } 415} 416 417sub open3 { 418 my ($read, $write, $err, $command) = @_; 419 420 pipe($read, RTMP); 421 pipe($err, ETMP); 422 pipe(WTMP, $write); 423 424 select($read); $| = 1; 425 select($err); $| = 1; 426 select($write); $| = 1; 427 select(STDOUT); 428 429 return 0 unless defined $command; 430 431 # fork 432 my $pid = fork(); 433 if ($pid) { 434 # parent 435 $child_pid = $pid; 436 $SIG{CHLD} = \&sigchild_handler; 437 close RTMP; close WTMP; close ETMP; 438 return $pid; 439 } else { 440 # child 441 close $write; close $read; close $err; 442 open(STDIN, "<&WTMP"); close WTMP; 443 open(STDOUT, ">&RTMP"); close RTMP; 444 open(STDERR, ">&ETMP"); close ETMP; 445 exec($command); 446 exit 0; 447 } 448} 449 450sub update { 451 # automatically check for updates 452 my $baseURL = "http://www.gruntle.org/projects/gay"; 453 454 # do we have useragent? 455 eval "use LWP::UserAgent"; 456 if ($@) { 457 Irssi::print("LWP::UserAgent failed to load: $!"); 458 return; 459 } 460 461 # first see what the latest version is 462 my $ua = LWP::UserAgent->new(); 463 my $req = HTTP::Request->new( 464 GET => "$baseURL/CURRENT", 465 ); 466 my $res = $ua->request($req); 467 if (!$res->is_success()) { 468 Irssi::print("Problem contacting the mothership"); 469 return; 470 } 471 472 my $latest_version = $res->content(); chomp $latest_version; 473 Irssi::print("Your version is: $VERSION"); 474 Irssi::print("Current version is: $latest_version"); 475 476 if ($VERSION >= $latest_version) { 477 Irssi::print("You are up to date"); 478 return; 479 } 480 481 # uh oh, old stuff! time to update 482 Irssi::print("You are out of date, fetching latest"); 483 $req = HTTP::Request->new( 484 GET => "$baseURL/gay-$latest_version.pl", 485 ); 486 $res = $ua->request($req); 487 if (!$res->is_success()) { 488 Irssi::print("Problem contacting the mothership"); 489 return; 490 } 491 492 my $src = $res->content(); 493 494 # check for integrity 495 #$VERSION = "1.5"; 496 497 if ($src !~ /(\$VERSION = "$latest_version";)/s) { 498 Irssi::print("Version mismatch, aborting"); 499 return; 500 } 501 502 # where should we save this? 503 my $script_dir = "$ENV{HOME}/.irssi/scripts"; 504 if (! -d $script_dir) { 505 Irssi::print("Could not determine script dir"); 506 return; 507 } 508 509 # save the shit already 510 unless (open(OUT, ">$script_dir/downloaded-gay.pl")) { 511 Irssi::print("Couldn't write to $script_dir/gay.pl: $!"); 512 return; 513 } 514 515 print OUT $src; 516 close OUT; 517 518 # copy to location 519 rename("$script_dir/downloaded-gay.pl", "$script_dir/gay.pl"); 520 521 Irssi::print("Updated successfully! '/run gay' to load"); 522} 523 524# command bindings 525Irssi::command_bind("cow", \&cow); 526Irssi::command_bind("colcow", \&colcow); 527Irssi::command_bind("figcow", \&figcow); 528Irssi::command_bind("figcolcow", \&figcolcow); 529Irssi::command_bind("colcat", \&colcat); 530Irssi::command_bind("figlet", \&figsay); 531Irssi::command_bind("colfig", \&colfig); 532Irssi::command_bind("gaysay", \&gaysay); 533Irssi::command_bind("colexec", \&colexec); 534Irssi::command_bind("blink", \&blinksay); 535Irssi::command_bind("gay", \&gay); 536 537# settings 538Irssi::settings_add_str($IRSSI{name}, 'cowfile', 'default'); 539Irssi::settings_add_str($IRSSI{name}, 'figfont', 'standard'); 540Irssi::settings_add_int($IRSSI{name}, 'figwrap', 50); 541Irssi::settings_add_str($IRSSI{name}, 'cowsay_cmd', 'cowsay'); 542Irssi::settings_add_str($IRSSI{name}, 'figlet_cmd', 'figlet'); 543Irssi::settings_add_int($IRSSI{name}, 'colcat_max', 2048); 544Irssi::settings_add_int($IRSSI{name}, 'rainbow_offset', 0); 545Irssi::settings_add_bool($IRSSI{name}, 'rainbow_keepstate', 1); 546Irssi::settings_add_int($IRSSI{name}, 'gay_default_style', 1); 547 548# display splash text 549Irssi::print("$SPLASH. '/gay help' for usage"); 550 551 552