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