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