Example 19-9. chemiserie

  #!/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
  croak "This CGI works only over HTTPS"
    if $ENV{'SERVER_PORT'} && !$ENV{'HTTPS'};
  # Since we deal with sensitive data like credit card numbers
  # 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) }