19. CGI Programming

Introduction

#-----------------------------
# http://www.perl.com/CPAN/
# http://www.perl.com:8001/bad/mojo.html
# ftp://gatekeeper.dec.com/pub/misc/netlib.tar.Z
# ftp://anonymous@myplace:gatekeeper.dec.com/pub/misc/netlib.tar.Z
# file:///etc/motd
#-----------------------------
# http://mox.perl.com/cgi-bin/program?name=Johann&born=1685
#-----------------------------
# http://mox.perl.com/cgi-bin/program
#-----------------------------

Writing a CGI Script

#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# hiweb - load CGI module to decode information given by web server
use strict;

use CGI qw(:standard escapeHTML);

# get a parameter from a form
my $value = param('PARAM_NAME');

# output a document
print header(), start_html("Howdy there!"),
      p("You typed: ", tt(escapeHTML($value))),
      end_html();

#-----------------------------
use CGI qw(:standard);
$who   = param("Name");
$phone = param("Number");
@picks = param("Choices");
#-----------------------------
print header( -TYPE    => 'text/plain',
              -EXPIRES => '+3d' );
#-----------------------------

Redirecting Error Messages

#-----------------------------
use CGI::Carp;
warn "This is a complaint";
die "But this one is serious";
#-----------------------------
BEGIN {
    use CGI::Carp qw(carpout);
    open(LOG, ">>/var/local/cgi-logs/mycgi-log")
        or die "Unable to append to mycgi-log: $!\n";
    carpout(*LOG);
}
#-----------------------------
use CGI::Carp qw(fatalsToBrowser);
die "Bad error here";
#-----------------------------

Fixing a 500 Server Error

#-----------------------------
# download the following standalone program
#!/usr/bin/perl
# webwhoami - show web users id
print "Content-Type: text/plain\n\n";
print "Running as ", scalar getpwuid($>), "\n";

#-----------------------------
#% perl -wc cgi-script        # just compilation
#
#% perl -w  cgi-script        # parms from stdin
#(offline mode: enter name=value pairs on standard input)
#
#name=joe
#
#number=10
#
#^D
#
#
#% perl -w  cgi-script name=joe number=10    # run with mock form input
#% perl -d  cgi-script name=joe number=10    # ditto, under the debugger
#
## POST method script in csh
#% (setenv HTTP_METHOD POST; perl -w cgi-script name=joe number=10)
## POST method script in sh
#% HTTP_METHOD=POST perl -w cgi-script name=joe number=10
#-----------------------------
#% perl -MCGI -le 'print CGI->VERSION'
#2.49
#-----------------------------
$| = 1;
#-----------------------------

Writing a Safe CGI Program

#-----------------------------
#!/usr/bin/perl -T
open(FH, "> $ARGV[0]") or die;
#-----------------------------
# Insecure dependency in open while running with -T switch at ...
#-----------------------------
$file = $ARGV[0];                                   # $file tainted
unless ($file =~ m#^([\w.-]+)$#) {                  # $1 is untainted
    die "filename '$file' has invalid characters.\n";
}
$file = $1;                                         # $file untainted
#-----------------------------
unless (-e $filename) {                     # WRONG!
    open(FH, "> $filename");
    # ...
}
#-----------------------------

Making CGI Scripts Efficient

#-----------------------------
#Alias /perl/ /real/path/to/perl/scripts/
#
#<Location /perl>
#SetHandler  perl-script
#PerlHandler Apache::Registry
#Options ExecCGI
#</Location>
#
#PerlModule Apache::Registry
#PerlModule CGI
#PerlSendHeader On
#-----------------------------
#<Files *.perl>
#SetHandler  perl-script
#PerlHandler Apache::Registry
#Options ExecCGI
#</Files>
#-----------------------------

Executing Commands Without Shell Escapes

#-----------------------------
system("command $input @files");            # UNSAFE
#-----------------------------
system("command", $input, @files);          # safer
#-----------------------------
chomp($now = `date`);
#-----------------------------
@output = `grep $input @files`;
#-----------------------------
die "cannot fork: $!" unless defined ($pid = open(SAFE_KID, "|-"));
if ($pid == 0) {
    exec('grep', $input, @files) or die "can't exec grep: $!";
} else {
    @output = <SAFE_KID>;
    close SAFE_KID;                 # $? contains status
}
#-----------------------------
open(KID_TO_READ, "$program @options @args |");    # UNSAFE
#-----------------------------
# add error processing as above
die "cannot fork: $!" unless defined($pid = open(KID_TO_READ, "-|"));

