In this lesson, we're actually going to start writing a few CGI programs. In fact, we're just going to have a bit of fun by presenting you with two small programs in the hopes that you'll start to get a feel for how CGI programming in Perl works and, more importantly, to give you a bit of satisfaction that you're actually doing something. One of the programs will use CGI.pm's HTML generating functions and the other one will use here-documents to embed the HTML. This will give you the opportunity to feel comfortable with both styles.
Let's start out by creating a little CGI template upon which you'll build your other programs.
1 #!/usr/local/bin/perl -T
2 use strict;
3 use warnings;
4 use CGI qw/:standard/;
5
6 use constant TITLE => 'Template for Programs';
7
8 print
9 header,
10 start_html(-title => TITLE),
11 h1(TITLE),
12 hr,
13 p("Here's where the content will go"),
14 hr,
15 end_html;We'll go ahead and use the CGI.pm HTML generating functions because they generate valid XHTML (thus freeing us from worrying about why our page won't render) and because it's much cleaner style. Those functions, by the way, generate the XHTML semantically equivalent to the following:
<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>Template for Programs</title>
</head>
<body>
<h1>Template for Programs</h1>
<hr />
<p>Here's where the content will go</p>
<hr />
</body>
</html>This template will prove useful as we later want to create another small program and have the shell in place for us. Of course, when programming real systems for a business, you'll rarely see something so simplistic, but it can be fun to get back to the "good ol' days" of the web, when stuff like this was cutting edge.
For our first program, let's roll some dice. Perhaps you're familiar with some sort of role-playing game such as Dungeons & Dragons. These games often have dice with many different sides: 4, 6, 8, 10, 12, and 20-sided dice are the most common. They are used to generate random numbers with certain simple distributions. To see if you could hit an enemy with your sword, you might roll a 20-sided dice once. To generate statistics for your character (such as strength, intelligence, etc.,) you might have to roll two 10-sided dice or three 6-sided dice. Let's write a short program to do that.
Debugging tips
Don't forget: if you get an "Internal Server Error" and can't figure out what is wrong, you can add the following line to your code:
use CGI::Carp qw/fatalsToBrowser/;
That should show the error in the browser. Don't forget to remove it for production!
Also, you can test from the command line whether or not your program compiles.
perl -Tc myprog.pl
The T switch is needed to have Perl launch with taint checking enabled and the c switch tells Perl to only compile the program, don't run it. However, any code in BEGIN {} blocks will still be run, but that's beyond the scope of this tutorial.
As a final note, if you have Perl 5.8 or above, you can use the "little t" switch. This switch merely warns about taint violations, it does not kill the program. This is useful when you're trying to convert older programs over to taint mode.
First, we want the form:
| Number of rolls: | |
| Number of sides: |
Whenever you need a quick refresher on CGI.pm's HTML generating functions, you can refer to the CGI.pm documentation.
The code for the form looks something like this:
print start_form,
table(
Tr([
td(['Number of rolls: ', textfield(-name => 'rolls')]),
]),
Tr([
td(['Number of sides: ', textfield(-name => 'sides')]),
]),
),
submit(-value => 'Roll!'),
end_form;We might roll one die with X sides like this:
sub roll {
my $sides = shift;
return int(rand($sides)) + 1;
}And to roll several of them, we can wrap this in another function:
sub roll_dice {
my ($rolls, $sides) = @_;
my $total = 0;
$total += roll($sides) for 1 .. $rolls;
return $total;
}Putting that all together with some code to read the form data gives us the following:
1 #!/usr/local/bin/perl -Tw
2 use strict;
3 use CGI::Pretty qw/:standard/;
4
5 use constant TITLE => 'Dice Rolling';
6 my $_rolls = param('rolls');
7 my $_sides = param('sides');
8
9 my ($rolls) = $_rolls =~ /^(\d+)$/;
10 my ($sides) = $_sides =~ /^(\d+)$/;
11
12 my $show_result = '';
13
14 if ($rolls && $sides) {
15 my $result = roll_dice($rolls, $sides);
16 $show_result = p("${rolls}d${sides} result: $result");
17 }
18
19 sub roll_dice {
20 my ($rolls, $sides) = @_;
21 my $total = 0;
22 $total += roll($sides) for 1 .. $rolls;
23 return $total;
24 }
25
26 sub roll {
27 my $sides = shift;
28 return int(rand($sides)) + 1;
29 }
30
31 print
32 header,
33 start_html(-title => TITLE),
34 h1(TITLE),
35 hr,
36 $show_result,
37 start_form,
38 table(
39 Tr([
40 td(['Number of rolls: ', textfield(-name => 'rolls')]),
41 ]),
42 Tr([
43 td(['Number of sides: ', textfield(-name => 'sides')]),
44 ]),
45 ),
46 submit(-value => 'Roll!'),
47 end_form,
48 hr,
49 end_html;Now go ahead and try running that program and see what it does.
Many of us used to (or still do) play role playing games (RPGs). In these games, you used paper and dice and imagination and potato chips and soda to create an imaginary world where your characters could do everything you really want to do now but would get slapped, arrested or killed if you actually tried it. In these games, you played a "character" and this character would have some basic information called "stats" which tracked such things as how strong they were, how healthy, etc.
For the next program, we'll go ahead and roll some stats for different species ("races", in RPG lingo) of characters: humans, elves, and dwarves. We'll also use the more common here-document syntax. It's messier, but it's also easier to see what's going on.
First, we'll go ahead and reuse the roll() and roll_dice() subroutines from the previous program. In the real world, you'd probably want to move these into their own package, for proper code reuse. Read the perlmod documentation or Mark Jason Dominus' very, very short tutorial about modules in Perl, if you're interested in learning more about this.
First, we'll create some constants representing the various attributes a character can posses.
use constant STR => 0; use constant INT => 1; use constant WIS => 2; use constant CON => 3; use constant DEX => 4; use constant CHA => 5;
We'll use those constants later when we index into the array listing the attributes:
my @stats = qw/
Strength
Intelligence
Wisdom
Constitution
Dexterity
Charisma
/;We're about to start using complex data structure. In this case, it's a hash of hashes (or "HoH" for short). If you're not familiar with complex data structures, read the perlreftut documentation to see how these work. It's difficult to get real work done in Perl without them.
Next, we'll define the three races. In role-playing games, when characters are first generated, their various statistics are often adjusted up or down based upon the race's natural abilities. We'll refer to this as the "stat adjustment". Let's create a data structure which will let us keep track of these abilities.
my %races = (
human => {},
elf => {
DEX, +1,
INT, -1
},
dwarf => {
STR, +1,
WIS, -1
},
);Now if you've been programming Perl for a while, this may look a bit strange. We have a hash of races with each race pointing to a hash of attributes. However, you're probably used to seeing something like this:
my %races = (
human => {},
elf => {
DEX => +1,
INT => -1
},
dwarf => {
STR => +1,
WIS => -1
}
);The reason we use a normal comma (,) instead of the so-called "fat comma" (=>) is because the fat comma automagically quotes whatever is on the left (if it can). We don't want the keys treated as strings. Instead, we want the keys to be the numeric values represented by the constants. We'll see why in a bit, but first, let's look at the dropdown we'll create for the form. This drop down lets the person choose which race of character they wish to create.
1 my $dropdown = make_dropdown(%races);
2
03 sub make_dropdown {
04 my %races = @_;
05 my $options = "";
06 foreach my $race (keys %races) {
07 my $label = ucfirst $race;
08 $options .= qq| <option value="$race">$label</option>\n|;
09 }
10 my $select = qq|<select name="race">$options</select>\n|;
11 return $select;
12 }When that runs, $dropdown will have a value similar to this:
<select name="race"> <option value="human">Human</option> <option value="elf">Elf</option> <option value="dwarf">Dwarf</option> </select>
That one is pretty simple. We merely iterate over the keys in the hash (line 06) and we make the first character upper-case (line 07) for the value the user will see in the form and we'll make the key the value which gets sent back to the server.
Generating the character will be a bit more difficult, though, so let's look at this closely. Here will see why we wanted the numeric keys in the %races hash.
1 my $character = generate_character(\@stats, \%races);
2
3 sub generate_character {
4 my ($stats, $races) = @_;
5 my $_race = param('race');
6 my ($race) = $_race =~ /^(\w+)$/; # untaint it
7 return '' unless exists $races->{$race};
8 my $this_race = $races->{$race};
9 my $rows = '';
10 foreach my $stat_index (0 .. $#$stats) {
11 my $label = $stats->[$stat_index];
12 my $roll = roll_dice(3,6);
13 if (exists $this_race->{$stat_index}) {
14 $roll += $this_race->{$stat_index};
15 }
16 $rows .= <<END_ROW;
17 <tr>
18 <td>$label: </td>
19 <td>$roll</td>
20 </tr>
21 END_ROW
22 }
23 my $desription = "<p>Stats for a $race</p>\n";
24 my $table = "$description<table>$rows</table>";
25 return $table;
26 }This subroutine is doing quite a bit. In lines 4 through 6, we see that we're fetching the value of 'race' which is supplied via the drop-down on the page. In reality, we don't need to untaint 'race' here as we're not doing anything unsafe with it, but it's better to be too cautious than not cautious enough.
In line 8, we go ahead and fetch the appropriate race from the %races hash. This is not strictly necessary, but if we didn't, lines 13 and 14 would look even messier:
13 if (exists $races->{$race}{$stat_index}) {
14 $roll += $races->{$race}{$stat_index};
15 }On line 10, we start iterating over the indexes of the stats, not the stats themselves. The reason we do this is each race has a hashref where we can determine the "stat adjustment" by doing a hash lookup on the stat index. In line 14, we can see that offset has been added to the die roll.
Lines 16 through 20 are where we build up the table row and line 24 has us creating the actual table.
It's worth noting that we're doing three things in this one subroutine:
As a general rule it's considered bad style to have a subroutine try to do too many things. In fact, the subroutine has deliberately been left this way because exercise two for this lesson shows why this is a bad thing, but we'll get to that later.
Now that we have all of our building blocks in place, let's go ahead and put them together.
1 #!/usr/local/bin/perl -Tw
2 use strict;
3 use CGI::Pretty qw/:standard/;
4
5 use constant STR => 0;
6 use constant INT => 1;
7 use constant WIS => 2;
8 use constant CON => 3;
9 use constant DEX => 4;
10 use constant CHA => 5;
11
12 my $TITLE = 'Generate Characters';
13
14 my @stats = qw/
15 Strength
16 Intelligence
17 Wisdom
18 Constitution
19 Dexterity
20 Charisma
21 /;
22
23 my %races = (
24 human => {},
25 elf => {
26 DEX, +1,
27 INT, -1
28 },
29 dwarf => {
30 STR, +1,
31 WIS, -1
32 },
33 );
34
35 my $dropdown = make_dropdown(%races);
36 my $character = generate_character(\@stats, \%races);
37
38 print header,
39 <<END_HTML;
40 <!DOCTYPE html
41 PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
42 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
43 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
44 <head>
45 <title>$TITLE</title>
46 </head>
47 <body>
48 <h1>$TITLE</h1>
49 <hr />
50 <form action="stats.pl">
51 $dropdown
52 <br />
53 <input type="submit" value="Create Character" />
54 </form>
55 $character
56 <hr />
57 </body>
58 </html>
59 END_HTML
60
61 sub generate_character {
62 my ($stats, $races) = @_;
63 my $_race = param('race');
64 my ($race) = $_race =~ /^(\w+)$/; # untaint it
65 return '' unless exists $races->{$race};
66 my $this_race = $races->{$race};
67 my $rows = '';
68 foreach my $stat_index (0 .. $#$stats) {
69 my $label = $stats->[$stat_index];
70 my $roll = roll_dice(3,6);
71 if (exists $this_race->{$stat_index}) {
72 $roll += $this_race->{$stat_index};
73 }
74 $rows .= <<END_ROW;
75 <tr>
76 <td>$label: </td>
77 <td>$roll</td>
78 </tr>
79 END_ROW
80 }
81 my $description = "<p>Stats for a $race</p>\n";
82 my $table = "$description<table>$rows</table>";
83 return $table;
84 }
85
86 sub make_dropdown {
87 my %races = @_;
88 my $options = "";
89 foreach my $race (keys %races) {
90 my $label = ucfirst $race;
91 $options .= qq| <option value="$race">$label</option>\n|;
92 }
93 my $select = qq|<select name="race">$options</select>\n|;
94 return $select;
95 }
96
97 sub roll_dice {
98 my ($rolls, $sides) = @_;
99 my $total = 0;
100 $total += roll($sides) for 1 .. $rolls;
101 return $total;
102 }
103
104 sub roll {
105 my $sides = shift;
106 return int(rand($sides)) + 1;
107 }That's a lot of typing, but the payoff is worth it. You'll understand a lot more about basic CGI programming by going through it. You'll note that up through line 33, we are primarily declaring the data we will use throughout the program. Lines 61 and beyond are the subroutines we will use. The actual "work" is done on lines 34 through 38: making the drop down, generating the character and printing the document. Further, you'll notice that the subroutines are all little black boxes. If you feed them the right data, they'll give the right responses, no matter where they are placed. This makes it easy to reuse them elsewhere (preferably as part of a module so they only need to be written once.)
my $dropdown = make_dropdown(%races);
my $character = generate_character(\@stats, \%races);
my $html = html_doc($title, $dropdown, $character);
print header, $html;
sub html_doc {
my ($title, $form, $result) = @_;
...Hints for exercise 2:
<option value="elf" selected="selected">Elf</option>
| Answers to Lesson 6 Exercises | Next Lesson: Basic cookie handling |