#!/usr/bin/perl #============================================================================= # ParkeCalc C : server-side calculator # If someone is authenticated, it adds a greeting. # Will welcome them back, if they return. #----------------------------------------------------------------------------- use bignum; use CGI qw(:all); #============================================================================= # Configuration. my $inputSize = 20; #============================================================================= # Get POSTed parameters. # Read stadard input (POST) to pick up the parameters (key-value pairs). # Should be on a single line, but loop over lines, just in case. my %param; while (<>) { # Tokenize, splitting on "&". my @kv = split("&", $_); # key = value # Put into a hash (a "map" in Java-speak), for easy access. foreach my $pair (@kv) { $pair =~ /(.*)=(.*)/; $param{$1} = $2; } } %ops = ( "none" => "", "add" => "", "mult" => "", "power" => "" ); # Validate & fix. if (!defined($param{"one"}) || !&isNumber($param{"one"})) { $param{"one"} = ""; } if (!defined($param{"two"}) || !&isNumber($param{"two"})) { $param{"two"} = ""; } if (!defined($param{"op"}) || !defined($ops{$param{"op"}})) { $param{"op"} = "none"; } # Mode my $mode; if ($param{"one"} eq "" || $param{"two"} eq "" || $param{"op"} eq "none") { $mode = "inc"; } else { $mode = "run"; } #----------------------------------------------------------------------------- # See if we can identify who is calling. my $user = $ENV{'REMOTE_USER'}; #============================================================================= # HTTP Response #----------------------------------------------------------------------------- # Header #print "Set-Cookie: ", &mkCookie("when", time), "\n" if (defined($user)); print "Set-Cookie: ", &mkCookie("when", time), "\n"; print "Content-Type: text/html\n"; print "\n"; #============================================================================= # Payload #----------------------------------------------------------------------------- # HTML start print << "START";
Welcome, $user.
CONTENT } else { my $visit = &formatTime($when); print << "CONTENT";Welcome back, $user. You last visited $visit.
Welcome, whoever you are.
CONTENT } } print << "CONTENT"; CONTENT #----------------------------------------------------------------------------- # HTML finish print << "FINISH"; FINISH #============================================================================= # SUBROUTINES #----------------------------------------------------------------------------- # Compute the requested operation. sub compute { # Compute the answer. if ($param{"op"} eq "add") { return 1->bmul($param{"one"}) + 1->bmul($param{"two"}); } elsif ($param{"op"} eq "mult") { return 1->bmul($param{"one"}) * 1->bmul($param{"two"}); } elsif ($param{"op"} eq "power") { return 1->bmul($param{"one"})** 1->bmul($param{"two"}); } } #----------------------------------------------------------------------------- # Make a cookie. sub mkCookie { my ($name, $value) = @_; my $expires = time + 7 * 24 * 60 * 60; # In 7 days from now (in seconds). # Set the name and value as the method call parameters requested. my $cookie = "$name=$value"; # Format the expiration time in the format HTTP likes. $cookie .= "; expires=" . &formatTime($expires); # SCOPE: Localize the cookie to just this path. $cookie .= "; path=" . "/~godfrey/2041/secure"; # SCOPE: Cookie belongs to this domain. $cookie .= "; domain=" . ".cse.yorku.ca"; # Client should only send back if over HTTPS. $cookie .= "; secure"; return $cookie; } #----------------------------------------------------------------------------- # Format time like HTTP likes it. sub formatTime { my ($stardate) = @_; my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime($stardate); my @day = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"); my @month = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"); return $day[$wday] . ", ". $mday . " " . $month[$mon] . " " . ($year + 1900) . " " . "$hour:$min:$sec " . "GMT"; } #----------------------------------------------------------------------------- # Perl has no simple isNumber check. sub isNumber { my ($x) = @_; return 1 if ((2 * $x) / 2 eq $x); return 0; }