if ($pid) {   # parent
   while (<KID_TO_READ>) {
       # do something interesting
   }
   close(KID_TO_READ)               or warn "kid exited $?";

} else {      # child
   # reconfigure, then
   exec($program, @options, @args)  or die "can't exec program: $!";
}
#-----------------------------
open(KID_TO_WRITE, "|$program $options @args");   # UNSAFE
#-----------------------------
$pid = open(KID_TO_WRITE, "|-");
die "cannot fork: $!" unless defined($pid = open(KID_TO_WRITE, "|-"));
$SIG{ALRM} = sub { die "whoops, $program pipe broke" };

if ($pid) {  # parent
   for (@data) { print KID_TO_WRITE $_ }
   close(KID_TO_WRITE)              or warn "kid exited $?";

} else {     # child
   # reconfigure, then
   exec($program, @options, @args)  or die "can't exec program: $!";
}
#-----------------------------

Formatting Lists and Tables with HTML Shortcuts

#-----------------------------
print ol( li([ qw(red blue green)]) );
# <OL><LI>red</LI> <LI>blue</LI> <LI>green</LI></OL>

@names = qw(Larry Moe Curly);
print ul( li({ -TYPE => "disc" }, \@names) );
# <UL><LI TYPE="disc">Larry</LI> <LI TYPE="disc">Moe</LI>
#
#     <LI TYPE="disc">Curly</LI></UL>
#-----------------------------
print li("alpha");
#     <LI>alpha</LI>

print li( [ "alpha", "omega"] );
#     <LI>alpha</LI> <LI>omega</LI>
#-----------------------------
use CGI qw(:standard :html3);

%hash = (
    "Wisconsin"  => [ "Superior", "Lake Geneva", "Madison" ],
    "Colorado"   => [ "Denver", "Fort Collins", "Boulder" ],
    "Texas"      => [ "Plano", "Austin", "Fort Stockton" ],
    "California" => [ "Sebastopol", "Santa Rosa", "Berkeley" ],
);

$\ = "\n";

print "<TABLE> <CAPTION>Cities I Have Known</CAPTION>";
print Tr(th [qw(State Cities)]);
for $k (sort keys %hash) {
    print Tr(th($k), td( [ sort @{$hash{$k}} ] ));
}
print "</TABLE>";
#-----------------------------
# <TABLE> <CAPTION>Cities I Have Known</CAPTION>
# 
#     <TR><TH>State</TH> <TH>Cities</TH></TR>
# 
#     <TR><TH>California</TH> <TD>Berkeley</TD> <TD>Santa Rosa</TD> 
# 
#         <TD>Sebastopol</TD> </TR>
# 
#     <TR><TH>Colorado</TH> <TD>Boulder</TD> <TD>Denver</TD> 
# 
#         <TD>Fort Collins</TD> </TR>
# 
#     <TR><TH>Texas</TH> <TD>Austin</TD> <TD>Fort Stockton</TD> 
# 
#         <TD>Plano</TD></TR>
# 
#     <TR><TH>Wisconsin</TH> <TD>Lake Geneva</TD> <TD>Madison</TD> 
# 
#         <TD>Superior</TD></TR>
# 
# </TABLE>
#-----------------------------
print table
        caption('Cities I have Known'),
        Tr(th [qw(State Cities)]),
        map { Tr(th($_), td( [ sort @{$hash{$_}} ] )) } sort keys %hash;
#-----------------------------
# download the following standalone program
#!/usr/bin/perl
# salcheck - check for salaries
use DBI;
use CGI qw(:standard :html3);

$limit = param("LIMIT");

print header(), start_html("Salary Query"),
      h1("Search"),
      start_form(),
      p("Enter minimum salary", textfield("LIMIT")),
      submit(),
      end_form();

