This is an example of a Perl script that I have written. It
has been modified slightly to preserve system security
# ************* Account Information Login comboform
# written by Richard Zitola (zee@ugcs.caltech.edu) February 3, 1996
#
require("cgi-lib.pl");
# The full pathname for this script is stored here
$LoginPLfile = "***********************************";
# The full pathname of the report directory is stored here.
# This is the output directory of makerep.prg
# Be sure that all backslashes are doubled
$ReportDATAdirectory = "***********************";
# Location of the ************* header icon
$SS1GIF = "*******";
# Full URL for *************'s main webpage
$******HomePage = "*******";
if ( &MethGet ) {
&ReadParse;
if (******************************) {
&Detail;
} else {
&ReturnForm;
}
} else {
# If POST request, then *********, return summary report
&ReadParse;
&GetInfo;
}
sub ReturnForm {
# Return form, as in login.htm
print &PrintHeader;
print "<html>\n";
print "<title>Real Login Screen</title>\n";
print "<body>\n";
print "<center>\n";
print "<img src=\"$SS1GIF\">\n";
print "<font color=\"ff0000\"><h1>Account Information<hr size=5></h1></font>\n";
print "<b>This new service allows you to view the status of your order(s) with\n";
print "*************.</b><br>\n";
print "If you are a new user and have not already chosen a PIN, please contact\n";
print "Sales Dept., person.<br>\n";
print "If you encounter a problem using this system, or detect a bug, please\n";
print "contact <a href=\"mailto:zee@uno.tc.net\">WebMaster</a>.<br>\n";
print "If you have a question about your order, please contact our<br>Sales Department (1-800-555-1212, or <a href=\"mailto:****************\">****************</a>).\n";
print "<br><br>\n";
print "<center><table border=3 align=center cellpadding=5><tr><td>\n";
print "<form method=\"POST\">\n";
print "<center>\n";
print "<table>\n";
print "<tr>\n";
print "<td align=right>\n";
print "<font size=+1><b>Account:</b></font>\n";
print "</td>\n";
print "<td>\n";
print "<input type=text name=\"account\"><br>\n";
print "</td>\n";
print "</tr>\n";
print "<tr>\n";
print "<td align=right>\n";
print "<font size=+1><b>PIN:</b></font>\n";
print "</td>\n";
print "<td>\n";
print "</td>\n";
print "</tr>\n";
print "</table>\n";
print "<br>\n";
print "<input type=reset> \n";
print "<input type=submit value=\"View Account Status\"><br>\n";
print "</form>\n";
print "</table>\n";
print "</center>\n";
print "</td></tr></table></center>\n";
print "<br><hr size=5>\n";
print "<a href=\"$******HomePage\">Return to ************* HomePage</a>\n";
print "</body>\n";
print "</html>\n";
}
sub GetInfo {
print &PrintHeader;
if ( &CheckPIN ) {
&ReturnSummary;
} else {
&AccessDenied;
}
}
sub CheckPIN {
*** edited ***
}
sub ReturnSummary {
print "<html>\n";
print "<head><title>Open Order Summary</title></head>\n";
print "<body bgcolor=\"ffffff\" text=\"000000\">\n";
print "<center>\n";
print "<img src=\"*********************************" align=center>\n";
print "<font color=\"ff0000\"><h2>Open Order Summary<hr size=6>\n";
print "</h2></font>\n";
open(REPFILE,"***********************".substr($in{account},0,7).".".substr($in{account},7,3)) || die "ERROR: Cannot open file: $in{account}.dat";
$RepBlanko = <REPFILE>
print "<center><h3>\n";
$RepCust = <REPFILE>
print $RepCust,"\n";
print "</h3></center>\n";
print "<table cellpadding=0>\n";
print "<tr>\n";
print "<td valign=top><b>SS Order # </b></td>\n";
print "<td valign=top><b>Purchase Order</b></td>\n";
print "<td valign=top><b>Contact</b></td>\n";
print "<td valign=top><b>Order Date</b></td>\n";
print "<td valign=top><b>Status</b></td>\n";
print "</tr>\n";
$RepStatLine = <REPFILE>
while (substr($RepStatLine,0,15) ne "*-END ACCOUNT-*") {
$RepStatON = substr($RepStatLine,3,10);
$RepStatPO = substr($RepStatLine,17,20);
$RepStatCT = substr($RepStatLine,41,10);
$RepStatSR = substr($RepStatLine,55,4);
$RepStatODm = substr($RepStatLine,63,2);
$RepStatODd = substr($RepStatLine,65,2);
$RepStatODy = substr($RepStatLine,67,2);
$RepStatLUm = substr($RepStatLine,73,2);
$RepStatLUd = substr($RepStatLine,75,2);
$RepStatLUy = substr($RepStatLine,77,2);
$RepStatLUh = substr($RepStatLine,80,4);
$MonthIN=$RepStatODm;
&Month;
$RepStatODm=$MonthOUT;
$YearIN=$RepStatODy;
&Year;
$RepStatODy=$YearOUT;
$MonthIN=$RepStatLUm;
&Month;
$RepStatLUm=$MonthOUT;
$YearIN=$RepStatLUy;
&Year;
$RepStatLUy=$YearOUT;
$RepStatLUh=" (".$RepStatLUh.")";
while (length($RepStatON) > 8) {
chop ($RepStatON);
}
print "<tr>\n";
print "<td><a href=\"******************************************************************>",$RepStatON,"</a> </td>\n";
print "<td>",$RepStatPO," </td>\n";
print "<td>",$RepStatCT," </td>\n";
print "<td>",$RepStatODm,$RepStatODd,$RepStatODy," </td>\n";
print "<td>",$RepStatSR," </td>\n";
$RepLineItem = <REPFILE>
while (substr($RepLineItem,0,13) ne "*-END ORDER-*") {
$RepLineItem = <REPFILE>
}
$RepStatLine = <REPFILE>
}
print "</table>\n";
print "<center><br><br><br>\n";
print "<table border=1><tr><td align=center>\n";
print "<font size=+1><b><i>Legend</b></i></font>\n";
print "</td></tr><tr><td>\n";
print "<table><tr><td><b>\n";
print "Shipped:<br>\n";
print "Ready:<br>\n";
print "In Process:<br>\n";
print "In Stock:<br>\n";
print "In Transit:<br>\n";
print "On Order: <br>\n";
print "</b></td>\n";
print "<td>\n";
print "Item has been shipped to customer<br>\n";
print "Item ready, awaiting shipment (within 24hrs)<br>\n";
print "Item being configured to customer specifications<br>\n";
print "Item being held for order completion<br>\n";
print "Item en route to ****** ******, will arrive within 48hrs<br>\n";
print "Item not yet arrived at ****** ******, waiting for availability<br>\n";
print "</td>\n";
print "</tr></table></table>\n";
print "</center>\n";
close (REPFILE);
print "<br><br></center><hr size=6>\n";
print "<address><a href=\"mailto:****************\">************* Sales Dept.</a></address>\n";
print "</body>\n";
print "</html>\n";
}
sub Detail {
print &PrintHeader;
print "<html>\n";
print "<head><title>Open Order Detail Report</title></head>\n";
print "<body bgcolor=\"ffffff\" text=\"000000\">\n";
$OrderNum = substr($in{order},0,8);
$AccountNum = substr($in{order},8,10);
print "<center>\n";
print "<img src=\"$SS1GIF\" align=center>\n";
print "<h2><font color=\"ff0000\">Open Order Detail Report</font></h2>\n";
$ODStat="";
open(REPFILE,"***************************************************************************** || die "ERROR: Cannot open file: $in{account}.dat";
$DetBlanko = <REPFILE>
print "<center><h3>\n";
$RepCust = <REPFILE>
print $RepCust,"\n";
print "</h3></center>\n";
$RepStatLine = <REPFILE>
while (substr($RepStatLine,0,15) ne "*-END ACCOUNT-*") {
$RepStatON = substr($RepStatLine,3,8);
$RepStatPO = substr($RepStatLine,17,20);
$RepStatCT = substr($RepStatLine,41,10);
$RepStatSR = substr($RepStatLine,55,4);
$RepStatODm = substr($RepStatLine,63,2);
$RepStatODd = substr($RepStatLine,65,2);
$RepStatODy = substr($RepStatLine,67,2);
$RepStatLUm = substr($RepStatLine,73,2);
$RepStatLUd = substr($RepStatLine,75,2);
$RepStatLUy = substr($RepStatLine,77,2);
$RepStatLUh = substr($RepStatLine,80,4);
$MonthIN=$RepStatODm;
&Month;
$RepStatODm=$MonthOUT;
$YearIN=$RepStatODy;
&Year;
$RepStatODy=$YearOUT;
$MonthIN=$RepStatLUm;
&Month;
$RepStatLUm=$MonthOUT;
$YearIN=$RepStatLUy;
&Year;
$RepStatLUy=$YearOUT;
$RepStatLUh=" (".$RepStatLUh.")";
if ($RepStatON eq $OrderNum) {
print "<table valign=top><tr>\n";
print "<td valign=top><b>\n";
print "Purchase Order #: <br>\n";
print "Contact:<br>\n";
print "Order Date:<br>\n";
print "</b></td>\n";
print "<td valign=top>\n";
print $RepStatPO,"<br>\n";
print $RepStatCT,"<br>\n";
print $RepStatODm,$RepStatODd,$RepStatODy,"<br>\n";
print "</td>\n";
print "<td valign=top><b>\n";
print " Order Number: <br>\n";
print " Sales Rep:<br>\n";
print " Last Update:<br>\n";
print "</b></td>\n";
print "<td valign=top>\n";
print $RepStatON,"<br>\n";
print $RepStatSR,"<br>\n";
print $RepStatLUm,$RepStatLUd,$RepStatLUy,$RepStatLUh,"\n";
print "</td>\n";
print "</tr></table>\n";
print "<table border=10 align=center valign=top cellspacing=0 cellpadding=12>\n";
print "<tr>\n";
print "<td valign=center align=left>Stock Number</td>\n";
print "<td valign=center align=left>Description</td>\n";
print "<td valign=center align=left>Initial<br>Order</td>\n";
# print "<td valign=center align=left>Date</td>\n";
print "<td valign=center align=left>Status</td>\n";
print "</tr>\n";
$RepLineItem = <REPFILE>
while (substr($RepLineItem,0,13) ne "*-END ORDER-*") {
$RepLIStatFlag = "";
$RepLIStockNum = substr($RepLineItem,0,15);
$RepLIDescript = substr($RepLineItem,16,35);
$RepLIInitOrdr = substr($RepLineItem,58,4);
$RepLIBackOrdr = substr($RepLineItem,69,4);
$RepLIAllocatd = substr($RepLineItem,74,4);
$RepLIInConfig = substr($RepLineItem,85,4);
$RepLIOutConfg = substr($RepLineItem,96,4);
$RepLIShippedZ = substr($RepLineItem,101,4);
$RepLIStatFlag = substr($RepLineItem,106,1);
$RepLIShipDate = substr($RepLineItem,108,8);
$RepLIExptDate = substr($RepLineItem,117,8);
if ($RepLIStatFlag eq "N") {
$ODStat = "NLA";
}
print "<tr>\n";
print "<td valign=top align=left>\n";
print $RepLIStockNum,"\n";
print "</td>\n";
print "<td valign=top align=left>\n";
print $RepLIDescript,"\n";
print "</td>\n";
print "<td valign=top align=left>\n";
print $RepLIInitOrdr,"\n";
print "</td>\n";
# print "<td valign=top align=left>\n";
# print " \n</td>\n";
print "<td valign=top align=left>\n";
$First = "Y";
if ($RepLIBackOrdr ne " 0") {
print $RepLIBackOrdr," On Order";
if ($RepLIExptDate ne " / / ") {
if ($RepLIExptDate eq "09/09/99") {
print " (<font color=\"ff0000\">* See Note</font>)\n";
$ODStat = "CON";
} elsif ($RepLIExptDate eq "08/08/88") {
print " (In Transit)\n";
} elsif ($RepLIExptDate eq "07/07/77") {
print " (<font color=\"ff0000\">* See Note</font>)\n";
$ODStat = "PRB";
} else {
print " (expected ",$RepLIExptDate,")\n";
}
}
$First = "N";
}
if ($RepLIAllocatd ne " 0") {
if ($First ne "Y") {
print "<br>";
}
print $RepLIAllocatd," In Stock\n";
$First = "N";
}
if ($RepLIInConfig ne " 0") {
if ($First ne "Y") {
print "<br>";
}
print $RepLIInConfig," In Process\n";
$First = "N";
}
if ($RepLIOutConfg ne " 0") {
if ($First ne "Y") {
print "<br>";
}
print $RepLIOutConfg," Ready\n";
$First = "N";
}
if ($RepLIShippedZ ne " 0") {
if ($First ne "Y") {
print "<br>";
}
print $RepLIShippedZ," Shipped";
if ($RepLIShipDate ne " / / ") {
print " on ",$RepLIShipDate;
}
}
if ($RepLIStatFlag eq "N") {
if ($First ne "Y") {
print "<br>";
}
print "<font color=\"ff0000\">* See Note</font>\n";
}
print " \n</td>\n";
print "</tr>\n";
$RepLineItem = <REPFILE>
}
print "</table></center>\n";
print "<br><br><br>\n";
}
$RepStatLine = <REPFILE>
}
if ($ODStat eq "CON") {
print "<center><font color=\"ff0000\"><h1>Constrained Item</h1>\n";
print "<h3>A constrained item appears on your report.<br>\n";
print "Please contact your sales representative.</h3></font></center>\n";
print "<br><br><br>\n";
}
if ($ODStat eq "PRB") {
print "<center><font color=\"ff0000\"><h1>Vendor Problem</h1>\n";
print "<h3>There is a problem concerning the vendor of this item.<br>\n";
print "Please contact your sales representative.</h3></font></center>\n";
print "<br><br><br>\n";
}
if ($ODStat eq "NLA") {
print "<center><font color=\"ff0000\"><h1>Item Not Available</h1>\n";
print "<h3>One of the items on your order is no longer available.<br>\n";
print "If you have not already received full shipment,<br>\n";
print "please contact your sales representative.</h3></font></center>\n";
print "<br><br><br>\n";
}
$ODStat = " ";
print "<center>\n";
print "<table border=1><tr><td align=center>\n";
print "<font size=+1><b><i>Legend</b></i></font>\n";
print "</td></tr><tr><td>\n";
print "<table><tr><td><b>\n";
print "Shipped:<br>\n";
print "Ready:<br>\n";
print "In Process:<br>\n";
print "In Stock:<br>\n";
print "In Transit:<br>\n";
print "On Order: <br>\n";
print "</b></td>\n";
print "<td>\n";
print "Item has been shipped to customer<br>\n";
print "Item ready, awaiting shipment (within 24hrs)<br>\n";
print "Item being configured to customer specifications<br>\n";
print "Item being held for order completion<br>\n";
print "Item en route to ****** ******, will arrive within 48hrs<br>\n";
print "Item not yet arrived at ****** ******, waiting for availability<br>\n";
print "</td>\n";
print "</tr></table></table>\n";
print "</center>\n";
close (REPFILE);
print "<br><br></center><hr size=6>\n";
print "<address><a href=\"mailto:****************\">************* Sales Dept.</a></address>\n";
print "</body>\n";
print "</html>\n";
}
sub AccessDenied {
print "<html>\n";
print "<title>Access Denied</title>\n";
print "<body>\n";
print "<h3><font color=\"ff0000\">Access Denied</font></h3>\n";
print "No information is available for your entry.<br><br>";
print "Either you have no active orders currently on our system,<br> or\n";
print "you have entered an invalid Account/PIN.<br>";
print "Please select \"Back\" on your browser to enter a new PIN, or<br>\n";
print "<ul><a href=\"$LoginPLfile\"><li>Reenter account info</a>\n";
print "<li>Contact Sales Department</ul>\n";
print "<br><hr size=5>\n";
print "<a href=\"top.htm\">Return to ************* HomePage</a>\n";
print "</body>\n";
print "</html>\n";
}
sub Month {
if ($MonthIN eq "01") {
$MonthOUT = "Jan ";
}
if ($MonthIN eq "02") {
$MonthOUT = "Feb ";
}
if ($MonthIN eq "03") {
$MonthOUT = "Mar ";
}
if ($MonthIN eq "04") {
$MonthOUT = "Apr ";
}
if ($MonthIN eq "05") {
$MonthOUT = "May ";
}
if ($MonthIN eq "06") {
$MonthOUT = "Jun ";
}
if ($MonthIN eq "07") {
$MonthOUT = "Jul ";
}
if ($MonthIN eq "08") {
$MonthOUT = "Aug ";
}
if ($MonthIN eq "09") {
$MonthOUT = "Sep ";
}
if ($MonthIN eq "10") {
$MonthOUT = "Oct ";
}
if ($MonthIN eq "11") {
$MonthOUT = "Nov ";
}
if ($MonthIN eq "12") {
$MonthOUT = "Dec ";
}
}
sub Year {
if (substr($YearIN,0,1) eq "9") {
$YearOUT = ", 199".substr($YearIN,1,1);
} else {
$YearOUT = ", 20".substr($YearIN,0,2);
}
}