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, "$line");
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