if (defined $limit) {
    $dbh = DBI->connect("dbi:mysql:somedb:server.host.dom:3306", 
        "username", "password") 
        or die "Connecting: $DBI::errstr";
    $sth = $dbh->prepare("SELECT name,salary FROM employees 
        WHERE salary > $limit")
        or die "Preparing: ", $dbh->errstr;
    $sth->execute
        or die "Executing: ", $sth->errstr;

    print h1("Results"), "<TABLE BORDER=1>";

    while (@row = $sth->fetchrow()) {
           print Tr( td( \@row ) );
    }

    print "</TABLE>\n";
    $sth->finish;
    $dbh->disconnect;
}

print end_html();

#-----------------------------

Redirecting to a Different Location

#-----------------------------
$url = "http://www.perl.com/CPAN/";
print "Location: $url\n\n";
exit;
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# oreobounce - set a cookie and redirect the browser
use CGI qw(:cgi);

$oreo = cookie( -NAME    => 'filling',
                -VALUE   => "vanilla crème",
                -EXPIRES => '+3M',    # M for month, m for minute
                -DOMAIN  => '.perl.com');

$whither  = "http://somewhere.perl.com/nonesuch.html";

print redirect( -URL     => $whither,
                -COOKIE  => $oreo);

#-----------------------------
#Status: 302 Moved Temporarily
#
#Set-Cookie: filling=vanilla%20cr%E4me; domain=.perl.com; 
#
#    expires=Tue, 21-Jul-1998 11:58:55 GMT
#
#Date: Tue, 21 Apr 1998 11:55:55 GMT
#
#Location: http://somewhere.perl.com/nonesuch.html
#
#Content-Type: text/html
#
#B<<blank line here>>
#-----------------------------
# download the following standalone program
#!/usr/bin/perl
# os_snipe - redirect to a Jargon File entry about current OS
$dir = 'http://www.wins.uva.nl/%7Emes/jargon';
for ($ENV{HTTP_USER_AGENT}) {
    $page  =    /Mac/            && 'm/Macintrash.html'
             || /Win(dows )?NT/  && 'e/evilandrude.html'
             || /Win|MSIE|WebTV/ && 'm/MicroslothWindows.html'
             || /Linux/          && 'l/Linux.html'
             || /HP-UX/          && 'h/HP-SUX.html'
             || /SunOS/          && 's/ScumOS.html'
             ||                     'a/AppendixB.html';
}
print "Location: $dir/$page\n\n";

#-----------------------------
use CGI qw(:standard);
print header( -STATUS => '204 No response' );
#-----------------------------
#Status: 204 No response
#
#Content-Type: text/html
#
#<blank line here>
#-----------------------------
#!/bin/sh

cat <<EOCAT
Status: 204 No response
 
EOCAT
#-----------------------------

Debugging the Raw HTTP Exchange

#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# dummyhttpd - start an HTTP daemon and print what the client sends

use strict;
use HTTP::Daemon;  # need LWP-5.32 or better

my $server = HTTP::Daemon->new(Timeout => 60);
print "Please contact me at: <URL:", $server->url, ">\n";

while (my $client = $server->accept) {
  CONNECTION:
    while (my $answer = $client->get_request) {
        print $answer->as_string;
        $client->autoflush;
      RESPONSE:
        while (<STDIN>) {
            last RESPONSE   if $_ eq ".\n";
            last CONNECTION if $_ eq "..\n";
            print $client $_;
        }
        print "\nEOF\n";
    }
    print "CLOSE: ", $client->reason, "\n";
    $client->close;
    undef $client;
}

#-----------------------------
#http://somewhere.com/cgi-bin/whatever
#-----------------------------
#http://somewhere.com:8989/cgi-bin/whatever
#-----------------------------
#% telnet www.perl.com 80
#GET /bogotic HTTP/1.0
#
#<blank line here>
#
#HTTP/1.1 404 File Not Found
#
#Date: Tue, 21 Apr 1998 11:25:43 GMT
#
#Server: Apache/1.2.4
#
#Connection: close
#
#Content-Type: text/html
#
#
#<HTML><HEAD>
#
#<TITLE>404 File Not Found</TITLE>
#
#</HEAD><BODY>
#
#<H1>File Not Found</H1>
#
#The requested URL /bogotic was not found on this server.<P>
#
#</BODY></HTML>
#-----------------------------
% GET -esuSU http://mox.perl.com/perl/bogotic
# GET http://language.perl.com/bogotic
# 
# Host: mox.perl.com
# 
# User-Agent: lwp-request/1.32
# 
# 
# GET http://mox.perl.com/perl/bogotic --> 302 Moved Temporarily
# 
# GET http://www.perl.com/perl/bogotic --> 302 Moved Temporarily
# 
# GET http://language.perl.com/bogotic --> 404 File Not Found
# 
# Connection: close
# 
# Date: Tue, 21 Apr 1998 11:29:03 GMT
# 
# Server: Apache/1.2.4
# 
# Content-Type: text/html
# 
# Client-Date: Tue, 21 Apr 1998 12:29:01 GMT
# 
# Client-Peer: 208.201.239.47:80
# 
# Title: Broken perl.com Links
# 
# 
# <HTML>
# 
# <HEAD><TITLE>An Error Occurred</TITLE></HEAD>
# 
# <BODY>
# 
# <H1>An Error Occurred</h1>
# 
# 404 File Not Found
# 
# </BODY>
# 
# </HTML>
#-----------------------------

Managing Cookies

#-----------------------------
$preference_value = cookie("preference name");
#-----------------------------
$packed_cookie = cookie( -NAME    => "preference name",
                         -VALUE   => "whatever you'd like",
                         -EXPIRES => "+2y");
#-----------------------------
print header(-COOKIE => $packed_cookie);
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# ic_cookies - sample CGI script that uses a cookie
use CGI qw(:standard);

use strict;

my $cookname = "favorite ice cream";
my $favorite = param("flavor");
my $tasty    = cookie($cookname) || 'mint';

unless ($favorite) {
    print header(), start_html("Ice Cookies"), h1("Hello Ice Cream"),
          hr(), start_form(),
            p("Please select a flavor: ", textfield("flavor",$tasty)),
              end_form(), hr();
    exit;
}

my $cookie = cookie(
                -NAME    => $cookname,
                -VALUE   => $favorite,
                -EXPIRES => "+2y",
            );

print header(-COOKIE => $cookie),
      start_html("Ice Cookies, #2"),
      h1("Hello Ice Cream"),
      p("You chose as your favorite flavor `$favorite'.");

#-----------------------------

Creating Sticky Widgets

#-----------------------------
print textfield("SEARCH");          # previous SEARCH value is the default
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -wT
# who.cgi - run who(1) on a user and format the results nicely

$ENV{IFS}='';
$ENV{PATH}='/bin:/usr/bin';

use CGI qw(:standard);

# print search form
print header(), start_html("Query Users"), h1("Search");
print start_form(), p("Which user?", textfield("WHO")); submit(), end_form();

# print results of the query if we have someone to look for
$name = param("WHO");
if ($name) {
    print h1("Results");
    $html = '';
    
    # call who and build up text of response
    foreach (`who`) {
        next unless /^$name\s/o;            # only lines matching $name
        s/&/&amp;/g;                        # escape HTML
        s/</&lt;/g;
        s/>/&gt;/g;
        $html .= $_;
    }
    # nice message if we didn't find anyone by that name
    $html = $html || "$name is not logged in";
    
    print pre($html);
}

print end_html();

#-----------------------------

Writing a Multiscreen CGI Script

#-----------------------------
use CGI qw(:standard);
print hidden("bacon");
#-----------------------------
    print submit(-NAME => ".State", -VALUE => "Checkout");
#-----------------------------
sub to_page { return submit( -NAME => ".State", -VALUE => shift ) }
#-----------------------------
$page = param(".State") || "Default";
#-----------------------------
if ($page eq "Default") {
    front_page();
} elsif ($page eq "Checkout") {
    checkout();
} else {
    no_such_page();         # when we get a .State that doesn't exist
}
#-----------------------------
%States = (
    'Default'     => \&front_page,
    'Shirt'       => \&shirt,
    'Sweater'     => \&sweater,
    'Checkout'    => \&checkout,
    'Card'        => \&credit_card,
    'Order'       => \&order,
    'Cancel'      => \&front_page,
);

if ($States{$page}) {
    $States{$page}->();   # call the correct subroutine 
} else {
    no_such_page();
}
#-----------------------------
while (($state, $sub) = each %States) {
    $sub->( $page eq $state );
}
#-----------------------------
sub t_shirt {
    my $active = shift;

    unless ($active) {
        print hidden("size"), hidden("color");
        return;
    }

    print p("You want to buy a t-shirt?");
    print p("Size: ", popup_menu('size', [ qw(XL L M S XS) ]));
    print p("Color:", popup_menu('color', [ qw(Black White) ]));

    print p( to_page("Shoes"), to_page("Checkout") );
}
#-----------------------------
print header("Program Title"), start_html();
print standard_header(), begin_form();
while (($state, $sub) = each %States) {
    $sub->( $page eq $state );
}
print standard_footer(), end_form(), end_html();
#-----------------------------

Saving a Form to a File or Mail Pipe

#-----------------------------
# first open and exclusively lock the file
open(FH, ">>/tmp/formlog")              or die "can't append to formlog: $!";
flock(FH, 2)                            or die "can't flock formlog: $!";

# either using the procedural interface
use CGI qw(:standard);
save_parameters(*FH);                   # with CGI::save

# or using the object interface
use CGI;
$query = CGI->new();
$query->save(*FH);

close(FH)                               or die "can't close formlog: $!";
#-----------------------------
use CGI qw(:standard);
open(MAIL, "|/usr/lib/sendmail -oi -t") or die "can't fork sendmail: $!";
print MAIL <<EOF;
From: $0 (your cgi script)
To: hisname\@hishost.com
Subject: mailed form submission

EOF
save_parameters(*MAIL);
close(MAIL)                             or die "can't close sendmail: $!"; 
#-----------------------------
param("_timestamp", scalar localtime);
param("_environs", %ENV);
#-----------------------------
use CGI;
open(FORMS, "< /tmp/formlog")       or die "can't read formlog: $!";
flock(FORMS, 1)                     or die "can't lock formlog: $!";
while ($query = CGI->new(*FORMS)) {
    last unless $query->param();     # means end of file
    %his_env = $query->param('_environs');
    $count  += $query->param('items requested')
                unless $his_env{REMOTE_HOST} =~ /(^|\.)perl\.com$/
}
print "Total orders: $count\n";
#-----------------------------

Program: chemiserie

#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# chemiserie - simple CGI shopping for shirts and sweaters

use strict;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);

