;
close THEFILE;
chomp($title, $reserve, $inc, $desc, $loca, $cont, $image, $image2, $image3, $image4, $cat1, $cat2, $cat3, $cat4, @bids);
@firstbid = split(/\[\]/,$bids[0]);
@lastbid = split(/\[\]/,$bids[$#bids]);
print "$title
\n";
print "
Description
$desc";
print "
Bid History
\n";
print "START: ";
foreach $bid (@bids) {
@thebid = split(/\[\]/,$bid);
$bidtime = localtime($thebid[3]);
print "$thebid[0] \($bidtime\) - \$$thebid[2]
\n";
}
print "Reserve was: \$$reserve
\n";
print "
Contact Information
\n";
if ($form{'ALIAS'} eq $firstbid[0]) {
print "You were the seller...\n";
print "Buyer Information:
Alias: $lastbid[0]
E-Mail: $lastbid[1]
Address: $lastbid[4]
$lastbid[5]
$lastbid[6]
High Bid: \$$lastbid[2]\n";
print "
Unsuccessful Bid Contacts:
\n";
foreach $bid (@bids) {
@thebid = split(/\[\]/,$bid);
print "$thebid[0] - $thebid[1]
\n";
}
print "
\n";
}
elsif ($form{'ALIAS'} eq $lastbid[0]) {
print "You were a high bidder...\n";
print "Seller Information:
Alias: $firstbid[0]
E-Mail: $firstbid[1]
Address: $firstbid[4]
$firstbid[5]
$firstbid[6]
Your High Bid: \$$lastbid[2]
\n";
print "Remember, the seller is not required to sell unless your bid price was above the reserve price...";
}
else {
print "You were not a winner... No further contact information is available.\n";
}
}
##############################################
# Sub: Seller edit auction
sub selleredit {
&oops('ALIAS') unless ($form{'ALIAS'});
&oops('PASSWORD') unless ($form{'PASSWORD'});
$form{'ALIAS'} =~ s/\W//g;
$form{'ALIAS'} = lc($form{'ALIAS'});
$form{'ALIAS'} = ucfirst($form{'ALIAS'});
open REGFILE, "$basepath$regdir/$form{'ALIAS'}.dat";
($password,$email,$add1,$add2,$add3,@junk) = ;
chomp($password,$email,$add1,$add2,$add3,@junk);
close REGFILE;
open THEFILE, "$basepath$form{'CAT'}/$form{'ITEM'}.dat";
($title, $reserve, $inc, $desc, $loca, $cont, $image, $image2, $image3, $image4, $cat1, $cat2, $cat3, $cat4, @bids) = ;
$title =~ s/\"//g; # quotes cause problems for a text input field
chomp($title, $reserve, $inc, $desc, $loca, $cont, $image, $image2, $image3, $image4, $cat1, $cat2, $cat3, $cat4, @bids);
close THEFILE;
@firstbid = split(/\[\]/,$bids[0]);
@lastbid = split(/\[\]/,$bids[$#bids]);
if ($firstbid[0] eq $form{'ALIAS'}) {
if (lc($password) eq lc($form{'PASSWORD'})) {
print <<"EOF";
EOF
if ($firstbid[0] eq $lastbid[0]) {
print <<"EOF";
EOF
}
}
else {
print "\n";
print "Incorrect Password!\n";
print "\n";
}
}
else {
print "\n";
print "Only the seller may make modifications to the listing!\n";
print "\n";
}
}
##############################################
# Sub: Process Modified Auction
sub sellerchange {
&oops('ITEM') unless ($form{'ITEM'});
$form{'ITEM'} =~ s/\W//g;
&oops('ITEM') unless (open(THEFILE, "$basepath$form{'CAT'}/$form{'ITEM'}.dat"));
($title, $reserve, $inc, $desc, $loca, $cont, $image, $image2, $image3, $image4, $cat1, $cat2, $cat3, $cat4, @bids) = ;
close THEFILE;
chomp($title, $reserve, $inc, $desc, $loca, $cont, $image, $image2, $image3, $image4, $cat1, $cat2, $cat3, $cat4, @bids);
@firstbid = split(/\[\]/,$bids[0]);
@lastbid = split(/\[\]/,$bids[$#bids]);
$form{'IMAGE'} = $image if !($form{'IMAGE'});
$commtime = localtime(time);
if ($form{'NEWDESC'} ne "") {
$desc1 = $desc;
$desc1 .= "
";
$desc1 .= "Added by the Seller on $commtime\:
$form{'NEWDESC'}";
}
else {
$desc1 = $desc;
}
&oops('ITEM') unless (open NEWITEM, ">$basepath$form{'CAT'}/$form{'ITEM'}.dat");
print NEWITEM "$title\n$reserve\n$inc\n$desc1\n$loca\n$cont\n$image\n$image2\n$image3\n$image4\n$cat1\n$cat2\n$cat3\n$cat4";
foreach $bad (@bids) {
@thebid = split(/\[\]/,$bad);
$bidtime = localtime($thebid[3]);
print NEWITEM "\n$thebid[0]\[\]$thebid[1]\[\]$thebid[2]\[\]$thebid[3]\[\]$thebid[4]\[\]$thebid[5]\[\]$thebid[6]\[\]$thebid[7]";
$message = "This item has a bidding history that was not changed!";
}
close NEWITEM;
print "\n";
print "$form{'TITLE'} has been successfully changed.
\n";
##print "$message\n";
print "\n";
}
##############################################
# Sub: Remove Item
sub selldel1 {
if (unlink("$basepath$form{'CAT'}/$form{'ITEM'}.dat")) {
print "\n";
print "\n";
print "Your SUPER CLASSIFIED AD has been deleted!\n";
print "\n";
}
else {
print "\n";
print "\n";
print "File Could Not Be Removed!\n";
print "\n";
}
}
##############################################
# Sub: Oops!
sub oops {
print "
Something is wrong with the $_[0] section.
Please hit BACK to try again!
\n";
exit;
}
##############################################
# Sub: Get Form Data
sub get_form_data {
$buffer = "";
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/,$buffer);
foreach $pair (@pairs)
{
@a = split(/=/,$pair);
$name=$a[0];
$value=$a[1];
$value =~ s/\+/ /g;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/~!/ ~!/g;
$value =~ s/[\n\r]/ /sg; #remove \n
$value =~ s/\[\]//g; #remove []
push (@data,$name);
push (@data, $value);
}
%form=@data;
%form;
}
##############################################
# Sub: File Lock
sub filelock {
flock (NEWITEM, 2);
seek(NEWITEM, 0, 2);
}
#################################
sub Parse_Form {
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
@pairs = split(/&/, $ENV{'QUERY_STRING'});
} elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
if ($ENV{'QUERY_STRING'}) {
@getpairs =split(/&/, $ENV{'QUERY_STRING'});
push(@pairs,@getpairs);
}
} else {
print "Content-type: text/html\n\n";
print "Use Post or Get";
}
foreach $pair (@pairs) {
($key, $value) = split (/=/, $pair);
$key =~ tr/+/ /;
$key =~ 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;
$value =~s///g;
if ($formdata{$key}) {
$formdata{$key} .= ", $value";
} else {
$formdata{$key} = $value;
}
}
}
##############################################
# SUB: Send E-mail
sub sendemail {
use Socket;
$TO=$_[0]; @TO=split('\0',$TO);
$SUBJECT=$_[1];
$REPLYTO=$_[2];
$REMOTE = $_[3];
$THEMESSAGE = $_[4];
if ($REMOTE =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
$addr = pack('C4', $1, $2, $3, $4);
}
else { die("Bad IP address: $!"); }
$port = 25 unless $port;
$port = getservbyname($port,'tcp') if $port =~ /\D/;
$proto = getprotobyname('tcp');
socket(S, PF_INET, SOCK_STREAM, $proto) or die("Socket failed: $!");
$sockaddr = 'S n a4 x8'; # shouldn't this be in Socket.pm?
connect(S, pack($sockaddr, AF_INET, $port, $addr)) or die("Unable to connect: $!");
select(S); $| = 1; select(STDOUT);
$a=;
print S "HELO ${SERVERNAME}\n";
$a=;
print S "MAIL FROM:postmaster\@transportuniverse\.com\n";
$a=;
print S "RCPT TO:<$TO[0]>\n";
$a=;
if ($#TO > 0) { foreach (1..$#TO) { print S "RCPT TO: $TO[$_]\n";$a=; }
}
print S "DATA \n";
$a=;
print S "To: $TO[0]\n";
if ($#TO > 0) { foreach (1..$#TO) { print S "Cc: $TO[$_]\n"; }
}
print S "Subject: $SUBJECT\n";
# Print the body
print S "$THEMESSAGE\n";
print S ".\n";
$a=;
print S "QUIT";
close (S);
}
