Text::Lorem::More - Generate formatted nonsense using random Latin words.

	use Text::Lorem::More;

	my $lorem = Text::Lorem::More->new;

	# Greet a friend
	print "Hello, ", $lorem->fullname, "\n";

	# You could also ...
	print $lorem->process("Hello, +fullname\n");

	... or you can use the singleton:

	use Text::Lorem::More qw(lorem);

	# Generate a random latin word
	my $latinwordoftheday = lorem->word;

	# Produce paragaphs in the Text::Lorem compatible manner
	my $content = lorem->paragraphs(3);

	# Print 4 paragraphs, each separated by a single newline and tab:
	print "\t", scalar lorem->paragraph(4, "\n\t");

	my $name = $lorem->name;

	my $hostname = $lorem->hostname;

	# This will do the same thing ...
	my $otherhostname = $lorem->generate("+hostname");

	dicta
	sed
	repellat

	Repellat
	Sed
	Ipsum

	Lorem Dicta

	example.com
	example.net

	et.example.com
	example.org

	+name
	+fullname
	+word+word+word+word

	+name@+domainname
	"+firstname +lastname"

	prefix+namesuffix

	prefix+{name}suffix

	2 ++ 2

    git clone git://github.com/robertkrimen/text-lorem-more.git Text-Lorem-More

    perldoc Text::Lorem::More

package Text::Lorem::More;

use warnings;
use strict;

our $VERSION = '0.13';

use base qw/Exporter/;

use Carp;
use Parse::RecDescent;

use Text::Lorem::More::Source;
    
our $PARSER = Parse::RecDescent->new(<<'_END_');
content: <rulevar: local @content >
content: <skip:''> pattern(s) { \@content }
pattern: escape | variable | text
escape: '++'  { push @content, \"+" }
variable: '+{' identifier '}' | '+' identifier
identifier: /[A-Za-z0-9_]+/ { push @content, $item[1] }
text: m/[^\+]+/ { push @content, \$item[1] }
_END_

