[9252] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 2847 Volume: 8

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Jun 11 18:07:53 1998

Date: Thu, 11 Jun 98 15:01:38 -0700
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Thu, 11 Jun 1998     Volume: 8 Number: 2847

Today's topics:
        Please Help !!! <howardcs@thnet.com>
    Re: Problem with embedding on AIX (Sean McAfee)
    Re: Stages in a pipeline <bowlin@sirius.com>
    Re: taking data out of ':' delimited string and placing <aqumsieh@matrox.com>
    Re: Win32: File glob causes floppy to chatter <michael.n.burr@boeing.com>
        Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Thu, 11 Jun 1998 04:02:41 -0500
From: Curtis Howard <howardcs@thnet.com>
Subject: Please Help !!!
Message-Id: <357F9D31.652AA817@thnet.com>

This is a multi-part message in MIME format.
--------------1C4CDD01636DCD2E315AB65E
Content-Type: text/plain; charset=iso-2022-jp
Content-Transfer-Encoding: 7bit

I'm trying to write a script that allows for a generic version of an
online ordering system. Everything works fine except for my Check_Form
Routine.  I would like to require certain fields so that orders are
not sent without contact information.  Can someone please take a look at
my script and let me know what I am doing wrong, or just point me in the
right direction ?  Any help would be greatly appreciated and I would be
happy to mention your name in the script documentation. Thank You.

--------------1C4CDD01636DCD2E315AB65E
Content-Type: text/plain; charset=iso-2022-jp; name="order.cgi"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="order.cgi"

#!/usr/bin/perl

#############################################################################
# Program Name: Order.cgi						    #
# Written By: Curtis Howard						    #
# Date Completed: 10.6.98						    #
# Purpose:  Use An HTML Form To Send Ordering Information To Bernard C	    #
#			Chocolate E-Mail. First Step In Real Time On-Line   #
#			Ordering System.				    #
# Summary:	Ordering Information Will Be Read By the program in a	    #
#			continous line that will have to be parsed.  After  #
#			being seperated in to name-value pairs that 	    #
#			information will be used to calculate cost. That    #
#			information will be sent via email to Bernard C     #
#			Chocolate.  A message will then be returned to the  #
#			user confirming the order, and that the information #
#			has been sent.					    #														#
#############################################################################

##### Location Of Sendmail Program On Server #####
$Mail_Location = '/usr/sbin/sendmail';

&Load_Prefs;
&Parse_Form;
&Check_Form;
if ($error == 0) {
	&Get_Order_Num;
	&Send_Mail;
	&Create_HTML;
}
else {
	&Error_Page;
}

#############################################################################
# Sub Routine Name: Check Form						    # 
# Written By: Curtis Howard                                                 #
# Date: 10.6.98								    #
# Purpose:	Checks To Make Sure That Required			    #
#		Fields Have Been Filled Out				    #
#############################################################################
		
sub Check_Form {	
	foreach $item (@REQUIRE) {
		if (!defined @FORM{'$item'}) {
			$error = 1;
		}
	}
}
	
	
#############################################################################
# Sub Routine Name: Parse Form						    # 
# Written By: Curtis Howard                                                 #
# Date: 5/6/98								    #
# Purpose:	Configures CGI Script; Cost Of Items mail recipient etc.    #
#############################################################################

sub Load_Prefs {
	$REQUIRE = {'firstname', 'lastname', 'phonenumber', 'email'};
	$Config{'recipient'} = 'info@bernardcchocolate.com';
	$Cost{'CCB13'} = 12.00;  $Cost{'GWB13'} = 14.00;
	$Cost{'CCB12'} = 18.00;  $Cost{'GWB12'} = 20.00;
	$Cost{'CCB1'} = 36.00;   $Cost{'GWB1'} = 38.00;
	$Cost{'CCB112'} = 54.00; $Cost{'GWB112'} = 56.00;
	$Cost{'CCB2'} = 72.00;   $Cost{'GWB2'} = 74.00;
	$Cost{'TB'} = 22.00;
	$Cost{'LPB'} = 95.00;
	$Cost{'SPB'} = 55.00;
	$Cost{'ChampBottle'} = 70.00;
	$Cost{'CouvBars'} = 12.00;
	$Cost{'ChocDrops'} = 7.00;
	$Cost{'ChocBars'} = 3.00;
	$Cost{'ChocTea'} = 6.00;
	$Cost{'Sauces'} = 8.00;
	$Cost{'ChocMini2'} = 3.25;
	$Cost{'ChocMini4'} = 5.50;
	$error = 0;
}

