Recipe 19.13 Program: chemiserie

The CGI script in Example 19-9 lets people order t-shirts and sweaters over the Web, using techniques described in Recipe 19.11. Its output isn't elegant or beautiful, but illustrating the multiscreen technique in a short program was challenging enough without trying to make it pretty as well.

The shirt and sweater subroutines check their widget values. If the user somehow submits an invalid color or size, the value is reset to the first in the list of allowable colors or sizes.

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) }