our %GENERATOR = (

	name => sub { [ sub { ucfirst lc $_ }, "+word" ] },
	firstname => "name",
	lastname => "name",

	fullname => sub { ["+firstname +lastname"] },

	username => "word",

	word => [ grep { length $_ } map { s/\W//g; lc } split m/\s/, <<_END_ ],
alias consequatur aut perferendis sit voluptatem accusantium doloremque aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis Nemo enim ipsam voluptatem quia voluptas sit suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae  et iusto odio dignissimos ducimus qui blanditiis praesentium laudantium, totam rem voluptatum deleniti atque corrupti quos dolores et quas molestias excepturi sint occaecati cupiditate non provident, Sed ut perspiciatis unde omnis iste natus error similique sunt in culpa qui officia deserunt mollitia animi, id est laborum et dolorum fuga. Et harum quidem rerum facilis est et expedita distinctio. Nam libero tempore, cum soluta nobis est eligendi optio cumque nihil impedit quo porro quisquam est, qui minus id quod maxime placeat facere possimus, omnis voluptas assumenda est, omnis dolor repellendus. Temporibus autem quibusdam et aut consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur? At vero eos et accusamus officiis debitis aut rerum necessitatibus saepe eveniet ut et voluptates repudiandae sint et molestiae non recusandae. Itaque earum rerum hic tenetur a sapiente delectus, ut aut reiciendis voluptatibus maiores doloribus asperiores repellat.
_END_

	title => sub { [ sub { ucfirst($_) },  "+word", 1 + int rand 3 ] },

	description => sub { [ "+sentence", 1 + int rand 3 ] },

	sentence => sub { [ sub { ucfirst($_) . "." },  "+word", 4 + int rand 6 ] },

	paragraph => sub { [ "+sentence", 3 + int rand 4 ] }, 

	words => sub {
		$Text::Lorem::More::PRUNE = 1;
		return [ "+word", $Text::Lorem::More::COUNT, " " ];
	},

	sentences => sub {
		my $lorem = shift;
		$Text::Lorem::More::PRUNE = 1;
		my $count = $Text::Lorem::More::COUNT;
		my @sentence;
		while ($count > 0) {
			push @sentence, ucfirst $lorem->words(4 + int rand 6);
			$count--;
		}
		return join(". ", @sentence) . ".";
	},

	paragraphs => sub {
		my $lorem = shift;
		$Text::Lorem::More::PRUNE = 1;
		my $count = $Text::Lorem::More::COUNT;
		my @paragraph;
		while ($count > 0) {
			push @paragraph, $lorem->sentences(3 + int rand 4);
			$count--;
		}
		return join("\n\n", @paragraph);
	},

	email => [ map { [ $_ ] } split m/\n/, <<_END_ ],
+word\@+hostname
+word\@+domainname
_END_

	mail => "email",

	relativepath => '',
	absolutepath => '',

	path => sub { [ "+word", 1 + int rand 6, "/" ] },

	httpurl => [ map { [ $_ ] } split m/\n/, <<_END_ ],
http://+hostname+path
http://+hostname:+port+path
_END_
	port => sub { int rand(1 + (2 ** 15)) },

	mailto => \"mailto:+email",

	tld => "topleveldomain",

	topleveldomain => [ split m/\s/, <<_END_ ],
com org net
_END_

	domain => "domainname",

	domainname => [ map { [ $_ ] } split m/\n/, <<_END_ ],
example.+tld
_END_

	host => "hostname",

	hostname => [ map { [ $_ ] } split m/\n/, <<_END_ ],
+word.+domainname
+domainname
_END_

);

use constant MAXIMUM_RECURSION => 2 ** 12;
use constant GENERATOR => \%GENERATOR;

our @EXPORT_OK = qw(lorem);

sub new {
	my $self = bless {}, shift;
	my $source;
	if (@_) {
		if (ref $_[0] eq "HASH") {
			my $generator = shift;
			my $priority = shift;
			$source = new Text::Lorem::More::Source($source, $priority) if ref $source eq "HASH";
		}
		elsif (UNIVERSAL::isa($_[0], "Text::Lorem::More::Source")) {
			$source = shift;
		}
		elsif (! defined $_[0]) {
			$source = new Text::Lorem::More::Source;
		}
	}
	else {
		$source = $self->_DEFAULT_SOURCE->copy;
	}
	$self->{source} = $source;
	return $self;
}

sub generate {
	my $self = shift;
	# _generate may recurse any number of times.
	# the RECURSION counter makes sure it doesn't get out of hand.
	local $Text::Lorem::More::RECURSION = 0;
	return $self->_generate(@_);
}

sub process {
	my $self = shift;
	# _process may recurse any number of times.
	# the RECURSION counter makes sure it doesn't get out of hand.
	local $Text::Lorem::More::RECURSION = 0;
	return $self->_process(@_);
}

sub source {
	my $self = shift;
	return $self->{source};
}

sub lorem() { __PACKAGE__->_singleton }

sub _DEFAULT_SOURCE {
	return our $SOURCE ||= do {
		$SOURCE = new Text::Lorem::More::Source;
		$SOURCE->push(GENERATOR);
		$SOURCE;
	}
}

sub AUTOLOAD {
	my $self = shift->_self;
	my $method = our $AUTOLOAD;
	$method =~ s/.*:://;

	if ($self->{source}->find($method)) {
		no strict 'refs';
		*$AUTOLOAD = sub { my $self = shift; $self->generate("+$method", @_) };
		unshift @_, $self;
		goto &$AUTOLOAD;
	}
	else {
		carp "no such generatelet for \"$method\" found";
		return "";
	}
}

our ($RECURSION, $COUNT, $PRUNE);
sub _process {
	my $self = shift;
	my $content = shift;
	my $count = shift;
	my $separator = shift;

	$RECURSION += 1;
	croak "Too much recursion ($RECURSION) on \"$content\"" if $RECURSION >= MAXIMUM_RECURSION;

	$count = 1 unless defined $count;
    croak "\$count ($count) should be a number" unless $count =~ m/^\d+$/;

	$separator = " " unless defined $separator;

	local $Text::Lorem::More::COUNT = $count; $COUNT = $COUNT;
	local $Text::Lorem::More::PRUNE = 0;

	my @content;
	while ($count >= 0) {
		my $yield = "";
		my $parseryield = $PARSER->content($content);
		for (@$parseryield) {
			$yield .= ref $_ ? $$_ : $self->_replace_pattern($_);
		}
		push @content, $yield if $Text::Lorem::More::PRUNE;
		last if 0 == $count || $Text::Lorem::More::PRUNE;
		push @content, $yield;
		$count--;
	}

	return $content[0] if 1 == @content;
	return wantarray ? @content : join $separator, @content;
}

sub _generate {
	my $self = shift;
	my $pattern = shift;
	my $count = shift;
	my $separator = shift;
	my $fast = shift;

	$RECURSION += 1;
	croak "Too much recursion ($RECURSION) on \"$pattern\"" if $RECURSION >= MAXIMUM_RECURSION;

	$count = 1 unless defined $count;
    croak "\$count ($count) should be a number" unless $count =~ m/^\d+$/;

	$separator = " " unless defined $separator;

	local $Text::Lorem::More::COUNT = $count; $COUNT = $COUNT;
	local $Text::Lorem::More::PRUNE = 0;

        my @content;
        while ($count >= 0) {
		my $pattern = $pattern;
		$pattern =~ s/\+\{(\w+)\}|\+(\w+)/$self->_replace_pattern($1 || $2)/eg;
                push @content, $pattern if $Text::Lorem::More::PRUNE;
                last if 0 == $count || $Text::Lorem::More::PRUNE;
                push @content, $pattern;
		$count--;
	}

	return $content[0] if 1 == @content;
	return wantarray ? @content : join $separator, @content;
}

sub _replace_pattern {
	my $self = shift;
	my $pattern = shift;

	my $generatelet = $self->{source}->find($pattern);

	return $pattern unless $generatelet;

	my $content;
	if (ref $generatelet eq "ARRAY") {
		$content = $generatelet->[int rand @$generatelet];
	}
	elsif (ref $generatelet eq "SCALAR") {
		$content = $$generatelet;
	}
	elsif (ref $generatelet eq "CODE") {
		$content = $generatelet->($self);
	}
	else {
		croak "Don't know how to run/handle generatelet \"$generatelet\"";
	}

	if (ref $content eq "ARRAY") {
		my $filter;
		$filter = shift @$content if ref $content->[0] eq "CODE";
		my ($pattern, $count, $separator) = @$content;
		local $_ = $self->_generate($pattern, $count, $separator);
		$_ = $filter->($_) if $filter;
		$content = $_;
	}

	return $content;
}

sub _self($) { return ref $_[0] ? $_[0] : $_[0]->_singleton }


sub _singleton {
	my $class = shift;
	return our $singleton ||= $class->new;
}

sub DESTROY {
}

1; # End of Text::Lorem::More