my %States;              # state table mapping pages to functions
my $Current_Screen;     # the current screen

# Hash of pages and functions.

%States = (
    'Default'     => \&front_page,
    'Shirt'       => \&shirt,
    'Sweater'     => \&sweater,
    'Checkout'    => \&checkout,
    'Card'        => \&credit_card,
    'Order'       => \&order,
    'Cancel'      => \&front_page,
);

$Current_Screen = param(".State") || "Default";
die "No screen for $Current_Screen" unless $States{$Current_Screen};

# Generate the current page.

standard_header();

while (my($screen_name, $function) = each %States) {
    $function->($screen_name eq $Current_Screen);
}
standard_footer();
exit;

################################
# header, footer, menu functions
################################

sub standard_header {
    print header(), start_html(-Title => "Shirts", -BGCOLOR=>"White");
    print start_form(); # start_multipart_form() if file upload
}

sub standard_footer { print end_form(), end_html() }

sub shop_menu {
    print p(defaults("Empty My Shopping Cart"),
        to_page("Shirt"),
        to_page("Sweater"),
        to_page("Checkout"));
}

#############################
# subroutines for each screen
#############################

# The default page.
sub front_page {
    my $active = shift;
    return unless $active;

    print "<H1>Hi!</H1>\n";
    print "Welcome to our Shirt Shop!  Please make your selection from ";
    print "the menu below.\n";

    shop_menu();
}

