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