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!


Randal L. Schwartz is a renowned expert on the Perl programming language (the lifeblood of the Internet), having contributed to a dozen top-selling books on the subject, and over 200 magazine articles. Schwartz runs a Perl training and consulting company (Stonehenge Consulting Services, Inc of Portland, Oregon), and is a highly sought-after speaker for his masterful stage combination of technical skill, comedic timing, and crowd rapport. And he's a pretty good Karaoke singer, winning contests regularly.

Schwartz can be reached for comment at merlyn@stonehenge.com or +1 503 777-0095, and welcomes questions on Perl and other related topics.