#############################################################################
# Sub Routine Name: Get Order Number					    # 
# Written By: Curtis Howard                                                 #
# Date: 5/6/98								    #
# Purpose:	Retrieves the order number from a data file (ordernum.txt)  #
#############################################################################

sub Get_Order_Num {
	open(COUNTER, "< ordernum.txt") || die "Busy";
	$OrderNum = <COUNTER>;
	close(COUNTER);

	#increment count and write to file
	$OrderNum++;
	open(COUNTER, "> ordernum.txt") || "Busy";
	print COUNTER $OrderNum;
	close (COUNTER);
}

#############################################################################
# Sub Routine Name: Parse Form                                              # 
# Written By: Curtis Howard                                                 #
# Date: 5/6/98                                                              #
# Purpose:	Put Data Entered Into Form Into An Associative Array	    #
#			And Calculates The Cost of the items		    #
#############################################################################

sub Parse_Form {
	read(STDIN, $input, $ENV{'CONTENT_LENGTH'});
	@pairs = split(/&/, $input);

	foreach $pair (@pairs) 
	{
    	($name, $value) = split(/=/, $pair);
    	$name =~ tr/+/ /;
    	$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    	$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    	$FORM{$name} = $value;
    	$ItemTotal{$name} = ($FORM{$name} * $Cost{$name});
    	$Total = $Total + ($FORM{$name} * $Cost{$name});
	}
}

#############################################################################
# Sub Routine Name: Create HTML                                             #
# Written By: Curtis Howard						    #
# Date: 5/6/98								    #
# Purpose: Returns An HTML Page If The Order Is Processed Successfully	    #
#############################################################################

