Acme-Wabby
view release on metacpan or search on metacpan
my $self = shift;
die "Invalid object" unless (ref($self) eq __PACKAGE__);
if ($self->{'conf'}{'autosave_on_destroy'}) {
$self->save;
}
}
# A method for dumping the current state to files using Storable.
# Arguments: None.
# Returns: undef on failure, true on success.
sub save {
my $self = shift;
die "Invalid object" unless (ref($self) eq __PACKAGE__);
# Since Storable can die on serious errors, or simply return an undef,
# we need to wrap these calls in evals
eval {
if (!store($self->{'data'}{'list'}, $self->{'conf'}{'list_file'})) {
$@ = 1;
}
};
if ($@) {
return undef;
}
eval {
if (!store($self->{'data'}{'hash'}, $self->{'conf'}{'hash_file'})) {
$@ = 1;
}
};
if ($@) {
return undef;
}
return 1;
}
# A method for loading a previously saved state from files using Storable.
# Arguments: None.
# Returns: undef on failure, true on success
sub load {
my $self = shift;
die "Invalid object" unless (ref($self) eq __PACKAGE__);
# Since Storable can die on serious errors, or simply return an undef,
# we need to wrap these calls in evals
my $ref;
eval {
if (!($ref = retrieve($self->{'conf'}{'list_file'}))) {
$@ = "Error retrieving list from " . $self->{'conf'}{'list_file'};
}
};
if ($@) {
return undef;
}
@{$self->{'data'}{'list'}} = @{$ref};
eval {
if (!($ref = retrieve($self->{'conf'}{'hash_file'}))) {
$@ = "Error retrieving hash from " . $self->{'conf'}{'hash_file'};
}
};
if ($@) {
return undef;
}
%{$self->{'data'}{'hash'}} = %{$ref};
return 1;
}
# A method for adding a block of text to the current state.
# Arguments: Takes a scalar containing text to be added. Embedded newlines,
# random crap, et al are fine, they'll just be stripped out anyway.
# Returns: undef on failure, true on success. The only failure condition is
# currently if an invalid parameter is passed in.
sub add {
my $self = shift;
die "Invalid object" unless (ref($self) eq __PACKAGE__);
# Make sure we actually got something to add
my $text = shift;
unless ($text) {
return undef;
}
# If we don't care about case, lowercase the whole thing to start with
unless ($self->{'conf'}{'case_sensitive'}) {
$text = lc($text);
}
# Split the text into component phrases, which we define as being delimited
# by the characters below. I left the comma out because it seems to lead
# to slightly more coherent results.
}
}
return 1;
}
# A function for generating a random line of text.
# Arguments: If no arguments, spew will try to generate a completely random
# sentence. If a string is passed in, spew will try to generate a
# random sentence beginning with the provided text.
# Returns: The generated string, or undef on any of several error conditions.
# Note that these error conditions are not fatal. They are:
# * At least (min_len * 10) words haven't been run through yet.
# (Must ->add() more text before trying again.)
# * A string was passed in containing nothing. (Don't do that.)
# * We don't know the last word in the sentence, and can therefore
# not generate a sentence with it. (Either teach us about it
# with ->add(), or try something else.)
# * A sentence of at least min_len words could not be generated,
# even after max_attempts tries at doing so. (Likely need to
# ->add() more text before trying again.)
#
sub spew {
my $self = shift;
die "Invalid object" unless (ref($self) eq __PACKAGE__);
my $text = shift;
# If we don't have at least 10 * min_len words, we probably don't have a
# very good chance of making a sentence, so let's just return.
if (scalar(keys %{$self->{'data'}{'hash'}}) <
($self->{'conf'}{'min_len'} * 10)) {
return undef;
}
my $directed;
my $start;
# If they passed in an argument, take a look at it.
if ($text) {
$directed = 1;
# If we're case-insensitive, lowercase what they sent us.
# Clean any long strings of whitespace to single spaces.
$text =~ s/\s+/ /g;
# Remove leading and trailing whitespace.
$text =~ s/^\s+//;
$text =~ s/\s+$//;
# If there's not a word left to talk about, return.
if ($text !~ /([-a-zA-Z0-9']+)$/) {
return undef;
}
# If we don't know anything about this word, return.
if (!exists(${$self->{'data'}{'hash'}}{$1})) {
return undef;
}
# Seems like a good starting place, so let's mark it.
$start = ${$self->{'data'}{'hash'}}{$1};
}
# They didn't pass an argument, so we're on our own.
else {
$directed = 0;
# The 0th element in the list is 'special' in that no hash entry points
next;
}
# If we passed our max number of attempts, we can take one of two
# course of action.
else {
# If we're trying to talk about something in particular, we're
# always going to be stuck with the same starting point. Thus,
# there's not the best chance for continued success, so just
# give up and bail.
if ($directed) {
return undef;
}
# If we're talking about random things, we likely just got
# a bad starting point, so we'll pick a new random starting
# point, and do the whole thing over again.
else {
$attempts = 0;
$start = ${${$self->{'data'}{'list'}}[0]{'num'}}[int rand scalar @{${$self->{'data'}{'list'}}[0]{'num'}}];
$text = ${$self->{'data'}{'list'}}[$start]{'word'};
next;
}
To have an amusing experience, you will need to feed the object a body of text.
This text can come from virtually any source, although I enjoy using e-Texts
from the good folks at Project Gutenberg (http://promo.net/pg). To add text to
the state, simply call the B<add()> method on the object, passing it a scalar
containing the text.
$wabby->add($complete_works_of_shakespeare);
It is acceptable for the input text to contain embedded newlines or other such
things. It is acceptable to call the B<add()> method many times, and at any
point in the object's life-span. The B<add()> method will return B<undef> upon
error, and true upon success.
=head2 Generating random sentences
Once you have some text loaded into the object, you can generate random
sentences. To do this, we use the B<spew()> method. The B<spew()> method has
two modes of operation: If no argument is given, it will generate and return a
random sentence. If a single string is passed in, it will generate and return
a random sentence beginning with the provided string.
my $random_sentence = $wabby->spew;
my $not_so_random_sentence = $wabby->spew("Romeo and Juliet");
The B<spew()> method will return the generated string, or B<undef> upon error.
There are several error conditions which can occur in the B<spew()> method.
None of them are fatal, but they must be taken into account by the calling
program. They are:
* At least (min_len * 10) words haven't been run through yet. (Must B<add()>
more text before trying again.)
* A string was passed in containing nothing. (Don't do that.)
* We don't know the last word in the string passed in, and can therefore not
( run in 0.907 second using v1.01-cache-2.11-cpan-d80b1682f3f )