File Coverage

blib/lib/Acme/Scurvy/Whoreson/BilgeRat/Backend/insultserver.pm

Criterion	Covered	Total	%
statement	45	45	100.0
branch	7	8	87.5
condition			n/a
subroutine	5	5	100.0
pod	0	2	0.0
total	57	60	95.0

package Acme::Scurvy::Whoreson::BilgeRat::Backend::insultserver;

$VERSION = '1.0';

use warnings;
use strict;

use base 'Acme::Scurvy::Whoreson::BilgeRat';


=head1 NAME

Acme::Scurvy::Whoreson::BilgeRat::Backend::insultserver - generate insults in the style of the old colarado.edu Insult Server

=head1 SYNOPSIS

	use Acme::Scurvy::Whoreson::BilgeRat;

	my $insultgenerator = Acme::Scurvy::Whoreson::BilgeRat->new(
		language => 'insultserver'
	);

	print $insultgenerator; # prints an insult


=head1 DESCRIPTION

We used to have the Insult Server at http://insulthost.colorado.edu
which you could telnet to on port 1695 to get a random insult. And Lo!
it was fun.

Useless, but fun.

Sadly, it's down now. This is a reimplementation in Perl.

=head1 BUGS

Should be able to specify another config file, possibly though environment variables.

=head1 AUTHOR

Simon Wistow

based on code by

James Garnett

=head1 COPYRIGHT

Copyright 2005, Simon Wistow

Distributed under the same terms as Perl itself.

=head1 SEE ALSO

http://insulthost.colorado.edu/

=cut


sub new {
	my $class = shift;

	my $self = {};

	my $pos = tell DATA;
    while() {
        chomp;
        next if /^\s*$/;
		next if /^\s*#/;
		next unless s!^\s*(adj|amt|noun)\s+!!i;
		my $what = $1;
		# turn the '|' character into a space
		push @{$self->{$what}}, map { s!\|! !g; $_ } split ' ', $_;
    }

    seek DATA, $pos,0;


	return bless $self, $class;
}

sub generateinsult {
	my $self  =shift;

	my @adj  = @{$self->{adj}};
	my @noun = @{$self->{noun}};
	my @amt  = @{$self->{amt}};

	my $adj1   = rand @{$self->{adj}};
	my $adj2   = $adj1;
	do { $adj2 = rand @{$self->{adj}} } while ($adj1 == $adj2);

	$adj1      = $adj[$adj1];
	$adj2      = $adj[$adj2];

	my $amt    = $amt[rand @amt];
	my $noun   = $noun[rand @noun];


	my $return  = "You are nothing but a";
	$return    .= 'n' if substr($adj1,0,1) =~ m![aeiou]!;
	$return    .= sprintf(" %s %s of %s %s.", $adj1, $amt, $adj2, $noun);

	return $return;

}
1;
__DATA__