sub Create_HTML {
	print "Content-type: text/html\n\n";
	print "<HTML>\n<HEAD>\n";
	print "<TITLE>Order Number: $OrderNum</TITLE>\n";
	print "</HEAD>\n";
	print "<BODY BGCOLOR=\"#ffffff\">\n";
	print "<TABLE WIDTH=\"500\" CELLSPACING=\"0\" CELLPADDING=\"0\" BORDER=\"0\">\n";
	print "<TR>\n<TD WIDTH=\"500\"COLSPAN=\"2\" VALIGN=\"BOTTOM\"><IMG SRC=\"../images/abars/btopp.jpg\" WIDTH=\"500\" HEIGHT=\"41\" BORDER=\"0\" NATURALSIZEFLAG=\"0\"></TD></TR>\n";
	print "<TR>\n<TD WIDTH=\"217\" VALIGN=\"BOTTOM\"><IMG SRC=\"../images/abars/aord.jpg\" WIDTH=\"217\" HEIGHT=\"41\" BORDER=\"0\" NATURALSIZEFLAG=\"0\" ALIGN=\"TOP\"></TD>\n";
	print "<TD WIDTH=\"283\" VALIGN=\"BOTTOM\"> <MAP NAME=\"main1\"><AREA SHAPE=\"rect\" COORDS=\"170,20 200,44\" HREF=\"history.htm\"></MAP>\n";
	print "<IMG SRC=\"../images/abars/bcent.jpg\" WIDTH=\"283\" HEIGHT=\"41\" BORDER=\"0\" NATURALSIZEFLAG=\"0\" ALIGN=\"BOTTOM\"ISMAP USEMAP=\"#main1\"></TD></TR>\n";
	print "<TR><TD WIDTH=\"500\" COLSPAN=\"2\"><MAP NAME=\"main2\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"45,15 23,36 43,52 60,42 100,43 94,30 76,23 59,26\" HREF=\"../index.htm\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"111,4 95,20 112,36 121,28 125,30 175,30 178,17 151,16 127,16\" HREF=\"../catal.htm\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"207,21 226,34 219,44 218,49 257,48 262,63 194,62 164,63 155,58 159,49 169,45 192,47 194,30\" HREF=\"speci.htm\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"297,39 282,22 260,38 276,57 390,58 390,49 385,43\" HREF=\"../order.htm\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"338,5 319,18 337,34 350,28 354,30 412,30 410,19 355,17\" HREF=\"../locat.htm\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"463,1 453,19 434,18 435,13 392,13 383,0\"  HREF=\../history.htm\">\n";
	print "</MAP><IMG SRC=\"../images/abars/bbott.jpg\" WIDTH=\"500\" HEIGHT=\"88\" BORDER=\"0\" NATURALSIZEFLAG=\"0\" ALIGN=\"TOP\" ISMAP USEMAP=\"#main2\"></TD></TR>\n";
	print "</TABLE>\n";
	print "<TABLE BORDER = 0>\n<TR>\n<TD COLSPAN = 4>\n";
	print "<FONT FACE = Helvetica SIZE = +2>Order Confirmation</FONT><P>\n";
	print "<FONT FACE = Helvetica SIZE = -1>Thank you for your order.<BR>\n";
	print "You will be contacted promptly<BR>by a Bernard C. representative.<BR>\n";
	print "</TD>\n</TR>\n<TR>\n\n";
	print "<TD><BR>\nOrder Number: $OrderNum<BR>\n</TD>";
	print "</TR><TR><TD>";
	print "Name: $FORM{firstname} $FORM{lastname}<BR>\n";
	print "Email: $FORM{email}<BR>\n";
	print "Phone: $FORM{phonenumber}<BR>\n</TD>\n";
	print "</TD><TD WIDTH = 25></TD>\n<TD>";
	print "$FORM{address}<BR>\n";
	print "$FORM{city}, $FORM{state}<BR>";
	print "$FORM{postalcode}<BR>\n";
	print "</TD>\n</TR></TABLE>\n";
	print "<TABLE>\n<TR>\n";
	print "<TD WIDTH = 250 ALIGN = CENTER><B>Item</B><HR></TD>\n";
	print "<TD WIDTH = 125 ALIGN = CENTER><B>Quantity</B><HR></TD>\n";
	print "<TD WIDTH = 125 ALIGN = CENTER><B>Cost</B><HR></TD>\n</TR>\n";
	if ($FORM{CCB13} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Copper Chest Box (1/3 lb.)</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{CCB13}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{CCB13}<TD>\n</TR>\n"; }
	if ($FORM{CCB12} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Copper Chest Box (1/2 lb.)</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{CCB12}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{CCB12}<TD>\n</TR>\n"; }
	if ($FORM{CCB1} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Copper Chest Box (1 lb.)</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{CCB1}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{CCB1}<TD>\n</TR>\n"; }
	if ($FORM{CCB112} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Copper Chest Box (1 1/2 lb.)</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{CCB112}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{CCB112}<TD>\n</TR>\n"; }
	if ($FORM{CCB2} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Copper Chest Box (2 lb.)</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{CCB2}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{CCB2}<TD>\n</TR>\n"; }
	if ($FORM{GWB13} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Gift Wrapped Box (1/3 lb.)</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{GWB13}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{GWB13}<TD>\n</TR>\n"; }
	if ($FORM{GWB12} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Gift Wrapped Box (1/2 lb.)</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{GWB12}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{GWB12}<TD>\n</TR>\n"; }
	if ($FORM{GWB1} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Gift Wrapped Box (1 lb.)</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{GWB1}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{GWB1}<TD>\n</TR>\n"; }
	if ($FORM{GWB112} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Gift Wrapped Box (1 1/2 lb.)</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{GWB112}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{GWB112}<TD>\n</TR>\n"; }
	if ($FORM{GWB2} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Gift Wrapped Box (2 lb.)</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{GWB2}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{GWB2}<TD>\n</TR>\n"; }
	if ($FORM{TB} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Truffle Box</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{TB}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{TB}<TD>\n</TR>\n"; }
	if ($FORM{LPB} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Large Presentation Box</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{LPB}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{LPB}<TD>\n</TR>\n"; }
	if ($FORM{SPB} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Small Presentation Box</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{SPB}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{SPB}<TD>\n</TR>\n"; }
	if ($FORM{ChampBottle} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Champagne Bottle</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{ChampBottle}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{ChampBottle}<TD>\n</TR>\n"; }
	if ($FORM{CouvBars} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Couverture Bars</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{CouvBars}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{CouvBars}<TD>\n</TR>\n"; }
	if ($FORM{ChocDrops} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Chocolate Drops</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{ChocDrops}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{ChocDrops}<TD>\n</TR>\n"; }
	if ($FORM{ChocBars} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Chocolate Bars</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{ChocBars}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{ChocBars}<TD>\n</TR>\n"; }
	if ($FORM{ChocTea} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Chocolate Tea</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{ChocTea}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{ChocTea}<TD>\n</TR>\n"; }
	if ($FORM{Sauces} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>Sauces</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{Sauces}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{Sauces}<TD>\n</TR>\n"; }
	if ($FORM{ChocMini2} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>2 Chocolate Mini Box</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{ChocMini2}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{ChocMini2}<TD>\n</TR>\n"; }
	if ($FORM{ChocMini4} != 0) {
		print "<TR>\n<TD ALIGN = CENTER VALIGN = BOTTOM>4 Chocolate Mini Box</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>$FORM{ChocMini4}</TD>\n";
		print "<TD ALIGN = CENTER VALIGN = BOTTOM>\$ $ItemTotal{ChocMini4}<TD>\n</TR>\n"; }
	print "<TR><TD COLSPAN = 2></TD><TD ALIGN = CENTER><HR><B>Total: \$ $Total</B></TD>";
	print "</TABLE>\n";
	foreach $item (@REQUIRE) {
		print "$item<BR>\n";
	}
	print "<\BODY>\n</HTML>";
}

#############################################################################
# Sub Routine Name: Send Mail                                               #
# Written By: Curtis Howard						    #
# Date: 5/6/98								    #
# Purpose: Sends Formated Form Data To Appropriate Person Via E-mail	    #
#############################################################################

sub Send_Mail {
	open(MAIL, "|$Mail_Location -t");
	print MAIL "To: $Config{recipient} \n";
	print MAIL "From: $FORM{email}\n";
	print MAIL "Subject: Order Number $OrderNum\n\n";
	print MAIL "Order: $OrderNum\n";
	print MAIL "Name:  $FORM{firstname} $FORM{lastname}\n";
	print MAIL "Email: $FORM{email}\n";
	print MAIL "Phone: $FORM{phonenumber}\n";
	print MAIL "Address:\n";
	print MAIL "$FORM{address}\n";
	print MAIL "$FORM{city}, $FORM{state}\n";
	print MAIL "$FORM{postalcode}\n";
	print MAIL "Call:  $FORM{time}\n\n0";
	print MAIL "           ITEM                   Quantity          Cost\n";
	print MAIL "---------------------------      ----------      ----------\n";
	if ($FORM{CCB13} != 0)    { print MAIL "Copper Chest Box (1/3 lb.):          $FORM{CCB13}              \$ $Cost{CCB13}\n\n"; }
	if ($FORM{CCB12} != 0)    { print MAIL "Copper Chest Box (1/2 lb.):          $FORM{CCB12}              \$ $Cost{CCB12}\n\n"; }
	if ($FORM{CCB1} != 0)     { print MAIL "Copper Chest Box (1 lb.):            $FORM{CCB1}              \$ $Cost{CCB1}\n\n"; }
	if ($FORM{CCB112} != 0)   { print MAIL "Copper Chest Box (1 1/2 lb.):        $FORM{CCB112}              \$ $Cost{CCB112}\n\n"; }
	if ($FORM{CCB2} != 0)     { print MAIL "Copper Chest Box (2 lbs.):           $FORM{CCB2}              \$ $Cost{CCB2}\n\n"; }
	if ($FORM{GWB13} != 0)    { print MAIL "Copper Chest Box\nGift Wrapped (1/3 lb.):              $FORM{GWB13}              \$ $Cost{GWB13}\n\n"; }
	if ($FORM{GWB12} != 0)    { print MAIL "Copper Chest Box\nGift Wrapped (1/2 lb.):              $FORM{GWB12}              \$ $Cost{GWB12}\n\n"; }
	if ($FORM{GWB1} != 0)     { print MAIL "Copper Chest Box\nGift Wrapped (1 lb.):                $FORM{GWB1}              \$ $Cost{GWB1}\n\n"; }
	if ($FORM{GWB112} != 0)   { print MAIL "Copper Chest Box\nGift Wrapped (1 1/2 lb.):            $FORM{GWB112}              \$ $Cost{GWB112}\n\n"; }
	if ($FORM{GWB2} != 0)     { print MAIL "Copper Chest Box\nGift Wrapped (2 lbs.):               $FORM{GWB2}              \$ $Cost{GWB2}\n\n"; }
	if ($FORM{TB} != 0)     { print MAIL "Truffle Gift Box:                    $FORM{TB}              \$ $Cost{TB}\n\n"; }
	if ($FORM{LPB} != 0)     { print MAIL "Large Presentation Box:              $FORM{LPB}              \$ $Cost{LPB}\n\n"; }
	if ($FORM{SPB} != 0)     { print MAIL "Small Presentation Box:              $FORM{SPB}              \$ $Cost{SPB}\n\n"; }
	if ($FORM{ChampBottle} != 0)     { print MAIL "Champagne Bottle:                    $FORM{ChampBottle}              \$ $Cost{ChampBottle}\n\n"; }
	if ($FORM{CouvBars} != 0)     { print MAIL "Couverture Bars:                     $FORM{CouvBars}              \$ $Cost{CouvBars}\n\n"; }
	if ($FORM{ChocDrops} != 0)     { print MAIL "Chocolate Drops:                     $FORM{ChocDrops}              \$ $Cost{ChocDrops}\n\n"; }
	if ($FORM{ChocBars} != 0)     { print MAIL "Chocolate Bars:                      $FORM{ChocBars}              \$ $Cost{ChocBars}\n\n"; }
	if ($FORM{ChocTea} != 0)     { print MAIL "Chocolate Tea:                       $FORM{ChocTea}              \$ $Cost{ChocTea}\n\n"; }
	if ($FORM{Sauces} != 0)     { print MAIL "Sauces:                              $FORM{Sauces}              \$ $Cost{Sauces}\n\n"; }
	if ($FORM{ChocMini2} != 0)     { print MAIL "2 Chocolate Mini Box:                $FORM{ChocMini2}              \$ $Cost{ChocMini2}\n\n"; }
	if ($FORM{ChocMini4} != 0)     { print MAIL "4 Chocolate Mini Box:                $FORM{ChocMini4}              \$ $Cost{ChocMini4}\n\n"; }
	print MAIL "Total Cost: \$ $Total\n\n";
	close(MAIL);
}

#############################################################################
# Sub Routine Name: Error Page						    #
# Written By: Curtis Howard						    #
# Date: 5/6/98								    #
# Purpose: Returns An HTML Page If The Form Was Not Complete		    #
#############################################################################

sub Error_Page {
	print "Content-type: text/html\n\n";
	print "<HTML>\n<HEAD>\n";
	print "<TITLE>Order Number: $OrderNum</TITLE>\n";
	print "</HEAD>\n";
	print "<BODY BGCOLOR=\"#ffffff\">\n";
	print "<TABLE WIDTH=\"500\" CELLSPACING=\"0\" CELLPADDING=\"0\" BORDER=\"0\">\n";
	print "<TR>\n<TD WIDTH=\"500\"COLSPAN=\"2\" VALIGN=\"BOTTOM\"><IMG SRC=\"../images/abars/btopp.jpg\" WIDTH=\"500\" HEIGHT=\"41\" BORDER=\"0\" NATURALSIZEFLAG=\"0\"></TD></TR>\n";
	print "<TR>\n<TD WIDTH=\"217\" VALIGN=\"BOTTOM\"><IMG SRC=\"../images/abars/aord.jpg\" WIDTH=\"217\" HEIGHT=\"41\" BORDER=\"0\" NATURALSIZEFLAG=\"0\" ALIGN=\"TOP\"></TD>\n";
	print "<TD WIDTH=\"283\" VALIGN=\"BOTTOM\"> <MAP NAME=\"main1\"><AREA SHAPE=\"rect\" COORDS=\"170,20 200,44\" HREF=\"history.htm\"></MAP>\n";
	print "<IMG SRC=\"../images/abars/bcent.jpg\" WIDTH=\"283\" HEIGHT=\"41\" BORDER=\"0\" NATURALSIZEFLAG=\"0\" ALIGN=\"BOTTOM\"ISMAP USEMAP=\"#main1\"></TD></TR>\n";
	print "<TR><TD WIDTH=\"500\" COLSPAN=\"2\"><MAP NAME=\"main2\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"45,15 23,36 43,52 60,42 100,43 94,30 76,23 59,26\" HREF=\"../index.htm\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"111,4 95,20 112,36 121,28 125,30 175,30 178,17 151,16 127,16\" HREF=\"../catal.htm\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"207,21 226,34 219,44 218,49 257,48 262,63 194,62 164,63 155,58 159,49 169,45 192,47 194,30\" HREF=\"speci.htm\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"297,39 282,22 260,38 276,57 390,58 390,49 385,43\" HREF=\"../order.htm\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"338,5 319,18 337,34 350,28 354,30 412,30 410,19 355,17\" HREF=\"../locat.htm\">\n";
	print "<AREA SHAPE=\"polygon\" COORDS=\"463,1 453,19 434,18 435,13 392,13 383,0\"  HREF=\../history.htm\">\n";
	print "</MAP><IMG SRC=\"../images/abars/bbott.jpg\" WIDTH=\"500\" HEIGHT=\"88\" BORDER=\"0\" NATURALSIZEFLAG=\"0\" ALIGN=\"TOP\" ISMAP USEMAP=\"#main2\"></TD></TR>\n";
	print "</TABLE>\n";
	print "<TABLE>\n<TR>\n<TD>\n";
	print "There Was An Error Processing The Form\n";
	print "</TD>\n</TR>\n</TABLE>\n";
	print "<\BODY>\n</HTML>";
}
--------------1C4CDD01636DCD2E315AB65E--



------------------------------

Date: Thu, 11 Jun 1998 21:47:40 GMT
From: mcafee@stargate.rs.itd.umich.edu (Sean McAfee)
Subject: Re: Problem with embedding on AIX
Message-Id: <0gYf1.552$Y3.2965457@news.itd.umich.edu>

In article <myBf1.394$Y3.2042222@news.itd.umich.edu>, I wrote:
>I'm trying to add database functionality to a script which is called from a
>C program.  However, I can't even get this short example to work:

<snip textbook embedding case>

Found the problem.  On my AIX system, ExtUtils::Embed::ldopts prints a
flag "-bE:perl.exp".  When compiling my embedding program previously
(before attempting to link in any external code), this option caused
linking to fail.  Not knowing what it was for, I removed it, and was able
to link successfully and run my program.

However, it seems that this flag's presence is critically important for
embedded scripts that use external code.  "perl.exp" is the name of a file
that was present when Perl was originally compiled on my system.  This file
now resides deep in /usr/local/lib/perl5.  I changed the flag returned by
ldopts from "-bE:perl.exp" to refer to the file's absolute pathname, and
my program finally ran perfectly (despite a slew of warning messages
during the linking phase).

-- 
Sean McAfee | GS d->-- s+++: a26 C++ US+++$ P+++ L++ E- W+ N++ |
            | K w--- O? M V-- PS+ PE Y+ PGP?>++ t+() 5++ X+ R+ | mcafee@
            | tv+ b++ DI++ D+ G e++>++++ h- r y+>++**          | umich.edu


------------------------------

Date: Thu, 11 Jun 1998 14:23:16 -0700
From: Jim Bowlin <bowlin@sirius.com>
To: Scott Bronson <sbronson@opentv.com>
Subject: Re: Stages in a pipeline
Message-Id: <35804AC4.1D54EDC3@sirius.com>

Scott Bronson wrote:
> 
> Jim Bowlin, Zhang Zhengyu:
> 
> >  print format_lists number_lines remove_header get paragraph @my_text;
> 
> Unfortunately, this method requires reading the entire file all at
> once.  Doable, but considering the sizes of the files, I'd prefer to
> avoid this.

Scott, I am glad that you found a solution that works for you.

The two methods I outlined do not require reading the entire file in
one fell swoop.  Since you had mentioned that you already had a bunch
of functions written and had mentioned a Get_Paragraph function, I had
assumed that you already had this problem licked and were just interested
in how to string the functions together.  My mistake.  Here is a slight
modification to what I sent you before.  This one reads a paragraph at
at a time from a file.

sub open_file {
    my $file = shift;
    open(FILE, $file) or die "could not open $file\n$!";
    return sub {
	local($/) = "\n\n";
	my @a = split(/\n/, scalar <FILE>);
	return @a ? [@a] : undef;
    }
}

sub number_lines {
    my $a = shift;
    my $i;
    foreach(@$a) {
	$i++;
	$_ = "$i: $_";
    }
    $a;
}

sub print_array {
    my $a = shift;
    print join("\n", @$a), "\n\n";
}

my $get_par = open_file('pipeline3.pl');

while( $a = &$get_par) {
    print_array number_lines $a;
}

When run on itself, it produces the following output:

1: sub open_file {
2:     my $file = shift;
3:     open(FILE, $file) or die "could not open $file\n$!";
4:     return sub {
5: 	local($/) = "\n\n";
6: 	my @a = split(/\n/, scalar <FILE>);
7: 	return @a ? [@a] : undef;
8:     }
9: }

1: sub number_lines {
2:     my $a = shift;
3:     my $i;
4:     foreach(@$a) {
5: 	$i++;
6: 	$_ = "$i: $_";
7:     }
8:     $a;
9: }

1: sub print_array {
2:     my $a = shift;
3:     print join("\n", @$a), "\n\n";
4: }

1: my $get_par = open_file('pipeline3.pl');

1: while( $a = &$get_par) {
2:     print_array number_lines $a;
3: }

There's more than one way to do it.

-- Jim Bowlin


------------------------------

Date: Thu, 11 Jun 1998 16:05:14 -0400
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: taking data out of ':' delimited string and placing it into 6 variables
Message-Id: <35803879.62CBC8D8@matrox.com>

> Azman Shariff <azman@bnex.com> writes:
> >
> >data :
> >        roger:1002:10004:Roger Deng:/home/roger:/bin/bash
> >
> >looks familiar huh? .. .yepp it is from my passwd file.... i need to
> >write code to takethe six fields and put them in diff variables like
> >these
> >
> >var:
> >    $uname
> >    $uid
> >    $gid
> >    $fullname
> >    $home
> >    $shell
> >
> >how do i proceed? i tried this :
> >
> >      ($fielduname, $fielduid, $fieldgid, $fieldfullname, $fieldhome,
> >$fieldshell) = split(/:/,$_,6);
> >
> >doesn't seem to work though..
> >

Well, this should work ... but if you want to access only the data in the
passwd file, you can use the following commands:

getlogin()
getpwnam()
getpwuid()
getpwent()

among others!

--
Ala Qumsieh             |  No .. not just another
ASIC Design Engineer    |  Perl Hacker!!!!!
Matrox Graphics Inc.    |
Montreal, Quebec        |  (Not yet!)





------------------------------

Date: Thu, 11 Jun 1998 20:53:36 GMT
From: Michael Burr <michael.n.burr@boeing.com>
To: Ron Savage <rpsavage@ozemail.com.au>
Subject: Re: Win32: File glob causes floppy to chatter
Message-Id: <358043D0.2B87@boeing.com>

Ron Savage wrote:
> 
> Anti-virus software (eg McAfee) causes this.

Thanks Jaime and Ron - this was indeed the problem.  Rather bazaar but
true.  

-- 
Michael N. Burr, Programmer/Analyst
ALS Spares, Desktop Applications
M/S 35-62  (206) 662-5978


------------------------------

Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 8 Mar 97)
Message-Id: <null>


Administrivia:

The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc.  For subscription or unsubscription requests, send
the single line:

	subscribe perl-users
or:
	unsubscribe perl-users

to almanac@ruby.oce.orst.edu.  

To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.

To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.

To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.

The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.

The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.

For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.


------------------------------
End of Perl-Users Digest V8 Issue 2847
**************************************

home help back first fref pref prev next nref lref last post