# Page to order a shirt from.
sub shirt {
    my $active = shift;
    my @sizes  = qw(XL L M S);
    my @colors = qw(Black White);

    my ($size, $color, $count) =
      (param("shirt_size"), param("shirt_color"), param("shirt_count"));

    # sanity check
    if ($count) {
        $color = $colors[0] unless grep { $_ eq $color } @colors;
        $size  = $sizes[0]  unless grep { $_ eq $size  } @sizes;
        param("shirt_color", $color);
        param("shirt_size",  $size);
    }

    unless ($active) {
        print hidden("shirt_size")  if $size;
        print hidden("shirt_color") if $color;
        print hidden("shirt_count") if $count;
        return;
    }

    print h1("T-Shirt");
    print p("What a shirt!  This baby is decked out with all the options.",
        "It comes with full luxury interior, cotton trim, and a collar",
        "to make your eyes water!  Unit price: \$33.00");
    print h2("Options");
    print p("How Many?", textfield("shirt_count"));
    print p("Size?",  popup_menu("shirt_size",  \@sizes ),
        "Color?", popup_menu("shirt_color", \@colors));

    shop_menu();
}

# Page to order a sweater from.
sub sweater {
    my $active = shift;
    my @sizes  = qw(XL L M);
    my @colors = qw(Chartreuse Puce Lavender);

    my ($size, $color, $count) =
      (param("sweater_size"), param("sweater_color"), param("sweater_count"));

    # sanity check
    if ($count) {
        $color = $colors[0] unless grep { $_ eq $color } @colors;
        $size  = $sizes[0]  unless grep { $_ eq $size  } @sizes;
        param("sweater_color", $color);
        param("sweater_size",  $size);
    }

    unless ($active) {
        print hidden("sweater_size")  if $size;
        print hidden("sweater_color") if $color;
        print hidden("sweater_count") if $count;
        return;
    }

    print h1("Sweater");
    print p("Nothing implies preppy elegance more than this fine",
        "sweater.  Made by peasant workers from black market silk,",
        "it slides onto your lean form and cries out ``Take me,",
        "for I am a god!''.  Unit price: \$49.99.");
    print h2("Options");
    print p("How Many?", textfield("sweater_count"));
    print p("Size?",  popup_menu("sweater_size",  \@sizes));
    print p("Color?", popup_menu("sweater_color", \@colors));

    shop_menu();
}

