#!/usr/local/bin/perl ####################### # # printorders.pl #------------------------------------------------------------------# # A partial front end to Perlshop that will print a listing of # customer numbers, which can be clicked on to print the customer # file. # # Written by Kevin H. Weiss, Ph.D. # Last modified on 10/15/1998 # kevin@childbirth.org # http://www.childbirth.org #------------------------------------------------------------------# # You will need to create a password file, such as "htaccess" that # contains username:password pairs. # Webstorage customers, go to http://www.webstorage.com/utils/htpasswd.html # to create username:password pairs. #------------------------------------------------------------------# # Set the following variables: $htaccess_file="$ENV{'DOCUMENT_ROOT'}/cgi-bin/CEP/htpasswd"; #location of password file $customer = "$ENV{'DOCUMENT_ROOT'}/cgi-bin/Mystore/customers"; #the directory where the orders reside $program_location = "http://www.childbirth.org/cgi-bin/CEP/printorders.pl"; $secure_program = "https://secure.nameservers.com/~childbir/cgi-bin/CEP/printorders.pl"; #################### &ReadParse(*formdata); ### Subroutine ReadParse is part of cgi-lib.pl library, Copyright 1993 Steven E. Brenner (see full text below) $customer_file_name="$ENV{'DOCUMENT_ROOT'}/cgi-bin/Mystore/customers/$formdata{'CUSTOMER'}"; #$order_file_name="$ENV{'DOCUMENT_ROOT'}/cgi-bin/Mystore/orders/$formdata{'ORDER'}"; ##################################### # Print HTML MIME headers and a title print "Content-type: text/html\n\n"; print "PerlShop Administration Center\n"; print "\n"; #------------------------------------ # Check Password if (!($formdata{'PASSWORD'} || $formdata{'CRYPTPASS'})) { print "Please login.
"; print "
\n"; print "
Username: 
\n";
   print "Password:
