Copyright Notice
This text is copyright by CMP Media, LLC, and is used with their permission. Further distribution or use is not permitted.This text has appeared in an edited form in SysAdmin/PerformanceComputing/UnixReview magazine. However, the version you are reading here is as the author originally submitted the article for publication, not after their editors applied their creativity.
Please read all the information in the table of contents before using this article.
Unix Review Column 31 (Apr 2000)
[suggested title: Rainy Day Template Fun]
I grew up (and still reside) in Oregon, well-known for having rain nearly all parts of the year. However, the months around April seem to have been particularly wet, and as a child, I'd often end up doing ``indoor'' activities during the heaviest rainy days.
One of the things I remember doing was a game whose name I won't mention so as not to infringe on any trademark, but consisted of two people taking turns asking each other for various items, like ``a noun'' or ``a verb ending in -ed''. Besides teaching us the parts of speech, it also delighted us to know that we had constructed a story by filling in the blanks of a complete story in an unexpected way. Of course, as we got more creative with the answers, we got better stories.
Now, what does this have to do with Perl? Well, I often see questions
online about ``how do I create a fill-in-the-blank template''? For general
applications, the answer is ``go see one of the templating solutions
in the CPAN''. That is, go to http://search.cpan.org
and enter
template
in the search box on the left. You'll see a dozen or
two different ways to take advantage of existing code.
For simple problems, though, an ad-hoc approach may be best. Our story creator software is simple enough that we can code it from scratch, also to show there's nothing magic about the approach. Let's start with a simple template:
The [person] went to the [place].
How do we turn [person]
into the question ``give me a person''
and put the response back in the string? Well, something like this
will work:
$_ = "The [person] went to the [place]."; s/\[(.*?)\]/&process($1)/eg; sub process { print "give me a $_[0]: "; chomp(my $response = <STDIN>); $response; } print;
What we're doing here is going through the value of $_
with the
global substitution. Each time a bracketed item is found, we'll
evaluate the right side of the substitution as Perl code. In this
case, it'll be an invocation of the process
subroutine, passing
$1
as the parameter. The subroutine takes the input parameter to
create a prompt, then reads my response from the result. The return
value of the subroutine becomes the replacement value for the
bracketed item. Note the /eg
on the end of the substitution: for
this, we get the right side as evaluated code, with the
substitution executed globally.
To get a little more flexible, we might also allow multiple words, including newlines, inside the brackets. That'd look like this:
{ local $/; $_ = <DATA> } s/\[(.*?)\]/&process($1)/egs; sub process { my $prompt = shift; $prompt =~ s/\s+/ /g; print "give me a $prompt: "; chomp(my $response = <STDIN>); $response; } print; __END__ The [sad person] went to the [fun place to go].
Now, we'll get the prompts like so:
give me a sad person: ____ give me a fun place to go: ____
And the right values will be filled in appropriately. The addition of
the s
suffix to the substitution operator enables .
to match an
embedded newline. Inside the subroutine, we crunch all embedded
newlines into single spaces. Also note that we're fetching the
template from the DATA
filehandle, which begins at the end of the
program immediately after the __END__
marker.
Now, let's look at a further complication. Suppose I want to ask the questions in an order different from how they'll be used in the story. That makes it more fun, because having an unexpected response to the ordering is often an interesting surprise.
To do this, I'll need a way of asking a prompt, but storing the value instead of immediately substituting it. Let's introduce a variable syntax, like so:
[person=person] [place1=nearby place] [place2=far away place] [$person] went to [$place1], and then to [$place2]. [$person] was [emotion after a long trip].
Here, I'm expecting that we'll ask for a person, two places, then do some substitution, then ask for an emotion and substitute that directly. Note that the person is used twice.
We'll say that a variable has to be a Perl identifier (alphas,
numerics, and underscores), conveniently matched by \w
in a regular
expression. So, brackets can now contain three things, and the
processing subroutine has to distinguish three cases: (1) a simple
prompt, to be substituted, (2) a variable to be prompted for, and
remembered, or (3) a reference to a previously established variable.
We'll hold the variable values in a hash called %value
. So,
process
will look like this:
sub process { my $thing = shift; if ($thing =~ /^\$(\w+)$/) { # variable reference return $value{$1}; }
So far, we'll take the value between the brackets (coming in as $thing
,
and if it's a dollar followed by a variable name, then we'll return
its current value. Next, we fix the embedded newlines, in case
the starting bracket is on a different line from the ending bracket:
$thing =~ s/\s+/ /g; # handle wrapping
And then we'll handle the ``defining'' case:
my $variable; $variable = $1 if $thing =~ s/^(\w+)=//; # may be undef
At this point, $variable
is either undef or the name of a variable
to define and remember. What's left in $thing
is now the prompt to
issue, and that comes next:
print "Give me a", $thing =~ /^[aeiou]/i ? "n " : " ", $thing, ": ";
Note the extra logic here to make it ``an apple'' or ``a carrot'' when given ``apple'' and ``carrot''. Finally, let's finish up the prompting:
chomp(my $response = <STDIN>); if (defined $variable) { $value{$variable} = $response; return ""; } return $response; }
Note that if it's a bracketed item defining a variable, no value is
returned. If you'd rather make a definition also be an invocation
automatically, you can leave out the return ""
. Either way, it's
nice.
So, we've now got some nice code, and it works against our example earlier. If you run this code, however, you may notice that there are some extra newlines in the output. Why is this so? Well, the definition lines:
[person=person] [place1=nearby place] [place2=far away place]
are in fact replaced with ``nothing'' followed by newline, three times.
(If you've hacked m4 before, you may recall this as the need for
frequent dnl()
constructs in your input.) That's a bit messy, so
let's special-case that. If a line consists entirely of a bracketed
item, the trailing newline is automatically swallowed up. Not tough,
but we have to get a bit messy:
s<^\[([^]]+)\]\s*\n|\[([^]]+)\]> {&process(defined $1 ? $1 : $2)}meg;
Here, I again have effectively an s/old/new/eg
operation, split
over two lines, using alternate delimiters. Note that the pattern
to be matched consists of two separate regular expressions joined
by the vertical bar:
^\[([^]]+)\]\s*\n
and
\[([^]]+)\]
The latter should be familiar... it's similar to what we've been using all along. The first one is a match for an entire line consisting only of the bracketed item, so that we can also scarf down the newline.
The right-side replacement text, as code, becomes slightly more
complicated, because we need to use either $1
or $2
, depending
on which item on the left matched. The defined()
took care of
that. And finally, the substitution uses the additional suffix of
m
, meaning that ^
in the regular expression matches any embedded
newline, and coincidentally spelling meg
, because I watched a Meg
Ryan movie last night on DVD.
One final niceity: we have no way to include a literal left or right
bracket in the text, so let's let [LEFT]
and [RIGHT]
stand for
those. That'll work by including these lines early in process
:
return "[" if $thing eq "LEFT"; return "]" if $thing eq "RIGHT";
So, let's put it all together. And as way of demonstrating how easy it
is to get stories to feed into this, I found an archive with several
``fill in the blank'' stories at http://www.mit.edu/storyfun/
, and
stole the following story to tack onto the end of the program:
{ local $/; $_ = <DATA> } s/^\[([^]]+)\]\s*\n|\[([^]]+)\]/&process(defined $1 ? $1 : $2)/meg; sub process { my $thing = shift; return "[" if $thing eq "LEFT"; return "]" if $thing eq "RIGHT"; if ($thing =~ /^\$(\w+)$/) { # variable reference return $value{$1}; } $thing =~ s/\s+/ /g; # handle wrapping my $variable; $variable = $1 if $thing =~ s/^(\w+)=//; # may be undef print "Give me a", $thing =~ /^[aeiou]/i ? "n " : " ", $thing, ": "; chomp(my $response = <STDIN>); if (defined $variable) { $value{$variable} = $response; return ""; } return $response; } print;
__END__ [LEFT]... from http://www.mit.edu/storyfun/I_went_for_a_walk[RIGHT] [adj1=adjective] [place=place] [verbed=verb (ending in -ed)] [adj2=adjective] [nouns=plural noun] [plants=plural plant] [adj3=adjective] [adj4=adjective] [adj5=adjective] [noun=noun] [verbing=verb (ending in -ing)] [verb_past=verb (past tense)] [animals=plural animal]
[your name] went for a walk
Yesterday, I went out walking, and somehow ended up in [$place]. I saw [$plants] and [$animals] -- it was [$adj2]! But I started getting [$adj5] hungry, and needed to find my way home. But no matter where I [$verb_past], I couldn't see the path. I decided to go around the [$adj1] [$noun] up ahead, and discovered that it led back home! I was [$verbed]. At dinner, when I told my [$adj3] story, my [$nouns] looked at me with [$adj4] expressions. Then they forbade me from ever [$verbing] again.
So, never again will you need to worry about those rainy days, or whenever you need to have ``fill in the blank'' templates. Perl can help you pass the time away, and do those tasks more efficiently. Until next time, enjoy!