Perl auktion
Hej her er koden til en perl auktion:#!/usr/bin/perl
##############################################
#
# EveryAuction
# by Matt Hahnfeld, EverySoft
#
# The premiere freeware auction software from
# the makers of EveryChat(tm).
#
# Version 1.01 (5/10/98)
#
# REDISTRIBUTION IN ANY FORM IS STRICTLY
# PROHIBITED!
#
# Please see the reamdme.txt file included
# with this script for the full license
# agreement.
#
# (c) 1998-99 EverySoft
#
# http://www.everysoft.com/
#
##############################################
##############################################
# The input query string is in the form
# auction.cgi?[category]&[number]&[r||n||u||c||v]
#
# If nothing is given, the script will
# display the categories in the auction.
#
# If category dir is given, the
# script will display the items in the
# category.
#
# If category dir is given and message
# number is given, the script will display
# the item.
#
# If category dir is given and message
# number is given, and the letter r is given
# then the record will be deleted from
# the database.
#
# If category dir is given and message
# number is given, and the letter n is given
# then a new record can be created. The
# message number given is ignored.
#
# If category dir is given and message
# number is given, and the letter u is given
# then a new user registration can be
# created. Both the message number and
# category given are ignored.
#
# If category dir is given and message
# number is given, and the letter c is given
# then a user registration can be
# changed. Both the message number and
# category given are ignored.
#
# If category dir is given and message
# number is given, and the letter v is given
# then a user may view his/her closed item
# status. Both the message number and
# category given are ignored.
#
##############################################
# Configuration Section
# Edit these variables!
# The Base Directory. We need an
# absolute path for the base directory.
# Include the trailing slash. THIS SHOULD
# NOT BE WEB-ACCESSIBLE!
$basepath = ''/home/hahnfld/auctiondata/'';
# Closed Auction Directory
# This is where closed auction items are stored.
# Leave this blank if you don''t want to store
# closed auctions. It can potentially take
# up quite a bit of disk space.
$closedir = ''closed'';
# User Registration Directory
# This is where user registrations are stored.
# Leave this blank if you don''t want to
# require registration. It can potentially
# take up quite a bit of disk space.
$regdir = ''reg'';
# List each directory and its associated
# category name. These directories should
# be subdirectories of the base directory.
%category = (
computer => ''Computer Hardware and Software'',
elec => ''Consumer Electronics'',
other => ''Other Junk'',
);
# This is the password for deleting auction
# items. If it is left blank, anyone may
# delete entries.
$adminpass = ''auction'';
# This must be the valid IP ADDRESS of an
# SMTP server. It is used to mail auction
# notifications. If the e-mail system is
# not working, this is what you should
# check first.
$mailserver = "127.0.0.1";
# This line should point to the URL of
# your server. It will be used for sending
# "you have been outbid" e-mail. The script
# name and auction will be appended to the
# end automatically, so DO NOT use a trailing
# slash. If you do not want to send outbid
# e-mail, leave this blank.
$scripturl = "www.your.host.com";
# This will let you define colors for the
# tables that are generated and the
# other page colors. The default colors
# create a nice "professional" look. Must
# be in hex format.
$colorbg = ''#FFFFFF'';
$colortext = ''#000000'';
$colorlink = ''#408080'';
$colorvlink = ''#000080'';
$coloralink = ''#800080'';
$colortablehead = ''#BBBBBB'';
$colortablebody = ''#EEEEEE'';
# Site Name (will appear at the top of each page)
$sitename = ''Your Site Name Here'';
# Sniper Protection... How many minutes
# past last bid to hold auction. If auctions
# should close at exactly closing time, set
# to zero.
$aftermin = 5;
# File locking enabled? Should be 1 (yes)
# for most systems, but set to 0 (no) if you
# are getting flock errors or the script
# crashes.
$flock = 1;
# User Posting Enabled- 1=yes 0=no
$newokay = 1;
##############################################
# Main Program
# You do not need to edit anything below this
# line.
##############################################
# Print The Page Header
#
print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>EveryAuction</TITLE></HEAD><BODY TEXT=$colortext BGCOLOR=$colorbg LINK=$colorlink VLINK=$colorvlink ALINK=$coloralink><TABLE WIDTH=100\% BORDER=0><TR><TD VALIGN=BOTTOM WIDTH=100\%><FONT SIZE=+2>$sitename</FONT><BR><FONT SIZE=+1>Online Auction</FONT></TD>\n";
print "<TD VALIGN=BOTTOM><FORM ACTION=$ENV{''SCRIPT_NAME''} METHOD=POST><INPUT TYPE=TEXT NAME=searchstring><INPUT TYPE=SUBMIT VALUE=\"Search\"><BR><FONT SIZE=-2><INPUT TYPE=RADIO NAME=searchtype VALUE=\"keyword\" CHECKED>keyword <INPUT TYPE=RADIO NAME=searchtype VALUE=\"username\">username </FONT></FORM></TD></TR></TABLE><P>\n";
#
##############################################
&get_form_data; # parse arguments from post
@ARGV = split(/\\*\&/, $ENV{''QUERY_STRING''});
$ARGV[0] =~ s/\W//g;
$ARGV[1] =~ s/\D//g;
if ($form{''action''} eq ''bid'') { &procbid; }
elsif ($form{''action''} eq ''new'') { &procnew; }
elsif ($form{''action''} eq ''reg'') { &procreg; }
elsif ($form{''action''} eq ''creg'') { &proccreg; }
elsif ($form{''action''} eq ''repost'') { &newitem; }
elsif ($form{''action''} eq ''closeditems1'') { &viewclosed1; }
elsif ($form{''action''} eq ''closeditems2'') { &viewclosed2; }
elsif ($form{''searchstring''}) { &procsearch; }
elsif ($ARGV[2] eq ''u'') { &newreg; }
elsif ($ARGV[2] eq ''c'') { &changereg; }
elsif ($ARGV[2] eq ''v'') { &viewclosed; }
elsif ($ARGV[2] eq ''n'') { &newitem; }
elsif (($regdir ne "") && ($ARGV[0] eq $regdir)) { &dispcat; } # be sure nobody is trying to hack the user dir
elsif (!(($ARGV[0]) && (-d "$basepath$ARGV[0]"))) { &dispcat; }
elsif ($ARGV[2] eq ''r'') { &remitem; }
elsif (!(($ARGV[1]) && (-f "$basepath$ARGV[0]/$ARGV[1].dat"))) { &displist; }
else { &dispitem; }
##############################################
# Print The Page Footer
#
print "<P><P ALIGN=CENTER><FONT SIZE=-1><A HREF=$ENV{''SCRIPT_NAME''}>[Category List]</A>";
print " <A HREF=$ENV{''SCRIPT_NAME''}?1\&1\&n>[Post New Item]</A>" if ($newokay);
print " <A HREF=$ENV{''SCRIPT_NAME''}?1\&1\&u>[New Registration]</A> <A HREF=$ENV{''SCRIPT_NAME''}?1\&1\&c>[Change Registration]</A>" if ($regdir);
print " <A HREF=$ENV{''SCRIPT_NAME''}?1\&1\&v>[Closed Auctions]</A>" if ($regdir) && ($closedir);
# Please do not delete or change the following line!!!
print "<BR><I>Powered By <A HREF=http://www.everysoft.com/auction/>EveryAuction 1.01</A></I></FONT></P></BODY></HTML>\n";
#
##############################################
##############################################
# Sub: Display List Of Categories
# This creates a "nice" list of categories.
sub dispcat {
print "<H2>Auction Categories</H2><TABLE WIDTH=100\% BORDER=1>\n";
print "<TR BGCOLOR=$colortablehead><TD ALIGN=CENTER><B>Category</B></TD><TD ALIGN=CENTER><B>Items</B></TD></TR>";
foreach $key (sort keys %category) {
opendir THEDIR, "$basepath$key" |||| die "Unable to open directory: $!";
@allfiles = grep -T, map "$basepath$key/$_", readdir THEDIR;
closedir THEDIR;
$numfiles = @allfiles;
umask(000); # UNIX file permission junk
mkdir("$basepath$key", 0777) unless (-d "$basepath$key");
print "<TR BGCOLOR=$colortablebody><TD><A HREF=$ENV{''SCRIPT_NAME''}\?$key>$category{$key}</A></TD><TD>$numfiles</TD></TR>";
}
print "</TABLE>\n";
}
##############################################
# Sub: Display List Of Items
# This creates a "nice" list of items in a
# category.
sub displist {
print "<H2>$category{$ARGV[0]}</H2>\n";
print "<TABLE BORDER=1 WIDTH=100\%>\n";
print "<TR BGCOLOR=$colortablehead><TD ALIGN=CENTER><B>Item</B></TD><TD ALIGN=CENTER><B>Closes</B></TD><TD ALIGN=CENTER><B>Num Bids</B></TD><TD ALIGN=CENTER><B>High Bid</B></TD></TR>\n";
opendir THEDIR, "$basepath$ARGV[0]" |||| die "Unable to open directory: $!";
@allfiles = readdir THEDIR;
closedir THEDIR;
foreach $file (sort { int($a) <=> int($b) } @allfiles) {
if (-T "$basepath$ARGV[0]/$file") {
open THEFILE, "$basepath$ARGV[0]/$file";
($title, $reserve, $inc, $desc, $image, @bids) = <THEFILE>;
close THEFILE;
chomp($title, $reserve, $inc, $desc, $image, @bids);
@lastbid = split(/\[\]/,$bids[$#bids]);
$file =~ s/\.dat//;
@closetime = localtime($file);
$closetime[4]++;
$camera="";
$camera = " <FONT COLOR=#3333FF SIZE=-1>[PIC]</FONT>" if ($image);
print "<TR BGCOLOR=$colortablebody><TD><A HREF=$ENV{''SCRIPT_NAME''}\?$ARGV[0]\&$file>$title</A>$camera</TD><TD>$closetime[4]/$closetime[3]</TD><TD>$#bids</TD><TD>\$$lastbid[2]</TD></TR>\n";
}
}
print "</TABLE>\n";
}
##############################################
# Sub: Display Item
# This displays a particular item, its
# description, and its associated bids.
sub dispitem {
open THEFILE, "$basepath$ARGV[0]/$ARGV[1].dat";
($title, $reserve, $inc, $desc, $image, @bids) = <THEFILE>;
close THEFILE;
chomp($title, $reserve, $inc, $desc, $image, @bids);
@firstbid = split(/\[\]/,$bids[0]);
@lastbid = split(/\[\]/,$bids[$#bids]);
$nowtime = localtime(time);
$closetime = localtime($ARGV[1]);
$image = "<TD><IMG SRC=$image></TD>" if ($image);
print "<H2>$title</H2><HR><FONT SIZE=+1><B>Information</B></FONT><HR>\n";
$reservemet = "";
$reservemet = "<FONT SIZE=-1>(reserve price not yet met)</FONT>" if ($lastbid[2] < $reserve);
$reservemet = "<FONT SIZE=-1>(reserve price met)</FONT>" if (($lastbid[2] >= $reserve) && ($reserve > 0));
print "<TABLE WIDTH=100\%><TR>$image<TD><TABLE BORDER=1><TR BGCOLOR=$colortablehead><TD><B>$title</B></TD></TR><TR BGCOLOR=$colortablebody><TD><B>Category:</B> <A HREF=$ENV{''SCRIPT_NAME''}\?$ARGV[0]>$category{$ARGV[0]}</A></TD></TR><TR BGCOLOR=$colortablebody><TD><B>Offered By:</B> <A HREF=mailto:$firstbid[1]>$firstbid[0]</A></TR></TD><TR BGCOLOR=$colortablebody><TD><B>Current Time:</B> $nowtime</TD></TR><TR BGCOLOR=$colortablebody><TD><B>Closes:</B> $closetime<BR><FONT SIZE=-2>Or $aftermin minutes after last bid...</FONT></TD></TR><TR BGCOLOR=$colortablebody><TD><B>Number of Bids:</B> $#bids</TD></TR><TR BGCOLOR=$colortablebody><TD><B>Last Bid:</B> \$$lastbid[2] $reservemet</TD></TR></TABLE></TD></TR></TABLE>\n";
print "<HR><FONT SIZE=+1><B>Description</B></FONT><HR>$desc</FONT></FONT></B></I></U></H1></H2></H3></H4></H5>";
print "<HR><FONT SIZE=+1><B>Bid History</B></FONT><HR>\n";
print "<FONT SIZE=-1><B>START:</B></FONT> ";
foreach $bid (@bids) {
@thebid = split(/\[\]/,$bid);
$bidtime = localtime($thebid[3]);
print "<FONT SIZE=-1>$thebid[0] \($bidtime\) - \$$thebid[2]</FONT><BR>";
}
if ((time > $ARGV[1]) && (time > (60 * $aftermin + $thebid[3]))) {
print "<FONT SIZE=-1 COLOR=#FF0000><B>BIDDING IS NOW CLOSED</B></FONT><BR>";
&closeit;
}
else {
&placebid;
}
}
##############################################
# Sub: Place Bid on Item
# This allows a user to place a new bid on
# something.
sub placebid {
$lowbid = &parsebid($lastbid[2] + $inc);
print <<"EOF";
<FORM ACTION=$ENV{''SCRIPT_NAME''} METHOD=POST>
<HR><FONT SIZE=+1><B>Place A Bid</B></FONT><HR>
<INPUT TYPE=HIDDEN NAME=action VALUE=bid>
<INPUT TYPE=HIDDEN NAME=ITEM VALUE=$ARGV[1]>
<INPUT TYPE=HIDDEN NAME=CATEGORY VALUE=$ARGV[0]>
<B>The High Bid Is:</B> \$$lastbid[2]<BR>
<B>The Lowest You May Bid Is:</B> \$$lowbid
<P>Please note that by placing a bid you are making a contract between you and the seller.
Once you place a bid, you may not retract it. In some states, it is illegal to win
an auction and not purchase the item. In other words, if you don''t want to pay for it,
don''t bid!
EOF
if ($regdir eq "") {
print <<"EOF";
<P><B>Your Handle/Alias:</B> <INPUT NAME=ALIAS TYPE=TEXT SIZE=30 MAXLENGTH=30> (used to track your bid)
<BR><B>Your E-Mail Address:</B> <INPUT NAME=EMAIL TYPE=TEXT SIZE=30> (must be valid)
<BR><B>Your Bid:</B> \$<INPUT NAME=BID TYPE=TEXT SIZE=7 VALUE=$lowbid>
<P><B>Contact Information:</B> (will be given out only to the seller)<BR>
<TT>Full Name: </TT><BR><INPUT NAME=ADDRESS1 TYPE=TEXT SIZE=30><BR>
<TT>Street Address: </TT><BR><INPUT NAME=ADDRESS2 TYPE=TEXT SIZE=30><BR>
<TT>City, State, ZIP: </TT><BR><INPUT NAME=ADDRESS3 TYPE=TEXT SIZE=30><P>
EOF
}
else {
print <<"EOF";
<P><B><A HREF=$ENV{''SCRIPT_NAME''}?1\&1\&u>Registration</A> is required to post or bid!</B>
<P><B>Your Handle/Alias:</B> <INPUT NAME=ALIAS TYPE=TEXT SIZE=30 MAXLENGTH=30> (used to track your bid)
<BR><B>Your Password:</B> <INPUT NAME=PASSWORD TYPE=PASSWORD SIZE=30> (must be valid)
<BR><B>Your Bid:</B> \$<INPUT NAME=BID TYPE=TEXT SIZE=7 VALUE=$lowbid><P>
EOF
}
print <<"EOF";
<INPUT TYPE=SUBMIT VALUE="Place Bid">
EOF
}
##############################################
# Sub: Process Bid
# This processes new bids from a posted form
sub procbid {
if (($regdir ne "") && !($newbidflag)) {
$form{''ALIAS''} =~ s/\W//g;
$form{''ALIAS''} = lc($form{''ALIAS''});
$form{''ALIAS''} = ucfirst($form{''ALIAS''});
&oops(''ALIAS'') unless (open(REGFILE, "$basepath$regdir/$form{''ALIAS''}.dat"));
($password, $form{''EMAIL''}, $form{''ADDRESS1''}, $form{''ADDRESS2''}, $form{''ADDRESS3''}, @userbids) = <REGFILE>;
close REGFILE;
chomp($password, $form{''EMAIL''}, $form{''ADDRESS1''}, $form{''ADDRESS2''}, $form{''ADDRESS3''}, @userbids);
&oops(''PASSWORD'') unless ((lc $password) eq (lc $form{''PASSWORD''}));
}
&oops(''ALIAS'') unless ($form{''ALIAS''});
&oops(''EMAIL'') unless ($form{''EMAIL''} =~ /.+\@.+/);
&oops(''BID'') unless ($form{''BID''} =~ /^(\d+\.?\d*||\.\d+)$/);
$form{''BID''} = &parsebid($form{''BID''});
&oops(''ADDRESS1'') unless ($form{''ADDRESS1''});
&oops(''ADDRESS2'') unless ($form{''ADDRESS2''});
&oops(''ADDRESS3'') unless ($form{''ADDRESS3''});
$timenum = time;
$thetime = localtime(time);
&oops(''ITEM'') unless (open ITEM, "$basepath$form{''CATEGORY''}/$form{''ITEM''}.dat");
($title, $reserve, $inc, $desc, $image, @bids) = <ITEM>;
close ITEM;
chomp($title, $reserve, $inc, $desc, $image, @bids);
@lastbid = split(/\[\]/,$bids[$#bids]);
if ((((time <= $form{''ITEM''}) |||| (time <= (60 * $aftermin + $lastbid[3]))) && ($form{''BID''} >= $lastbid[2] + $inc)) |||| ($newbidflag == 1)) {
&oops(''ITEM'') unless (open NEWITEM, ">>$basepath$form{''CATEGORY''}/$form{''ITEM''}.dat");
&filelock if ($flock);
print NEWITEM "\n$form{''ALIAS''}\[\]$form{''EMAIL''}\[\]$form{''BID''}\[\]$timenum\[\]$form{''ADDRESS1''}\[\]$form{''ADDRESS2''}\[\]$form{''ADDRESS3''}";
close NEWITEM;
print "<B>$form{''ALIAS''}, your bid has been placed on item number $form{''ITEM''} for \$$form{''BID''} on $thetime.</B><BR>You may want to print this notice as confirmation of your bid.<P>Go <A HREF=$ENV{''SCRIPT_NAME''}\?$form{''CATEGORY''}\&$form{''ITEM''}>back to the item</A>\n";
$flag=0;
foreach $userbid(@userbids) {
$flag=1 if ("$form{''CATEGORY''}$form{''ITEM''}" eq $userbid);
}
if ($flag==0 && $regdir ne "") {
&oops(''ALIAS'') unless (open(REGFILE, ">>$basepath$regdir/$form{''ALIAS''}.dat"));
print REGFILE "\n$form{''CATEGORY''}$form{''ITEM''}";
close REGFILE;
}
&sendemail($lastbid[1], ''You\''ve been outbid!'', ''nobody'', $mailserver, "You have been outbid on $title\! If you want to place a higher bid, please visit\:\n\n\thttp://$scripturl$ENV{''SCRIPT_NAME''}\?$form{''CATEGORY''}\&$form{''ITEM''}\n\nThe current high bid is \$$form{''BID''}.") if (($newbidflag != 1) && $scripturl);
}
else {
print "Either the auction is closed or your bid is too low.<BR>Hit the back button and reload to get the latest auction stats, then try again!\n";
}
}
##############################################
# Sub: Close Auction
# This sets an item''s status to closed.
sub closeit {
if ($ARGV[0] ne $closedir) {
# We''ll use the @firstbid and @lastbid info defined in &dispitem
if ($closedir) {
umask(000); # UNIX file permission junk
mkdir("$basepath$closedir", 0777) unless (-d "$basepath$closedir");
print "Please notify the site admin that this item cannot be copied to the closed directory even though it is closed.\n" unless &movefile("$basepath$ARGV[0]/$ARGV[1].dat", "$basepath$closedir/$ARGV[0]$ARGV[1].dat");
}
else {
print "Please notify the site admin that this item cannot be removed even though it is closed.\n" unless unlink("$basepath$ARGV[0]/$ARGV[1].dat");
}
if ($lastbid[2] >= $reserve) {
&sendemail($lastbid[1], "Auction Close: $title", $firstbid[1], $mailserver, "Congratulations! You are the winner of auction number $ARGV[1].\nYour winning bid was \$$lastbid[2].\n\nPlease contact the seller to make arrangements for payment and shipping:\n\n$firstbid[4]\n$firstbid[5]\n$firstbid[6]\n$firstbid[1]\n\nThanks for using EveryAuction!");
}
else {
&sendemail($lastbid[1], "Auction Close: $title", $firstbid[1], $mailserver, "Congratulations! You were the high bidder on auction number $ARGV[1].\nYour bid was \$$lastbid[2].\n\nUnfortunately, your bid did not meet the seller\''s reserve price...\n\nYou may still wish to contact the seller to negotiate a fair price:\n\n$firstbid[4]\n$firstbid[5]\n$firstbid[6]\n$firstbid[1]\n\nThanks for using EveryAuction!");
}
&sendemail($firstbid[1], "Auction Close: $title", $lastbid[1], $mailserver, "Auction Number $ARGV[1] Is Now Closed.\nThe high bid was \$$lastbid[2] (Your reserve was: \$$reserve).\n\nPlease contact the high bidder to make any necessary arrangements:\n\n$lastbid[4]\n$lastbid[5]\n$lastbid[6]\n$lastbid[1]\n\nThanks for using EveryAuction!");
}
}
##############################################
# Sub: Remove Item
# This removes an item from the auction
# database.
sub remitem {
if ($ARGV[3] eq $adminpass) {
if (unlink("$basepath$ARGV[0]/$ARGV[1].dat")) {
print "File Successfully Removed!\n";
}
else {
print "File Could Not Be Removed!\n";
}
}
else {
print "Sorry... Incorrect administrator password for delete!\n";
}
}
##############################################
# Sub: Add New Item
# This allows a new item to be put up for sale
sub newitem {
$inc = "1.00";
if ($form{''REPOST''}) {
if (open (THEFILE, "$basepath$closedir/$form{''REPOST''}.dat")) {
($title, $reserve, $inc, $desc, $image, @bids) = <THEFILE>;
$title =~ s/\"//g; # quotes cause problems for a text input field
close THEFILE;
}
}
print <<"EOF";
<FORM ACTION=$ENV{''SCRIPT_NAME''} METHOD=POST>
<H2>Post A New Item</H2>
<TABLE WIDTH=100% BORDER=1 BGCOLOR=$colortablebody>
<INPUT TYPE=HIDDEN NAME=action VALUE=new>
<TR><TD VALIGN=TOP><B>Title/Item Name:<BR></B>No HTML</TD><TD><INPUT NAME=TITLE VALUE=\"$title\" TYPE=TEXT SIZE=50 MAXLENGTH=50></TD></TR>
<TR><TD VALIGN=TOP><B>Category:<BR></B>Select One</TD><TD><SELECT NAME=CATEGORY>
<OPTION SELECTED></OPTION>
EOF
foreach $key (sort keys %category) {
print "<OPTION VALUE=\"$key\">$category{$key}</OPTION>\n";
}
print <<"EOF";
</SELECT></TD></TR>
<TR><TD VALIGN=TOP><B>Image URL:<BR></B>Optional, should be no larger than 200x200</TD><TD><INPUT NAME=IMAGE VALUE=\"$image\" TYPE=TEXT SIZE=50 VALUE="http://"></TD></TR>
<TR><TD VALIGN=TOP><B>Days Until Close:<BR></B>1-14</TD><TD><INPUT NAME=DAYS TYPE=TEXT SIZE=2 MAXLENGTH=2></TD></TR>
<TR><TD VALIGN=TOP><B>Description:<BR></B>May include HTML - This should include the condition of the item, payment and shipping information, and
any other information the buyer should know.</TD><TD><TEXTAREA NAME=DESC ROWS=5 COLS=45>$desc</TEXTAREA></TD></TR>
<TR><TD COLSPAN=2 VALIGN=TOP>Please note that by placing an item up for bid you are making a contract between you and the buyer.
Once you place an item, you may not retract it and you must sell it for the highest bid.
In other words, if you don''t want to sell it, don''t place it up for bid!
EOF
if ($regdir eq "") {
print <<"EOF";
</TD></TR>
<TR><TD VALIGN=TOP><B>Your Handle/Alias:<BR></B>Used to track your post</TD><TD><INPUT NAME=ALIAS TYPE=TEXT SIZE=30 MAXLENGTH=30>
<TR><TD VALIGN=TOP><B>Your E-Mail Address:<BR></B>Must be valid</TD><TD><INPUT NAME=EMAIL TYPE=TEXT SIZE=30>
<TR><TD VALIGN=TOP><B>Your Starting Bid:</B></TD><TD>\$<INPUT NAME=BID TYPE=TEXT SIZE=7 VALUE=0>
<TR><TD VALIGN=TOP><B>Your Reserve Price:<BR></B>You are not obligated to sell below this price. Leave blank if none.</TD><TD>\$<INPUT NAME=RESERVE TYPE=TEXT SIZE=7 VALUE=0>
<TR><TD VALIGN=TOP><B>Bid Increment:</B></TD><TD>\$<INPUT NAME=INC TYPE=TEXT SIZE=7 VALUE=\"$inc\">
<TR><TD VALIGN=TOP><B>Contact Information:<BR></B>Will be given out only to the buyer</TD><TD>
<TT>Full Name: </TT><BR><INPUT NAME=ADDRESS1 TYPE=TEXT SIZE=30><BR>
<TT>Street Address: </TT><BR><INPUT NAME=ADDRESS2 TYPE=TEXT SIZE=30><BR>
<TT>City, State, ZIP: </TT><BR><INPUT NAME=ADDRESS3 TYPE=TEXT SIZE=30></TD></TR></TABLE>
EOF
}
else {
print <<"EOF";
<P><B><A HREF=$ENV{''SCRIPT_NAME''}?1\&1\&u>Registration</A> is required to post or bid!</B></TD></TR>
<TR><TD VALIGN=TOP><B>Your Handle/Alias:<BR></B>Used to track your post</TD><TD><INPUT NAME=ALIAS TYPE=TEXT SIZE=30 MAXLENGTH=30>
<TR><TD VALIGN=TOP><B>Your Password:<BR></B>Must be valid</TD><TD><INPUT NAME=PASSWORD TYPE=PASSWORD SIZE=30>
<TR><TD VALIGN=TOP><B>Your Starting Bid:</B></TD><TD>\$<INPUT NAME=BID TYPE=TEXT SIZE=7 VALUE=0>
<TR><TD VALIGN=TOP><B>Your Reserve Price:<BR></B>You are not obligated to sell below this price. Leave blank if none.</TD><TD>\$<INPUT NAME=RESERVE TYPE=TEXT SIZE=7 VALUE=0>
<TR><TD VALIGN=TOP><B>Bid Increment:</B></TD><TD>\$<INPUT NAME=INC TYPE=TEXT SIZE=7 VALUE=\"$inc\"></TD></TR></TABLE>
EOF
}
print <<"EOF";
<CENTER><INPUT TYPE=SUBMIT VALUE=Preview></CENTER>
EOF
}
##############################################
# Sub: Preview
# This displays items before they are posted.
sub preview {
$nowtime = localtime(time);
$closetime = localtime($form{''ITEM''});
$image = "<TD><IMG SRC=$form{''IMAGE''}></TD>" if ($form{''IMAGE''});
print "<H2>$form{''TITLE''} PREVIEW</H2><HR><FONT SIZE=+1><B>Information</B></FONT><HR>\n";
print "<TABLE WIDTH=100\%><TR>$image<TD><TABLE BORDER=1><TR BGCOLOR=$colortablehead><TD><B>$form{''TITLE''}</B></TD></TR><TR BGCOLOR=$colortablebody><TD><B>Category:</B> <A HREF=$ENV{''SCRIPT_NAME''}\?$form{''CATEGORY''}>$category{$form{''CATEGORY''}}</A></TD></TR><TR BGCOLOR=$colortablebody><TD><B>Offered By:</B> <A HREF=mailto:$form{''EMAIL''}>$form{''ALIAS''}</A></TR></TD><TR BGCOLOR=$colortablebody><TD><B>Current Time:</B> $nowtime</TD></TR><TR BGCOLOR=$colortablebody><TD><B>Closes:</B> $closetime<BR><FONT SIZE=-2>Or $aftermin minutes after last bid...</FONT></TD></TR><TR BGCOLOR=$colortablebody><TD><B>Number of Bids:</B> 0</TD></TR><TR BGCOLOR=$colortablebody><TD><B>Last Bid:</B> \$$form{''BID''}</TD></TR></TABLE></TD></TR></TABLE>\n";
print "<HR><FONT SIZE=+1><B>Description</B></FONT><HR>$form{''DESC''}</FONT></FONT></B></I></U></H1></H2></H3></H4></H5>";
print "<HR><B><FORM ACTION=$ENV{''SCRIPT_NAME''} METHOD=POST>If this looks good, hit <INPUT TYPE=SUBMIT VALUE=\"Post Item\">, else hit the back button on your browser to edit the item.<INPUT TYPE=HIDDEN NAME=FROMPREVIEW VALUE=1></B>\n";
foreach $key (keys %form) {
$form{$key} =~ s/\>/\[greaterthansign\]/gs;
$form{$key} =~ s/\</\[lessthansign\]/gs;
$form{$key} =~ s/\"/\[quotes\]/gs;
print "<INPUT TYPE=hidden NAME=\"$key\" VALUE=\"$form{$key}\">\n";
}
print "</FORM>\n";
}
##############################################
# Sub: Process New Item
# This processes new item to be put up for
# sale from a posted form
sub procnew {
if ($regdir ne "") {
$form{''ALIAS''} =~ s/\W//g;
$form{''ALIAS''} = lc($form{''ALIAS''});
$form{''ALIAS''} = ucfirst($form{''ALIAS''});
&oops(''ALIAS'') unless (open(REGFILE, "$basepath$regdir/$form{''ALIAS''}.dat"));
($password, $form{''EMAIL''}, $form{''ADDRESS1''}, $form{''ADDRESS2''}, $form{''ADDRESS3''}, @userbids) = <REGFILE>;
close REGFILE;
chomp($password, $form{''EMAIL''}, $form{''ADDRESS1''}, $form{''ADDRESS2''}, $form{''ADDRESS3''}, @userbids);
&oops(''PASSWORD'') unless ((lc $password) eq (lc $form{''PASSWORD''}));
}
&oops(''TITLE'') unless ($form{''TITLE''} && (length($form{''TITLE''}) < 51));
$form{''TITLE''} =~ s/\</\<\;/g;
$form{''TITLE''} =~ s/\>/\>\;/g;
&oops(''CATEGORY'') unless (-d "$basepath$form{''CATEGORY''}");
$form{''IMAGE''} = "" if ($form{''IMAGE''} eq "http://");
&oops(''DAYS'') unless (($form{''DAYS''} > 0) && ($form{''DAYS''} < 15));
&oops(''DESC'') unless ($form{''DESC''});
&oops(''ALIAS'') unless ($form{''ALIAS''});
&oops(''EMAIL'') unless ($form{''EMAIL''} =~ /.+\@.+/);
&oops(''BID'') unless ($form{''BID''} =~ /^(\d+\.?\d*||\.\d+)$/);
&oops(''INC'') unless (($form{''INC''} =~ /^(\d+\.?\d*||\.\d+)$/) && ($form{''INC''} >= .01));
$form{''INC''} = &parsebid($form{''INC''});
$form{''RESERVE''} = &parsebid($form{''RESERVE''});
&oops(''ADDRESS1'') unless ($form{''ADDRESS1''});
&oops(''ADDRESS2'') unless ($form{''ADDRESS2''});
&oops(''ADDRESS3'') unless ($form{''ADDRESS3''});
$form{''ITEM''} = ($form{''DAYS''} * 86400 + time);
$form{''ITEM''} = ($form{''DAYS''} * 86400 + time) until (!(-f "$basepath$form{''CATEGORY''}/$form{''ITEM''}.dat"));
if ($form{''FROMPREVIEW''}) {
foreach $key (keys %form) {
$form{$key} =~ s/\[greaterthansign\]/\>/gs;
$form{$key} =~ s/\[lessthansign\]/\</gs;
$form{$key} =~ s/\[quotes\]/\"/gs;
}
&oops(''ITEM'') unless (open(NEWAUCTION, ">$basepath$form{''CATEGORY''}/$form{''ITEM''}.dat"));
print NEWAUCTION "$form{''TITLE''}\n$form{''RESERVE''}\n$form{''INC''}\n$form{''DESC''}\n$form{''IMAGE''}";
close NEWAUCTION;
print "<H3>$form{''TITLE''} was posted under $category{$form{''CATEGORY''}}...</H3>\n";
$newbidflag=1;
&procbid;
}
else {
&preview;
}
}
##############################################
# Sub: Process Search
# This displays search results
sub procsearch {
print "<H2>Search Results - $form{''searchstring''}</H2>";
print "<TABLE BORDER=1 WIDTH=100\%>\n";
print "<TR BGCOLOR=$colortablehead><TD ALIGN=CENTER><B>Item</B></TD><TD ALIGN=CENTER><B>Closes</B></TD><TD ALIGN=CENTER><B>Num Bids</B></TD><TD ALIGN=CENTER><B>High Bid</B></TD></TR>\n";
foreach $key (sort keys %category) {
opendir THEDIR, "$basepath$key" |||| die "Unable to open directory: $!";
@allfiles = readdir THEDIR;
closedir THEDIR;
foreach $file (sort { int($a) <=> int($b) } @allfiles) {
if (-T "$basepath$key/$file") {
open THEFILE, "$basepath$key/$file";
($title, $reserve, $inc, $desc, $image, @bids) = <THEFILE>;
close THEFILE;
chomp($title, $reserve, $inc, $desc, $image, @bids);
@lastbid = split(/\[\]/,$bids[$#bids]);
$file =~ s/\.dat//;
@closetime = localtime($file);
$closetime[4]++;
if($form{''searchtype''} eq ''keyword'') {
print "<TR BGCOLOR=$colortablebody><TD><A HREF=$ENV{''SCRIPT_NAME''}\?$key\&$file>$key\: $title</TD><TD>$closetime[4]/$closetime[3]</TD><TD>$#bids</TD><TD>\$$lastbid[2]</TD></TR>\n" if (($title =~ /$form{''searchstring''}/i) |||| ($desc =~ /$form{''searchstring''}/i));
}
elsif($form{''searchtype''} eq ''username'') {
$flag=0;
foreach $bid(@bids) {
if (($bid =~ /$form{''searchstring''}/i) && ($flag==0)) {
print "<TR BGCOLOR=$colortablebody><TD><A HREF=$ENV{''SCRIPT_NAME''}\?$key\&$file>$key\: $title</TD><TD>$closetime[4]/$closetime[3]</TD><TD>$#bids</TD><TD>\$$lastbid[2]</TD></TR>\n";
$flag=1;
}
}
}
}
}
}
print "</TABLE>\n";
}
##############################################
# Sub: Change Registration
# This allows a user to change information
sub changereg {
print <<"EOF";
<FORM ACTION=$ENV{''SCRIPT_NAME''} METHOD=POST>
<H2>Change Street Address and/or Password</H2>
<TABLE WIDTH=100% BORDER=1 BGCOLOR=$colortablebody>
<INPUT TYPE=HIDDEN NAME=action VALUE=creg>
<TR><TD COLSPAN=2 VALIGN=TOP> This form will allow you to change your
street address and/or password.
</TD></TR>
<TR><TD VALIGN=TOP><B>Your Handle/Alias:<BR></B>Required for verification</TD><TD><INPUT NAME=ALIAS TYPE=TEXT SIZE=30 MAXLENGTH=30>
<TR><TD VALIGN=TOP><B>Your Current Password:<BR></B>Required for verification</TD><TD><INPUT NAME=OLDPASS TYPE=PASSWORD SIZE=30>
<TR><TD VALIGN=TOP><B>Your New Password:<BR></B>Leave blank if unchanged</TD><TD><INPUT NAME=NEWPASS1 TYPE=PASSWORD SIZE=30>
<TR><TD VALIGN=TOP><B>Your New Password Again:<BR></B>Leave blank if unchanged</TD><TD><INPUT NAME=NEWPASS2 TYPE=PASSWORD SIZE=30>
<TR><TD VALIGN=TOP><B>Contact Information:<BR></B>Leave blank if unchanged</TD><TD>
<TT>Full Name: </TT><BR><INPUT NAME=ADDRESS1 TYPE=TEXT SIZE=30><BR>
<TT>Street Address: </TT><BR><INPUT NAME=ADDRESS2 TYPE=TEXT SIZE=30><BR>
<TT>City, State, ZIP: </TT><BR><INPUT NAME=ADDRESS3 TYPE=TEXT SIZE=30></TD></TR></TABLE>
<CENTER><INPUT TYPE=SUBMIT VALUE="Change Registration"></CENTER>
EOF
}
##############################################
# Sub: Process Changed Registration
# This modifies an account
sub proccreg {
if ($regdir) {
&oops(''ALIAS'') unless ($form{''ALIAS''});
&oops(''OLD PASSWORD'') unless ($form{''OLDPASS''});
if ($form{''ADDRESS1''}) {
&oops(''ADDRESS2'') unless ($form{''ADDRESS2''});
&oops(''ADDRESS3'') unless ($form{''ADDRESS3''});
}
if ($form{''NEWPASS1''}) {
&oops(''NEW PASSWORD VERIFICATION'') unless ($form{''NEWPASS2''} eq $form{''NEWPASS1''});
}
$form{''ALIAS''} =~ s/\W//g;
$form{''ALIAS''} = lc($form{''ALIAS''});
$form{''ALIAS''} = ucfirst($form{''ALIAS''});
if (-f "$basepath$regdir/$form{''ALIAS''}.dat") {
&oops(''ALIAS'') unless (open(REGFILE, "$basepath$regdir/$form{''ALIAS''}.dat"));
($password,$email,$add1,$add2,$add3,@junk) = <REGFILE>;
chomp($password,$email,$add1,$add2,$add3,@junk);
close REGFILE;
&oops(''OLD PASSWORD'') unless ((lc $password) eq (lc $form{''OLDPASS''}));
$form{''NEWPASS1''} = $password if !($form{''NEWPASS1''});
$form{''ADDRESS1''} = $add1 if !($form{''ADDRESS1''});
$form{''ADDRESS2''} = $add2 if !($form{''ADDRESS2''});
$form{''ADDRESS3''} = $add3 if !($form{''ADDRESS3''});
&oops(''ALIAS'') unless (open NEWREG, ">$basepath$regdir/$form{''ALIAS''}.dat");
print NEWREG "$form{''NEWPASS1''}\n$email\n$form{''ADDRESS1''}\n$form{''ADDRESS2''}\n$form{''ADDRESS3''}";
foreach $bid (@junk) {
print NEWREG "\n$bid";
}
close NEWREG;
print "$form{''ALIAS''}, your information has been successfully changed.\n";
}
else {
print "Sorry... That Username is not valid. If you do not have an alias (or cannot remember it) you should create a <A HREF=$ENV{''SCRIPT_NAME''}?1\&1\&u>new account</A>.\n";
}
}
else {
print "User Registration is Not Implemented on This Server! The System Administrator Did Not Specify a Registration Directory...\n";
}
}
##############################################
# Sub: New Registration
# This creates a form for registration
sub newreg {
print <<"EOF";
<FORM ACTION=$ENV{''SCRIPT_NAME''} METHOD=POST>
<H2>New User Registration</H2>
<TABLE WIDTH=100% BORDER=1 BGCOLOR=$colortablebody>
<INPUT TYPE=HIDDEN NAME=action VALUE=reg>
<TR><TD COLSPAN=2 VALIGN=TOP>This form will allow you to register to buy or sell
auction items. You must enter accurate data, and your new password will be e-mailed
to you. Please be patient after hitting the submit button. Registration may take
a few seconds.</TD></TR>
<TR><TD VALIGN=TOP><B>Your Handle/Alias:<BR></B>Used to track your post</TD><TD><INPUT NAME=ALIAS TYPE=TEXT SIZE=30 MAXLENGTH=30>
<TR><TD VALIGN=TOP><B>Your E-Mail Address:<BR></B>Must be valid</TD><TD><INPUT NAME=EMAIL TYPE=TEXT SIZE=30>
<TR><TD VALIGN=TOP><B>Contact Information:<BR></B>Will be given out only to the buyer or seller</TD><TD>
<TT>Full Name: </TT><BR><INPUT NAME=ADDRESS1 TYPE=TEXT SIZE=30><BR>
<TT>Street Address: </TT><BR><INPUT NAME=ADDRESS2 TYPE=TEXT SIZE=30><BR>
<TT>City, State, ZIP: </TT><BR><INPUT NAME=ADDRESS3 TYPE=TEXT SIZE=30></TD></TR></TABLE>
<CENTER><INPUT TYPE=SUBMIT VALUE="Register Me"></CENTER>
EOF
}
##############################################
# Sub: Process Registration
# This adds new accounts to the database
sub procreg {
if ($regdir) {
umask(000); # UNIX file permission junk
mkdir("$basepath$regdir", 0777) unless (-d "$basepath$regdir");
&oops(''ALIAS'') unless ($form{''ALIAS''});
&oops(''EMAIL'') unless ($form{''EMAIL''} =~ /.+\@.+/);
&oops(''ADDRESS1'') unless ($form{''ADDRESS1''});
&oops(''ADDRESS2'') unless ($form{''ADDRESS2''});
&oops(''ADDRESS3'') unless ($form{''ADDRESS3''});
$form{''ALIAS''} =~ s/\W//g;
$form{''ALIAS''} = lc($form{''ALIAS''});
$form{''ALIAS''} = ucfirst($form{''ALIAS''});
if (!(-f "$basepath$regdir/$form{''ALIAS''}.dat")) {
&oops(''NEWREG'') unless (open NEWREG, ">$basepath$regdir/$form{''ALIAS''}.dat");
$newpass = &randompass;
print NEWREG "$newpass\n$form{''EMAIL''}\n$form{''ADDRESS1''}\n$form{''ADDRESS2''}\n$form{''ADDRESS3''}";
close NEWREG;
print "$form{''ALIAS''}, you should receive an e-mail to $form{''EMAIL''} in a few minutes. It will contain your password needed to post or bid. You may change your password once you receive it. If you do not get an e-mail, please re-register.\n";
&sendemail($form{''EMAIL''}, ''Auction Password'', ''nobody'', $mailserver, "PLEASE DO NOT REPLY TO THIS E-MAIL.\n\nThank you for registering to use our auction!\n\nYour new password is: $newpass\nYour alias (as you entered it) is: $form{''ALIAS''}\n\nThank you for visiting!");
}
else {
print "Sorry... that alias is taken. Hit back to try again!\n";
}
}
else {
print "User Registration is Not Implemented on This Server! The System Administrator Did Not Specify a Registration Directory...\n";
}
}
##############################################
# Sub: Random Password
# This generates psudo-random 8-letter
# passwords
sub randompass {
srand(time ^ $$);
@passset = (''a''..''k'', ''m''..''n'', ''p''..''z'', ''2''..''9'');
$randpass = "";
for ($i = 0; $i < 8; $i++) {
$randum_num = int(rand($#passset + 1));
$randpass .= $passset[$randum_num];
}
return $randpass;
}
##############################################
# Sub: parse bid
# This formats a bid amount to look good...
# ie. $###.##
sub parsebid {
$_[0] =~ s/\,//g;
@bidamt = split(/\./, $_[0]);
$bidamt[0] = "0" if (!($bidamt[0]));
$bidamt[0] = int($bidamt[0]);
$bidamt[1] = substr($bidamt[1], 0, 2);
$bidamt[1] = "00" if (length($bidamt[1]) == 0);
$bidamt[1] = "$bidamt[1]0" if (length($bidamt[1]) == 1);
return "$bidamt[0].$bidamt[1]";
}
##############################################
# Sub: Oops!
# This generates an error message and dies.
sub oops {
print "Something is wrong with the $_[0] field. Hit back to try again!\n";
die "Something is wrong with the $_[0] field. Hit back to try again!\n";
}
##############################################
# Sub: Movefile(file1, file2)
# This moves a file. Quick and dirty!
sub movefile {
($firstfile, $secondfile) = @_;
return 0 unless open(FIRSTFILE,$firstfile);
@lines=<FIRSTFILE>;
close FIRSTFILE;
return 0 unless open(SECONDFILE,">$secondfile");
foreach $line (@lines) {
print SECONDFILE $line;
}
close SECONDFILE;
return 0 unless unlink($firstfile);
return 1;
}
##############################################
# SUB: Send E-mail
# This is a real quick-and-dirty mailer that
# should work on any platform. It is my first
# attempt to work with sockets, so if anyone
# has any suggestions, let me know!
#
# Takes:
# (To, Subject, Reply-To, IP ADDRESS of SMTP host, Message)
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=<S>;
print S "HELO ${SERVERNAME}\n";
$a=<S>;
print S "MAIL FROM:<SMTPMAIL>\n";
$a=<S>;
print S "RCPT TO:<$TO[0]>\n";
$a=<S>;
if ($#TO > 0) { foreach (1..$#TO) { print S "RCPT TO: $TO[$_]\n";$a=<S>; }
}
print S "DATA \n";
$a=<S>;
print S "To: $TO[0]\n";
if ($#TO > 0) { foreach (1..$#TO) { print S "Cc: $TO[$_]\n"; }
}
print S "Subject: $SUBJECT\n";
print S "Reply-To: $REPLYTO\n";
# Print the body
print S "$THEMESSAGE\n";
print S ".\n";
$a=<S>;
print S "QUIT";
close (S);
}
##############################################
# Sub: Get Form Data
# This gets data from a post.
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: Closed items
# This displays closed items
sub viewclosed {
print <<"EOF";
<FORM ACTION=$ENV{''SCRIPT_NAME''} METHOD=POST>
<H2>View Closed Items</H2>
<TABLE WIDTH=100% BORDER=1 BGCOLOR=$colortablebody>
<INPUT TYPE=HIDDEN NAME=action VALUE=closeditems1>
<TR><TD COLSPAN=2 VALIGN=TOP> This form will allow you to view the
status and contact information for closed auction items you bid on or listed for auction.
</TD></TR>
<TR><TD VALIGN=TOP><B>Your Username:<BR></B>Required for verification</TD><TD><INPUT NAME=ALIAS TYPE=TEXT SIZE=30 MAXLENGTH=30>
<TR><TD VALIGN=TOP><B>Your Password:<BR></B>Required for verification</TD><TD><INPUT NAME=PASSWORD TYPE=PASSWORD SIZE=30>
</TD></TR></TABLE>
<CENTER><INPUT TYPE=SUBMIT VALUE="View Closed Items"></CENTER>
EOF
}
##############################################
# Sub: Closed items 1
# This displays closed items
sub viewclosed1 {
$form{''ALIAS''} =~ s/\W//g;
$form{''ALIAS''} = lc($form{''ALIAS''});
$form{''ALIAS''} = ucfirst($form{''ALIAS''});
&oops(''ALIAS'') unless (open(REGFILE, "$basepath$regdir/$form{''ALIAS''}.dat"));
($password,$email,$add1,$add2,$add3,@junk) = <REGFILE>;
chomp($password,$email,$add1,$add2,$add3,@junk);
close REGFILE;
&oops(''PASSWORD'') unless ((lc $password) eq (lc $form{''PASSWORD''}));
print "<FORM METHOD=POST ACTION=\"$ENV{''SCRIPT_NAME''}\">\n";
print "<INPUT TYPE=HIDDEN NAME=action VALUE=closeditems2><INPUT TYPE=HIDDEN NAME=ALIAS VALUE=\"$form{''ALIAS''}\"><SELECT NAME=bidtoview>\n";
foreach $bid(@junk) {
if (-T "$basepath$closedir/$bid.dat") {
open THEFILE, "$basepath$closedir/$bid.dat";
($title, $reserve, $inc, $desc, $image, @bids) = <THEFILE>;
close THEFILE;
chomp($title, $reserve, $inc, $desc, $image, @bids);
print "<OPTION VALUE=\"$bid\">$bid: $title</OPTION>\n";
}
}
print "</SELECT><BR><INPUT TYPE=SUBMIT VALUE=\"View My Status\"></FORM>\n";
}
##############################################
# Sub: Closed items 2
# This displays closed items
sub viewclosed2 {
$form{''bidtoview''} =~ s/\W//g;
open (THEFILE, "$basepath$closedir/$form{''bidtoview''}.dat") or &oops(''ITEM'');
($title, $reserve, $inc, $desc, $image, @bids) = <THEFILE>;
close THEFILE;
chomp($title, $reserve, $inc, $desc, $image, @bids);
@firstbid = split(/\[\]/,$bids[0]);
@lastbid = split(/\[\]/,$bids[$#bids]);
print "<H2>$title</H2>\n";
print "<HR><FONT SIZE=+1><B>Description</B></FONT><HR>$desc</FONT></FONT></B></I></U></H1></H2></H3></H4></H5>";
print "<HR><FONT SIZE=+1><B>Bid History</B></FONT><HR>\n";
print "<FONT SIZE=-1><B>START:</B></FONT> ";
foreach $bid (@bids) {
@thebid = split(/\[\]/,$bid);
$bidtime = localtime($thebid[3]);
print "<FONT SIZE=-1>$thebid[0] \($bidtime\) - \$$thebid[2]</FONT><BR>\n";
}
print "<P>Reserve was: \$$reserve<BR>\n";
print "<HR><FONT SIZE=+1><B>Contact Information</B></FONT><HR>\n";
if ($form{''ALIAS''} eq $firstbid[0]) {
print "You were the seller...<P>\n";
print "<B>Buyer Information:</B><BR><I>Alias</I>: $lastbid[0]<BR><I>E-Mail</I>: $lastbid[1]<BR><I>Address</I>: $lastbid[4]<BR>$lastbid[5]<BR>$lastbid[6]<P><B>High Bid:</B> \$$lastbid[2]\n";
print "<P><B>Unsuccessful Bid Contacts:</B><BR>\n";
foreach $bid (@bids) {
@thebid = split(/\[\]/,$bid);
print "<FONT SIZE=-1>$thebid[0] - <A HREF=\"mailto:$thebid[1]\">$thebid[1]</A></FONT><BR>\n";
}
print "<FORM ACTION=$ENV{''SCRIPT_NAME''} METHOD=POST>You may repost this item if you want to: <INPUT TYPE=SUBMIT VALUE=\"Repost\"><INPUT TYPE=HIDDEN NAME=action VALUE=\"repost\"><INPUT TYPE=HIDDEN NAME=REPOST VALUE=\"$form{''bidtoview''}\"></FORM>\n";
}
elsif ($form{''ALIAS''} eq $lastbid[0]) {
print "You were a high bidder...<P>\n";
print "<B>Seller Information:</B><BR><I>Alias</I>: $firstbid[0]<BR><I>E-Mail</I>: $firstbid[1]<BR><I>Address</I>: $firstbid[4]<BR>$firstbid[5]<BR>$firstbid[6]<P><B>Your High Bid:</B> \$$lastbid[2]<P>\n";
print "<I>Remember, the seller is not required to sell unless your bid price was above the reserve price...</I>";
}
else {
print "You were not a winner... No further contact information is available.\n";
}
}
##############################################
# Sub: File Lock
# This locks files when bidding takes place
sub filelock {
flock (NEWITEM, 2);
seek(NEWITEM, 0, 2);
}
Mit problem er at jeg ikke kan få auktionen til at sende e-mail tilbage. Ip''en på smtpserver er: 195.24.14.134. Jeg har også et mndul så man skulle kunne få Blat til at virke:
##########################################
# This must be the valid IP ADDRESS of an
# SMTP server. It is used to mail auction
# notifications. If the e-mail system is
# not working, this is what you should
# check first.
$mailserver = "123.45.678.91";
####End OF Config Section stuff#####
##############################################
# SUB: Send E-mail
sub sendemail {
$TO=$_[0];
$SUBJECT=$_[1];
$REPLYTO="Auction\@myAuction.Com"; # put your e-mail here.
$BLATPATH = "Blat ";
do {
$tempfile = int(rand(99999999)) . ".bla";
} until !(-e $tempfile);
# print message to temporary file and message log
open(OUTPUT, ">c:/MyAuction/temp/$tempfile") |||| #need to create a new folder for temp file.
&error("Error writing to temporary file $tempfile");
print OUTPUT "$_[4]";
close OUTPUT;
$commandline = $BLATPATH;
$commandline .= "c:/MyAuction/temp/$tempfile "; # the temp file
$commandline .= "-s \"$_[1]\" " if $SUBJECT;
$commandline .= "-t $TO " if $TO;
$commandline .= "-f $REPLYTO " if $REPLYTO;
system ($commandline);
opendir(DIR,"c:/MyAuction/temp") |||| die "Can''t open dir: $!\n";
chdir("c:/MyAuction/temp");
unlink($tempfile);
closedir(DIR);
}
Jeg har prøvet at sætte denne koden ind i scriptet med det vil stadig ikke send mail. Auktion kommer fra www.everysoft.com.
