Script that mangles input by replacing words with "equivalents" found via dictd/moby-thesaurus

man-gler.pl

#!/usr/bin/perl

use strict;
use warnings;

use IO::Socket;

my %options;
my %words;
my $sock;

# preserve uc/ucfirst/lc-ness in replacement word
sub save_case {
	my $orig = shift;
	my $new = shift;
	return $orig if $new eq $orig;

	return ucfirst $new if $orig =~ /^[A-Z][a-z]*$/;
	return uc $new if $orig =~ /^[A-Z]*$/;

	return $new;
}

# RAAAAAAAAAAAAAAAANDO
sub rando {
	my $word = shift;
	my @opts = @{$options{lc $word}};
	if(@opts == 0) {
		return $word;
	}
	return $opts[rand @opts];
	@opts = sort { length($a) <=> length($b) } @opts;
	return $opts[0];
}

sub lookup {
	my $sock = IO::Socket::INET->new(
			Proto => "tcp",
			PeerAddr => "localhost",
			PeerPort => "2628",
		) or die "Failed to open socket";

	# dictd supports pipelining, so we shove all the words at it at once
	my @order = keys %words;
	for my $word (@order) {
		$options{$word} = [];
		print $sock "define moby-thesaurus $word\r\n";
#		print ">define moby-thesaurus $word\r\n";
	}

	# then we loosely parse the results
	while(my $word = shift @order) {
#		print "=$word\n";
		while(<$sock>) {
#			print "<$_";
			chomp;
			last if(/^250 ok|^552 no/);
			next if(!/^   /);
			s/^\s*//;
			s/\s*$//;
			for my $opt (split /, ?/, lc $_) {
				push(@{$options{$word}}, $opt);
			}
		}
	}
	close($sock)
		or die "oh no sock";
}

my @lines;

# collect lines and words to lookup
while(my $l = <>) {
	push @lines, $l;
	for my $word ($l =~ m/[[:alpha:]]+/g) {
		$words{lc $word} = undef;
	}
}

# populate %options
lookup();

# do replacements
for my $l (@lines) {
	$l =~ s/([[:alpha:]]+)/save_case($1, rando($1))/eg;
	print $l;
}