view release on metacpan or  search on metacpan

lib/Acme/Scurvy/Whoreson/BilgeRat.pm  view on Meta::CPAN

package Acme::Scurvy::Whoreson::BilgeRat;

$VERSION = '1.0';

use strict;
use warnings;
use overload (
	'""' => \&stringify,
	fallback => 1
);

=head1 NAME

Acme::Scurvy::Whoreson::BilgeRat - multi-lingual insult generator

=head1 SYNOPSIS

  use Acme::Scurvy::Whoreson::BilgeRat;
  
  my $insultgenerator = Acme::Scurvy::Whoreson::BilgeRat->new(
    language => 'pirate'
  );
  
  print $insultgenerator; # prints a piratical insult

=head1 DESCRIPTION

A multi-lingual insult generator, which takes pluggable backends to
generate insults in the language of your choice, written in honour of
International Talk Like A Pirate Day on Sept 19th 2003
L<http://www.talklikeapirate.com/>.  An example backend is provided
which implements the 'pirate' language.

Usage is very simple.  Instantiate an Acme::Scurvy::Whoreson::BilgeRat
object, passing a single named parameter - 'language' - to the constructor.
This tells it to use the A::S::W::B::Backend::[language] plugin module.
If that is missing, we assume you want the 'pirate' backend.

To generate an insult, simply mention your object in any place where it
will be turned into a string.  It uses the AWESOME POWER of operator
overloading to achieve this heroic feat.

=cut

sub new {
	my($class, %params, $backend) = @_;
	
	die("Read the fucking manual you shitwit and at least use the constructor right!")
	  if(!$class || join('', keys %params) !~ /^(language)?$/);
	
	$params{language} ||= 'pirate';
	
	eval "
		use Acme::Scurvy::Whoreson::BilgeRat::Backend::$params{language};
	";
	$@ && die("Bollocks! I can't find a language backend for '$params{language}'");
	
	$backend = "Acme::Scurvy::Whoreson::BilgeRat::Backend::$params{language}"->new();
	($backend && $backend->isa("Acme::Scurvy::Whoreson::BilgeRat::Backend::$params{language}")) ||
		die("For fuck's sake, the fucking backend's fucked");

	$backend;
}

sub stringify {
	my $self = shift;
	$self->generateinsult();
}

sub generateinsult {
	my($self, %usedwords, $insult) = (shift);
	foreach my $element (split(//, $self->{grammars}->[rand @{$self->{grammars}}])) {
		my $word = '';
		my $counter = 0;
		while(!$word || $usedwords{$word}) {
			$word = (uc $element eq 'N') ? $self->{nouns}->[rand @{$self->{nouns}}] :
				(uc$ element eq 'A') ? $self->{adjectives}->[rand @{$self->{adjectives}}] :
				die("The dickhead who wrote your backend fucked up");
			return '' if(++$counter == 100);
		}
		$usedwords{$word} = 1;
		$insult .= (($insult) ? ' ' : '').$word;
	}
	$insult;
}

=head1 PLUGINS

So, on to the most complex part of all this, which thankfully isn't that
complex.