# Page to display current order for confirmation.
sub checkout {
    my $active = shift;

    return unless $active;

    print h1("Order Confirmation");
    print p("You ordered the following:");
    print order_text();
    print p("Is this right?  Select 'Card' to pay for the items",
        "or 'Shirt' or 'Sweater' to continue shopping.");
    print p(to_page("Card"),
        to_page("Shirt"), 
        to_page("Sweater"));
}

# Page to gather credit-card information.
sub credit_card {
    my $active = shift;
    my @widgets = qw(Name Address1 Address2 City Zip State Phone Card Expiry);

    unless ($active) {
        print map { hidden($_) } @widgets;
        return;
    }

    print pre(p("Name:          ", textfield("Name")),
          p("Address:       ", textfield("Address1")),
          p("               ", textfield("Address2")),
          p("City:          ", textfield("City")),
          p("Zip:           ", textfield("Zip")),
          p("State:         ", textfield("State")),
          p("Phone:         ", textfield("Phone")),
          p("Credit Card #: ", textfield("Card")),
          p("Expiry:        ", textfield("Expiry")));

    print p("Click on 'Order' to order the items.  Click on 'Cancel' to return 
shopping.");

    print p(to_page("Order"), to_page("Cancel"));
}

# Page to complete an order.
sub order {
    my $active = shift;

    unless ($active) {
        return;
    }

    # you'd check credit card values here

    print h1("Ordered!");
    print p("You have ordered the following toppings:");
    print order_text();

    print p(defaults("Begin Again"));
}

# Returns HTML for the current order ("You have ordered ...")
sub order_text {
    my $html = '';

    if (param("shirt_count")) {
        $html .= p("You have ordered ", param("shirt_count"),
               " shirts of size ",  param("shirt_size"),
               " and color ", param("shirt_color"), ".");
    }
    if (param("sweater_count")) {
        $html .= p("You have ordered ",  param("sweater_count"),
               " sweaters of size ", param("sweater_size"),
               " and color ", param("sweater_color"), ".");
    }
    $html = p("Nothing!") unless $html;
    $html .= p("For a total cost of ", calculate_price());
    return $html;
}

sub calculate_price {
    my $shirts   = param("shirt_count")   || 0;
    my $sweaters = param("sweater_count") || 0;
    return sprintf("\$%.2f", $shirts*33 + $sweaters * 49.99);
}

sub to_page { submit(-NAME => ".State", -VALUE => shift) }

#-----------------------------