\n"; print "\n"; print "
"; exit; } if ($formdata{'CRYPTPASS'}) { &error_trap("Login Incorrect.") unless (&verify_crypt_pass($formdata{'USERNAME'},$formdata{'CRYPTPASS'})); } else { &error_trap("Login Incorrect.") unless (&verify_login($formdata{'USERNAME'},$formdata{'PASSWORD'})); } ## order number is $formdata{'CUSTOMER'} ## if ORDER was passed to script, print out that customer file if (defined $formdata{'CUSTOMER'}) { open(customer_file, "$customer_file_name") || &error_trap ("Invoice # $formdata{'CUSTOMER'} not found."); $line=; $line =~ s/\"//; #remove first " $line =~ s/\"$//; #remove trailing " @customer_info=split(/\"\,\"/, $line); print "
\n";
print("Customer ID: $customer_info[0]
");
# print("Remote Address: $customer_info[1]
");
print ("Date: $customer_info[2]
");
print ("Time: $customer_info[3]
");
print ("$customer_info[4] $customer_info[5] $customer_info[6]
"); #Title First Last
print ("$customer_info[7]
") if ($customer_info[7] ne ""); #Company
print ("$customer_info[8]
"); #Street1
print ("$customer_info[9]
") if ($customer_info[9] ne ""); #Street 2
print ("$customer_info[10], "); #CITY
print ("$customer_info[11] "); #STATE
print ("$customer_info[12]
"); #ZIP CODE
print ("$customer_info[13]
") if ($customer_info[13] ne "US"); #COUNTRY
print ("E-Mail: $customer_info[14]
");
print ("Daytime Phone: $customer_info[15]");
print ("x$customer_info[16]") if ($customer_info[16] ne ""); #EXTENSION
print "
";
print ("Nighttime Phone: $customer_info[17]");
print ("x$customer_info[18]") if ($customer_info[18] ne ""); #EXTENSION
print "
";
print ("Fax: $customer_info[19]
") if ($customer_info[19] ne "");
print ("$customer_info[22] "); #CARD TYPE
print ("$customer_info[23] "); #CARD NO.
print ("Exp. $customer_info[24]/$customer_info[25]
"); #EXPIRATION MONTH/YEAR
print ("
\n");
# skipped fields 26, 27, 28
# which are Suggestions, where did you find out about our site?, and FirstVirtual PIN

printf(" Sub Total: %6.2f
", $customer_info[29]); #sub total
if ($customer_info[30] != 0) {
   printf("       Tax: %6.2f
", $customer_info[30]); #tax
}
printf("  Shipping: %6.2f
", $customer_info[31]); #shipping
if ($customer_info[33] != 0) {
   printf("  Discount: %6.2f
", -$customer_info[33]); #total discount
}
if ($customer_info[34] != 0) {
   printf("COD Charge: %6.2f
", $customer_info[34]); #COD charge
}
if ($customer_info[35] != 0) {
   printf("  Handling: %6.2f
", $customer_info[35]); #handling
}
printf("-----------------
");
printf("     Total: %6.2f
", $customer_info[32]); #grand total
print "";
close customer_file;	
}
else
{
#------------------------------------------------------------------#    
# User logged in.  Now print up form to enter an invoice number.

### maximum number of orders to be seen as new at one time
$max=100;

&scan_dir;

### pretty it up a bit.
print "
PerlShop Administration Center
\n";
print "
\n";
print "\n";
print "\n";
print "
Enter the Invoice #: \n";
# print ""
print "
\n";

print "Or, choose an invoice number, below, to get the customer's information.\n";

print "
\n";
print "\n";
print "\n";
print "\n";
print "
\n"; } ### This sub routine scans the order directory for new orders sub scan_dir { opendir(dir, $customer); @dirs=grep {!(/^\./) && -d} readdir(dir); rewinddir(dir); @files=grep {!(-T)} readdir(dir); closedir(dir); } ### this sub routine prints out the new orders by order number sub print_files { print "\n"; } #------------------------------------------------------------------# # Perl Routines to Manipulate CGI input # S.E.Brenner@bioc.cam.ac.uk # $Header: /people/seb1005/http/cgi-bin/RCS/cgi-lib.pl,v 1.2 1994/01/10 15:05:40 seb1005 Exp $ # # Copyright 1993 Steven E. Brenner # Unpublished work. # Permission granted to use and modify this library so long as the # copyright above is maintained, modifications are documented, and # credit is given for any use of the library. # ReadParse # Reads in GET or POST data, converts it to unescaped text, and puts # one key=value in each member of the list "@in" # Also creates key/value pairs in %in, using '\0' to separate multiple # selections # If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse, # information is stored there, rather than in $in, @in, and %in. sub ReadParse { if (@_) { local (*in) = @_; } local ($i, $loc, $key, $val); # Read in text if ($ENV{'REQUEST_METHOD'} eq "GET") { $in = $ENV{'QUERY_STRING'}; } elsif ($ENV{'REQUEST_METHOD'} eq "POST") { for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) { $in .= getc; } } else { print "An error has occurred.\n"; exit; } @in = split(/&/,$in); foreach $i (0 .. $#in) { # Convert plus's to spaces $in[$i] =~ s/\+/ /g; # Convert %XX from hex numbers to alphanumeric $in[$i] =~ s/%(..)/pack("c",hex($1))/ge; # Split into key and value. $loc = index($in[$i],"="); $key = uc substr($in[$i],0,$loc); ### uc function added by E.T. $val = substr($in[$i],$loc+1); $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator $in{$key} .= $val; } return 1; # just for fun } #------------------------------------------------ sub verify_login { my ($name, $pass) = @_; my $line; open (PASSWD, $htaccess_file) || &error_trap("Couldn't open password file."); while ($line = ) { chop ($line) if ($line =~ /\n$/); ($username, $password) = split(/:/ , $line); #changes global variables ($username, $password) if (($username eq $name) && ($password eq crypt ($pass, substr($password, 0, 2)))){ close (PASSWD); return (1); } } close (PASSWD); return (0); } #------------------------------------------------ sub verify_crypt_pass { my ($name, $pass) = @_; my $line; open (PASSWD, $htaccess_file) || &error_trap("Couldn't open password file."); while ($line = ) { chop ($line) if ($line =~ /\n$/); ($username, $password) = split(/:/ , $line); if (($username eq $name) && ($password eq $pass)){ close (PASSWD); return (1); } } close (PASSWD); return (0); } #------------------------------------------------ sub error_trap { my $err_msg=$_[0]; print "
An error has occurred:"; print "
$err_msg
"; exit; }