#!/usr/bin/perl -- use vars qw(%config %category %form %supercat); BEGIN { open (STDERR, ">http://www.domainregistry.de/cgi-bin/data/error.txt"); } #use strict; #-########################################################################### # # In accordance with the GPL, this copyright notice MUST remain intact: # # EveryAuction Release Version 1.53 (2/17/02) # Copyright (C) 2000-2002 EverySoft # Registered with the United States Copyright Office, TX5-186-526 # http://www.everysoft.com/ # #-########################################################################### # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # #-########################################################################### # # Modification Log (please add new entries to bottom): # # * 02/2000 # Matt Hahnfeld (matth@everysoft.com) - Original Concept and Design # Version available from http://www.everysoft.com/ # # * MM/YYYY # Name (email) - Modification # Availability # #-########################################################################### #-############################################# # Configuration Section # Edit these variables! local %config; # The Base Directory. We need an # absolute path for the base directory. # Include the trailing slash. THIS SHOULD # NOT BE WEB-ACCESSIBLE! $config{'basepath'} = 'http://www.domainregistry.de/cgi-bin/data/'; # 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. $config{'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. $config{'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', #); %supercat = ( AN => 'Antiques & Collectibles', AR => 'Art', AU => 'Autos', BO => 'Books', BU => 'Business & Industrial', CL => 'Clothing & Accessories', COM => 'Computers', CON => 'Consumer Electronics', HO => 'Home & Garden', EN => 'Entertainment & Leisure', RE => 'Real Estate', TO => 'Toys & Hobbies', EE => 'Everything Else', ); %category = ( anar => 'Antique Art', anfu => 'Antique Furniture', ante => 'Antique Textiles', anot => 'Other Antiques', anco => 'Collectibles', ancn => 'Coins', anst => 'Stamps', arpai => 'Paintings', arpr => 'Prints', arpo => 'Posters', arsc => 'Sculpture', arot => 'Other', arpot => 'Pottery', argl => 'Glass', bofi => 'Fiction', bono => 'Non-Fiction', boch => 'Childrens', boma => 'Magazines', boan => 'Antiques', buag => 'Agriculture', bufs => 'Businesses For Sale', buwh => 'Wholesale', bure => 'Retail', bueq => 'Equipment', burs => 'Restaurant', clmn => 'Mens', clwo => 'Womens', clbo => 'Boys', clgl => 'Girls', clac => 'Accessories', clje => 'Jewelry', compc => 'PCs', comso => 'Software', comha => 'Hardware', compe => 'Peripherals', comno => 'Notebooks', comap => 'Apple', comse => 'Services', comdo => 'Domain Names', contv => 'Televisions', conki => 'Kitchen Appliances', convi => 'Video', conau => 'Audio', conga => 'Gaming', congd => 'Gadgets', todo => 'Dolls', tobe => 'Bears', toac => 'Action Figures', toel => 'Electronic', toga => 'Games', tocr => 'Crafts', hobe => 'Bed', hoba => 'Bath', hola => 'Lawn', hoho => 'Home Decor', hoki => 'Kitchen', hofu => 'Furniture', hope => 'Pet Supplies', enmo => 'Movies', entv => 'Television', enmu => 'Music', enin => 'Instruments', enti => 'Tickets', entr => 'Travel', ensp => 'Sports', enme => 'Memorabilia', reho => 'Homes', rela => 'Land', reco => 'Commercial', reti => 'Time Shares', reap => 'Apartments', auca => 'Cars', autr => 'Trucks', aumo => 'Motorcycles', auva => 'Vans', aupa => 'Parts', auac => 'Accessories', ee => 'Everything Else', ); # This is the password for deleting auction # items. $config{'adminpass'} = '060756'; # You need to assign either a mail program or # a mail host so confirmation e-mails can # be sent out. # Leave one commented and one uncommented. # # YOU NEED EITHER A MAIL PROGRAM $config{'mailprog'} = '/usr/sbin/sendmail -t'; # # OR YOU NEED A MAIL HOST (SMTP) #$config{'mailhost'} = 'localhost'; # This line should be your e-mail address $config{'admin_address'} = 'secura@web.de'; # 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. $config{'scripturl'} = 'www.domainregistry.de'; # 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. $config{'colortablehead'} = '#FFFFCC'; $config{'colortablebody'} = '#CCCCCC'; $config{'fcolortablehead'} = '#FFFFCC'; #Attention Grabbers my $grabber1 = ""; my $grabber2 = ""; my $grabber3 = ""; my $grabber4 = ""; my $grabber5 = ""; # Site Name (will appear at the top of each page) $config{'sitename'} = 'domainregistry.de'; # You can configure your own header which will # be appended to the top of each page. $config{'header'} =<<"EOF"; Domain Auction Auctions
  Domain Auction
www.domainregistry.de
USER NAME
PASSWORD
Welcome To Domain Auction

EOF # You can configure your own footer which will # be appended to the bottom of each page. # Although not required, a link back to # everysoft.com will help to support future # development. $config{'footer'} =<<"EOF";

Domain Auction 2003 All Rights Reserved.
EOF # Sniper Protection... How many minutes # past last bid to hold auction. If auctions # should close at exactly closing time, set # to zero. $config{'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. $config{'flock'} = 1; # User Posting Enabled- 1=yes 0=no $config{'newokay'} = 1; # Allow Seller To... # 0 = Set the Buy-it Now Price at any price. # 1 = Set the Buy-it Now Price at or below the Reserve Price. # 2 = Set the Buy-it Now Price at or above the Reserve Price. $config{'buynow'} = 0; # Feedback icons configuration # You need to find (5) icons and edit the paths below. $config{'i1'} = "http://www.domainregistry.de/cgi-bin/images/staryellow.gif"; # 10 - 50 rating icon $config{'i2'} = "http://www.domainregistry.de/cgi-bin/images/starteal.gif"; # 51 - 100 rating icon $config{'i3'} = "http://www.domainregistry.de/cgi-bin/images/starpurple.gif"; # 101 - 500 rating icon $config{'i4'} = "http://www.domainregistry.de/cgi-bin/images/starred.gif"; # 501 - 1000 rating icon $config{'i5'} = "http://www.domainregistry.de/cgi-bin/images/starflying.gif"; # 1001 plus rating icon # Alternating Row Colors $config{'colorevenrow'} = 'F8F8E7'; $config{'coloroddrow'} = 'FFFFFF'; # Name of directory to store feedback $config{'feeddir'} = 'feedback'; # Number of feedbacks to show before a pagebreak $config{'feedbreak'} = 25; # Do you want to provide an email link when the username is displayed # yes = 1 no = 0 $config{'linkemail'} = 0; # # Do you want email to be sent to Users when feedback has been lefton them # yes = 1 no = 0 $config{'emailfeed'} = 1; $config{'bold_charge'} = '3.00'; # do not use a minus sign $config{'bold_charge2'} = '-3.00'; # use a minus sign before the number $config{'featured_charge'} = '20.00'; # do not use a minus sign $config{'featured_charge2'} = '-20.00'; # use a minus sign before the number $config{'grabber_charge'} = '20.00'; # do not use a minus sign $config{'grabber_charge2'} = '-20.00'; # use a minus sign before the number ######################## # Dutch Setup $config{'nodutch'} = 'no'; $config{'godutch'} = 'yes'; # path of your Dutch icon image $config{'dutchiconpath'} = ""; ############# # $config{'hotnum'} = 5; #-#$config{'nothot'} = 0; $config{'goinghours'} = 3; $config{'newdays'} = 1; $config{'watchdir'} = 'watchitems'; # How many columns for main categories/subcategories? $config{maincatcols} = 3; $config{subcatcols} = 2; # Define an icon for categories with/without sub categories, leave blank if none. $config{supercaticon} = ''; $config{regularcaticon} = ''; $config{'highbiddericon'} = "[HB]"; # you can use and image or whatever #-############################################# # Main Program # You do not need to edit anything below this # line. require "accountea.pl"; #-############################################# # Print The Page Header # print "Content-type: text/html\n\n"; print $config{'header'}; # #-############################################# local %form = &get_form_data; if ($form{'action'} eq 'new') { &new; } elsif ($form{'action'} eq 'ask') { &ask; } #-############################################# # AccountEA. By Stuart Jones. # elsif ($form{'action'} eq 'account_login') { &account_login; } elsif ($form{'action'} eq 'account_view') { &account_view; } elsif ($form{'action'} eq 'account_admin') { &account_admin; } elsif ($form{'action'} eq 'view_admin') { &view_admin; } elsif ($form{'action'} eq 'user_credit') { &user_credit; } elsif ($form{'action'} eq 'procpostal') { &procpostal; } elsif ($form{'action'} eq 'postal_login') { &postal_login; } elsif ($form{'action'} eq 'paypal_login') { &postal_login("paypal"); } # #-############################################# elsif ($form{'action'} eq 'repost') { &new; } elsif ($form{'action'} eq 'procnew') { &procnew; } elsif ($form{'action'} eq 'procbid') { &procbid; } elsif ($form{'action'} eq 'procdutchbid') { &procdutchbid; } # Dutch Bidding #elsif ($form{'action'} eq 'reg') { ® } elsif ($form{'action'} eq 'reg') { &user; } elsif ($form{'action'} eq 'usr') { ® } elsif ($form{'action'} eq 'procreg') { &procreg; } elsif ($form{'action'} eq 'creg') { &creg; } elsif ($form{'action'} eq 'proccreg') { &proccreg; } elsif ($form{'action'} eq 'closed') { &viewclosed1; } elsif ($form{'action'} eq 'closed2') { &viewclosed2; } elsif ($form{'action'} eq 'closed3') { &viewclosed3; } elsif ($form{'action'} eq 'admin') { &admin; } elsif ($form{'action'} eq 'procadmin') { &procadmin; } elsif ($form{'action'} eq 'search') { &procsearch; } elsif ($form{'action'} eq 'buynow') { &dispform1; } # Display Buy-it Now Form elsif ($form{'action'} eq 'procform1') { &procform1; } # Process Buy-it Now Form elsif ($form{'action'} eq 'allbuynow') { &allbuynow; } # Display All Buy-it Now Items elsif ($form{'item'} eq int($form{'item'}) and $category{$form{'category'}}) { &dispitem; } elsif ($category{$form{'category'}}) { &displist; } #------Feedback Addon---------------------------------------------------------# elsif ($form{'action'} eq 'viewfeed') { &viewfeed; } elsif ($form{'action'} eq 'leavefeed') { require "feedback.pl"; &leavefeed(); } elsif ($form{'action'} eq 'leavefeed1') { require "feedback.pl"; &leavefeed1(); } elsif ($form{'action'} eq 'feederadd') { require "feedback.pl"; &feederadd(); } elsif ($form{'action'} eq 'proc_feeder') { require "feedback.pl"; &proc_feeder(); } elsif ($form{'action'} eq 'view_feed_closed') { &view_feed_closed; } elsif ($form{'action'} eq 'adminfeed') { require "feedback.pl"; &adminfeed(); } elsif ($form{'action'} eq 'admin_delfeed') { require "feedback.pl"; &admin_delfeed(); } elsif ($form{'action'} eq 'delete_allfeed') { require "feedback.pl"; &delete_allfeed(); } elsif ($form{'action'} eq 'search_feedback') { &search_feedback; } elsif ($form{'action'} eq 'search_feedback2') { &search_feedback2; } #------End Feedback Addon-----------------------------------------------------# elsif ($form{'action'} eq 'emailusers') { &emailusers; } elsif ($form{'action'} eq 'emailusersadmin') { &emailusersadmin; } elsif ($form{'action'} eq 'forgot') { &forgot; } elsif ($form{'action'} eq 'forgot2') { &forgot2; } elsif ($category{$form{'category'}} and $form{'listtype'} eq 'current') { &displist; } elsif ($category{$form{'category'}} and $form{'listtype'} eq 'new') { &displistnew; } elsif ($category{$form{'category'}} and $form{'listtype'} eq 'hot') { &displisthot; } elsif ($category{$form{'category'}} and $form{'listtype'} eq 'gone') { &displistgone; } elsif ($category{$form{'category'}} and $form{'listtype'} eq 'close') { &displistclose; } #-#elsif ($category{$form{'category'}} and $form{'listtype'} eq 'nothot') { &displistnothot; } elsif ($form{'action'} eq 'watch_login') {require "watch.cgi"; &watch_login;} elsif ($form{'action'} eq 'watchitems') {require "watch.cgi"; &watchitems;} elsif ($form{'action'} eq 'see_watched') {require "watch.cgi"; &see_watched;} elsif ($form{'action'} eq 'add_watch') {require "watch.cgi"; &add_watch;} elsif ($form{'action'} eq 'remove_watch') {require "watch.cgi"; &remove_watch;} elsif ($form{'action'} eq 'proc_remove_watch') {require "watch.cgi"; &proc_remove_watch;} elsif ($form{'action'} eq 'search1') {require "search.cgi"; &start_search; } elsif ($form{'action'} eq 'search') {require "search.cgi"; &procsearch; } elsif ($form{'action'} eq 'ma') { &myad; } #login to View my ads elsif ($form{'action'} eq 'bids') { &mybids; } #View my bids else { &dispcat; } #-############################################# # Print The Page Footer # print $config{'footer'}; # #-############################################# #-############################################# # Sub: Display List Of Categories # This creates a "nice" list of categories. sub dispcat { # Outcomment the following line to disable supercat summary pages if($form{category} =~ /:([^:]*)$/){ &dispsupercat; return; } print( "

Auction Categories

" ); my $catinfo="";$catinfo=~s/\:/-->//g; umask(000); my($key, %numfiles, %mycategory, %caticon); foreach $key (keys %category) { next if $category{$key}!~/^\Q$catinfo\E/; opendir(THEDIR, "$config{'basepath'}$key") || mkdir("$config{'basepath'}$key", 0777) || &oops("Category directory $key could not be opened."); readdir THEDIR;readdir THEDIR; my @allfiles = readdir THEDIR; closedir THEDIR; if($category{$key} =~ /^\Q$catinfo\E/ && $supercat{$1} ne ''){ $mycategory{"$form{category}:$1"} = $supercat{$1}; $numfiles{"$form{category}:$1"} += @allfiles; $caticon{"$form{category}:$1"} = $config{supercaticon}; }else{ $mycategory{$key} = $category{$key}; $numfiles{$key} += @allfiles; $caticon{$key} = $config{regularcaticon}; } } my $cols = $config{maincatcols} || 2; my $pc = int(100/$cols); # Print Table Header with $cols Columns print ( "", "", "", "", ); # Print $cols Columns my @keys = sort {lc $mycategory{$a} cmp lc $mycategory{$b}} keys %mycategory; my $definedkeys = $#keys + $cols-(($#keys+1)%$cols); my $cmove = int(@keys/$cols); $cmove++ if (@keys%$cols); for(my $i = 0;$i<=$cmove-1;$i++) { print "\n"; my $j = $i; for(1..$cols){ my $key=$keys[$j]; if($key ne ''){ print( # Print A Category "\n", ); }else{ print( # Print Padding (Empty Cells) "", ); } $j+=$cmove; } print "\n"; } # Print End of Table print "
Auction Categories
", "$caticon{$key} $mycategory{$key}", " ($numfiles{$key})", " 
"; } #-############################################# # Sub: Supercat Summary Page # Display categories and items in a supercat sub dispsupercat { my $catinfo="";$catinfo=~s/\:/-->//g; $form{category} =~ /:([^:]*)$/; my $supercat = $1; print <Auction Categories EOF umask(000); my($key, %numfiles, %mycategory, %caticon, @sumfiles); foreach $key (keys %category) { next if $category{$key}!~/^\Q$catinfo\E/; if(!-d "$config{'basepath'}$key"){ mkdir("$config{'basepath'}$key", 0777) } opendir(THEDIR, "$config{'basepath'}$key") || &oops("Category directory $key could not be opened."); readdir THEDIR;readdir THEDIR; my @allfiles = readdir THEDIR; closedir THEDIR; push(@sumfiles, map {[$key, $_]} @allfiles); if($category{$key} =~ /^\Q$catinfo\E/ && $supercat{$1} ne ''){ $mycategory{"$form{category}:$1"} = $supercat{$1}; $numfiles{"$form{category}:$1"} += @allfiles; $caticon{"$form{category}:$1"} = $config{supercaticon}; }else{ $mycategory{$key} = $category{$key}; $numfiles{$key} += @allfiles; $caticon{$key} = $config{regularcaticon}; } } my $cols = $config{subcatcols} || 3; my $pc = int(100/$cols); # Print Table Header with $cols Columns print ( "", "", "", "", ); # Print $cols Columns my @keys = sort {lc $mycategory{$a} cmp lc $mycategory{$b}} keys %mycategory; my $definedkeys = $#keys + $cols-(($#keys+1)%$cols); my $cmove = int(@keys/$cols); $cmove++ if (@keys%$cols); for(my $i = 0;$i<=$cmove-1;$i++) { print "\n"; my $j = $i; for(1..$cols){ my $key=$keys[$j]; if($key ne ''){ print( # Print A Category "\n", ); }else{ print( # Print Padding (Empty Cells) "", ); } $j+=$cmove; } print "\n"; } # Print End of Table print "
Sub Categories
", "$caticon{$key} $mycategory{$key}", " ($numfiles{$key})", " 
"; # Display Item Summary print ( "

$supercat{$supercat}

", "", "", "", "", "", "", "", ); my $pagebreak; my ($icount, $pcount) = (0,0); # Remove the # in the following line to enable pagebreaks (requires pagebreak 1.3 addon) $pagebreak = int $form{pb} || 15; foreach ( sort { int($a->[1]) <=> int($b->[1]) } @sumfiles) { if(++$icount > $pagebreak){$icount=1; $pcount++} next if $pcount != $form{page} && $pagebreak; my $category = $_->[0]; my $file = $_->[1]; $file =~ s/\.dat$//; my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($category,$file); my $grabberpic = ""; $grabberpic = $grabber1 if ($grabber eq 'grabber01'); $grabberpic = $grabber2 if ($grabber eq 'grabber02'); $grabberpic = $grabber3 if ($grabber eq 'grabber03'); $grabberpic = $grabber4 if ($grabber eq 'grabber04'); $grabberpic = $grabber5 if ($grabber eq 'grabber05'); my $boldl = "" if ($bold eq "BOLDON"); my $boldr = "" if ($bold eq "BOLDON"); if ($title ne '') { my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); $bid=parsebid($bid); my @closetime = localtime($file); $closetime[4]++; $image = "[PIC]" if $image ne ''; print ( "", "", "", "", "", "", ); } } print "
ItemClosesNum BidsHigh Bid
$boldl$title$boldr$grabberpic $image$closetime[4]/$closetime[3]$#bids\$$bid
"; pagebreak($pcount,$pagebreak) if $pagebreak; } #-############################################# # Sub: Display List Of Items # This creates a "nice" list of items in a # category. sub displist { &dispfeatured; my $key; my $file; opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("Category directory $form{'category'} could not be opened."); readdir THEDIR;readdir THEDIR; my $numfiles = scalar @{[readdir THEDIR]}; closedir THEDIR; print "

$category{$form{'category'}} \n"; print "NEW | "; print "What's HOT | "; #-# print "What's NOT | "; print "Closing Today | "; print "Going, Going, GONE | "; print "

"; print "
Sort by:  Items ending first  |  Newly-listed first  |  Lowest prices first  |  Highest prices first
" if $numfiles > 0; print "
There are no items in this category.

" if $numfiles == 0; print "\n"; print "\n"; opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("Category directory $form{'category'} could not be opened."); my @sortedfiles = &sort_items; closedir THEDIR; my $pagebreak = int $form{pb} || 15; my ($icount, $pcount) = (0,0); foreach $file (@sortedfiles) { if(++$icount > $pagebreak){$icount=1; $pcount++} next if $pcount != $form{page}; $file =~ s/^$config{'basepath'}$form{'category'}\///; $file =~ s/\.dat$//; my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$file); my $grabberpic = ""; $grabberpic = $grabber1 if ($grabber eq 'grabber01'); $grabberpic = $grabber2 if ($grabber eq 'grabber02'); $grabberpic = $grabber3 if ($grabber eq 'grabber03'); $grabberpic = $grabber4 if ($grabber eq 'grabber04'); $grabberpic = $grabber5 if ($grabber eq 'grabber05'); my $bidnum = "No Bids Yet" if ($#bids <= 0); $bidnum = $#bids if ($#bids > 0); if ($title ne '') { my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); my @closetime = localtime($file); $closetime[4]++; my $boldl = "" if ($bold eq "BOLDON"); my $boldr = "" if ($bold eq "BOLDON"); $bid=parsebid($bid); print "\n"; } } print "
ItemClosesBidsHigh Bid
$boldl $title$boldr $grabberpic"; print " [PIC]" if ($image); print "$closetime[4]/$closetime[3]$bidnum\$$bid

\n"; pagebreak($pcount,$pagebreak); } #-############################################# # Sub: Display Item # This displays a particular item, its # description, and its associated bids. sub dispitem { my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$form{'item'}); my $sellerfeed = &get_feed_info($alias); &oops("Item $form{'item'} could not be opened. If this item is closed, you can view statistics and bid history using our closed item viewer.") if $title eq ''; my $nowtime = localtime(time); my $closetime = localtime($form{'item'}); my $html_description = &strip_scripts(&enable_html($desc)); print "

$title

Information
\n"; print ""; print "" if ($image); print "\n"; print "
Add   Item \# $form{'item'} To My.... Watch List!

"; print ""; print "
"; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); # read last bid print "Last Bid: \$$bid "; print ""; print ""; print ""; print "(reserve price not yet met)" if ($bid < $reserve); print "(reserve price met)" if (($bid >= $reserve) and ($reserve > 0)); print "
$title
Category: $category{$form{'category'}}
"; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[0]); # read first bid print "Offered By: $alias
[View Sellers Feedback]
Dutch: $dutch
Quantity: $qty
Sold Quantity: $soldqty
"; print ""; print ""; print ""; print " " if $pay0 ne "" ; print " " if $pay1 ne "" ; print " " if $pay2 ne "" ; print " " if $pay3 ne "" ; print " " if $pay4 ne "" ; print " " if $pay5 ne "" ; print " " if $pay6 ne "" ; print " " if $pay7 ne "" ; print " " if $pay8 ne "" ; print "
  Shipping Method
  $ship
  Payment Options
  $pay0
  $pay1
  $pay2
  $pay3
  $pay4
  $pay5
  $pay6
  $pay7
  $pay8
Ask the seller a question about this item
Questions and answers will be posted below

"; print "
"; print ""; print ""; print ""; print "Username
"; print "Password
"; print ""; print ""; print "Your Question:

"; print "
"; if (-e("$config{'basepath'}ask/$form{'category'}:$form{'item'}.txt")) { print "Previous Questions and answers

"; open FILE, "$config{'basepath'}ask/$form{'category'}:$form{'item'}.txt"; my (@data) = ; close FILE; my $line; foreach $line(@data) { print "$line\n"; } } print "
\n"; print "
Description
"; print "" if ($image); print "
$html_description"; print "
Bid History
\n"; my $lowest_new_bid; if ($#bids) { for (my $i=1; $i$alias \($bidtime\) - \$$bid
"; my $bidderfeed = &get_feed_info($alias); #print "$bidderfeed \($bidtime\) - \$$bid
"; ###### Dutch if ($dutch eq $config{'nodutch'}){ print "$bidderfeed \($bidtime\) - \$$bid
"; } else { if ($dutch eq $config{'godutch'}){ print "$bidderfeed \($bidtime\) - \$$bid X (Quantity: $oqty)
"; } $lowest_new_bid = &parsebid($bid+$inc); } } } ######## End Dutch else { print "No bids yet...
"; $lowest_new_bid = (&read_bid($bids[0]))[2]; } # either the item is closed or we will display a bid form my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); # read the last bid if ((time > int($form{'item'})) && (time > (60 * $config{'aftermin'} + $time))) { print "BIDDING IS NOW CLOSED
"; &closeit($form{'category'},$form{'item'}); } else { print "
Buy Now
Buy-it Now: \$$buyit

Buy-it Now is a option for the purchase of lots on $config{'sitename'}. Use Buy-it Now to meet the seller\'s set price immediately, pre-empting the auction of an item and beginning the billing and shipping process right away.

Look for the Buy-it Now anytime you view lots on the site. Once you click the link, you will have a chance to confirm your purchase before it is finalized.

Buy Now" if (($buyit > 0) && ($bids[0]) eq ($bids[$#bids])); ############################ ##### Normal Bid Form if ($dutch eq $config{'nodutch'}){ my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$form{'item'}); my $nowtime = localtime(time); my $closetime = localtime($form{'item'}); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); # read the last bid my $lowest_new_bid; my $lowest_new_bid; my $bidtime = localtime($time); $lowest_new_bid = &parsebid($bid+$inc); $bid=parsebid($bid); print <<"EOF";

Place A Bid
$title
Item # - $form{'item'}
The High Bid Is: \$$bid
The Lowest You May Bid Is: \$$lowest_new_bid EOF if ($config{'regdir'}) { print <<"EOF";

Registration is required to make a bid!

Your Username: (used to track your bid)
Your Password:   (must be valid)
Your Bid:          \$

EOF } else { print <<"EOF";

Your Username: (used to track your bid)
Your E-Mail Address: (must be valid)
Your Bid: \$

Contact Information: (will be given out only to the seller)
Full Name:

Street Address:

City, State, ZIP:

EOF } my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[0]); # read first bid print <<"EOF";

Binding contract:
  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!

Proxy bidding for all bids:
  Please bid the maximum amount you are willing to pay for this item. Your maximum amount will be kept secret; $config{'sitename'} will bid on your behalf as necessary by increasing your bid by the current bid increment up until your maximum is reached. This saves you the trouble of having to keep track of the auction as it proceeds and prevents you from being outbid at the last minute unless your spending limit is exceeded. Also, in case of a tie for high bidder, earlier bids take precedence. And, keep in mind that you cannot reduce your maximum bid at a later date.
  If you have bid on this item before, note that your new bid must be greater than your previous bid.

How to Bid

  1. Register to bid - It's free, and required to bid or sell.
  2. Know the Item - Read the full description of the item you are bidding on.
  3. If you have questions about the item - contact the seller $alias BEFORE you place a bid.
  4. Decide on the price, and submit your bid!
EOF } ## End Normal Bid Form else { ##### Go Dutch if ($dutch eq $config{'godutch'}){ ### Place Bid on a Auction Item my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$form{'item'}); my $nowtime = localtime(time); my $closetime = localtime($form{'item'}); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); # read the last bid my $lowest_new_bid; my $bidtime = localtime($time); $lowest_new_bid = &parsebid($bid); if (($soldqty+$form{'OQTY'}) > $qty) { $lowest_new_bid = &parsebid($bid+$inc); } print <<"EOF";
Place A Dutch Fixed Bid
$title
Item # - $form{'item'}
The Dutch Fixed Price Is: \$$lowest_new_bid EOF if ($config{'regdir'}) { print <<"EOF";

Registration is required to make a bid!

Your Username: (used to track your bid)
Your Password:   (must be valid) <

Your Dutch Price Is: \$$lowest_new_bid

Quanty your bidding on:     

EOF } else { print <<"EOF";

Your Username: (used to track your bid)
Your E-Mail Address: (must be valid)
Your Bid: \$

Contact Information: (will be given out only to the seller)
Full Name:

Street Address:

City, State, ZIP:

EOF } my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[0]); # read first bid print <<"EOF";

Binding contract:
  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!

This is a Dutch Action!
Please refer to our rules governing Dutch auctions before bidding.(NOTE:) There is no proxy bidding in a dutch Auction, item price does not change when bidding, When a bid is placed the seller and buyer will be E-Mailed contact information price and Quantity of bid, It is up to the buyer and seller to contact each other to make necessary arrangments.
How to Bid

  1. Register to bid - It's free, and required to bid or sell.
  2. Know the Item - Read the full description of the item you are bidding on.
  3. If you have questions about the item - contact the seller $alias BEFORE you place a bid.
  4. Decide on the Quantity you need!
EOF ## End Dutch Bid Form } } } } { ############################ my @lastbid = &read_bid($bids[$#bids]); my @firstbid = &read_bid($bids[0]); print <<"EOF";
Place A Bid
The High Bid Is: \$$bid
The Lowest You May Bid Is: \$$lowest_new_bid

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 ($config{'regdir'}) { print <<"EOF";

Registration is required to post or bid!

Your Handle/Alias: (used to track your bid)
Your Password: (must be valid)
Your Bid: \$

EOF } else { print <<"EOF";

Your Handle/Alias: (used to track your bid)
Your E-Mail Address: (must be valid)
Your Bid: \$

Contact Information: (will be given out only to the seller)
Full Name:

Street Address:

City, State, ZIP:

EOF } print <<"EOF"; EOF } #} #-############################################# # Sub: Add New Item # This allows a new item to be put up for sale sub new { my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids); my $inc = '.10'; # default increment if ($form{'REPOST'}) { $form{'REPOST'} =~ s/\W//g; if (-T "$config{'basepath'}$config{'closedir'}/$form{'REPOST'}.dat") { open THEFILE, "$config{'basepath'}$config{'closedir'}/$form{'REPOST'}.dat"; ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids); } } print <<"EOF";

Post A New Item

EOF print "" if ($form{'THUMB'}); print <<"EOF";
Upload Image:
Optional, should be no larger than 50K
EOF if ($config{'regdir'}) { print <<"EOF";

Registration is required to post or bid!

Title/Item Name:
No HTML
Category:
Select One
Image URL:
Optional, should be no larger than 200x200
Category Featured Auction:
Displayed on the top of the item's category \$$config{'featured_charge'}		 : Click this box for a category featured auction.
Attention Grabbers:
Really make your auction stand out from the crowd with these special icons! \$$config{'grabber_charge'}
None
Days Until Close:
1-14
Bold Listing:
Help your listings stand out for only \$$config{'bold_charge'} 		: Check this box for a Bold listing.
Shipping Method:
Payment Method(s):
Choose all payment methods you will accept.
See Description Cash Check
Money Order Visa Mastercard
Amex Discover Online Payment service
Description:
May include HTML - This should include the condition of the item, payment and shipping information, and any other information the buyer should know.
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!
Dutch:

Select this if you have more than one of the same item for auction.
Quantity if yes dutch selected:
Your Handle/Alias:
Used to track your post
Your Password:
Must be valid
Your Starting Bid:\$
Your Reserve Price:
You are not obligated to sell below this price. Leave blank if none.		\$
Bid Increment:\$
Buy-it Now:
Optional, this feature allows the first bidder to win the auction with a bid at this set price.		\$
EOF } else { print <<"EOF"; Your Handle/Alias:
Used to track your post Your E-Mail Address:
Must be valid Your Starting Bid:\$ Your Reserve Price:
You are not obligated to sell below this price. Leave blank if none.\$ Bid Increment:\$ Buy-it Now:
Optional, this feature allows the first bidder to win the auction with a bid at this set price.\$ Contact Information:
Will be given out only to the buyer Full Name:

Street Address:

City, State, ZIP:
EOF } print <<"EOF";
EOF } #-############################################# # Sub: Process New Item # This processes new item to be put up for # sale from a posted form sub procnew { my ($password, @userbids); if ($config{'regdir'} ne "") { &oops('Your alias could not be found!') unless ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = &read_reg_file($form{'ALIAS'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('Your password is incorrect.') unless ((lc $password) eq (lc $form{'PASSWORD'})); } ######################################### # Disallow post if Users Account is Suspended my ($balance,$status) = &read_balance($form{'ALIAS'}); &ac_oops ('Your Account is Currently Suspended.') unless ($status == 0); ######################################### # Disallow post if Users Account is Overdue my ($balance,$status,$firstdate,$lastdate,$lastcredit) = &read_balance($form{'ALIAS'}); &ac_oops ('Your Account is Currently Overdue.') unless ((($lastcredit + ($config{'overduedays'} * 84600)) > time) || ($balance >= 0 )); ######################################### # Disallow post if Negative Balance my ($balance,$status) = &read_balance($form{'ALIAS'}); &ac_oops ('Your Account is holding a Negative Balance.') unless ($balance >= 0); &oops('You must have an item title that is up to 50 characters.') unless ($form{'TITLE'} && (length($form{'TITLE'}) < 51)); &oops('You must select a valid category.') unless (-d "$config{'basepath'}$form{'CATEGORY'}" and $category{$form{'CATEGORY'}}); $form{'IMAGE'} = "" if ($form{'IMAGE'} eq "http://"); &oops('You must enter the number of days your auction should run, from 1 to 14.') unless (($form{'DAYS'} > 0) and ($form{'DAYS'} < 15)); &oops('You must enter an item description.') unless ($form{'DESC'}); &oops('You must enter an alias to track your item.') unless ($form{'ALIAS'}); &oops('You must enter a valid e-mail address.') unless (&check_email($form{'EMAIL'})); &oops('You must enter a valid starting bid.') unless ($form{'BID'} =~ /^(\d+\.?\d*|\.\d+)$/); &oops('You must enter a valid bid increment.') unless (($form{'INC'} =~ /^(\d+\.?\d*|\.\d+)$/) and ($form{'INC'} >= .01)); ############################ &oops('You must enter a valid Buy-it Now price that is greater than the Starting Bid.') if (($form{'BUYIT'} > 0) && ($form{'BUYIT'} < $form{'BID'}) && ($config{'buynow'} == 0)); &oops('You must enter a valid Buy-it Now price that is equal to or less than the Reserve Price.') if (($form{'BUYIT'} > 0) && ($form{'BUYIT'} > $form{'RESERVE'}) && ($config{'buynow'} == 1)); &oops('You must enter a valid Buy-it Now price that is equal to or greater than the Reserve Price.') if (($form{'BUYIT'} > 0) && ($form{'BUYIT'} < $form{'RESERVE'}) && ($config{'buynow'} == 2)); ############################ $form{'INC'} = &parsebid($form{'INC'}); $form{'RESERVE'} = &parsebid($form{'RESERVE'}); &oops('You must enter your full name.') unless ($form{'ADDRESS1'}); &oops('You must enter your street address.') unless ($form{'ADDRESS2'}); &oops('You must enter your city, state, and zip code.') unless ($form{'ADDRESS3'}); foreach my $key (keys %form) { $form{$key} = &strip_html($form{$key}); } my $item_number = ($form{'DAYS'} * 86400 + time); $item_number = ($form{'DAYS'} * 86400 + time) until (!(-f "$config{'basepath'}$form{'CATEGORY'}/$item_number.dat")); if ($form{'FROMPREVIEW'}) { &oops('We are unable to post your item. This could be a write permissions problem.') unless (open (NEW, ">$config{'basepath'}$form{'CATEGORY'}/$item_number.dat")); print NEW "$form{'TITLE'}\n$form{'RESERVE'}\n$form{'INC'}\n$form{'DESC'}\n$form{'IMAGE'}\n$form{'GRABBER'}\n$form{'CATFEAT'}\n$form{'BUYIT'}\n$form{'BOLD'}\n$form{'DUTCH'}\n$form{'QTY'}\n$form{'SHIP'}\n$form{'PAY0'}\n$form{'PAY1'}\n$form{'PAY2'}\n$form{'PAY3'}\n$form{'PAY4'}\n$form{'PAY5'}\n$form{'PAY6'}\n$form{'PAY7'}\n$form{'PAY8'}\n$form{'ALIAS'}\[\]$form{'EMAIL'}\[\]".&parsebid($form{'BID'})."\[\]".time."\[\]$form{'ADDRESS1'}\[\]$form{'ADDRESS2'}\[\]$form{'ADDRESS3'}\[\]$form{'OQTY'}\[\]$form{'SOLDQTY'}\[\]".&parsebid($form{'BID'}); close NEW; if ($form{'IMAGE'} =~ /^http\:\/\/$ENV{'HTTP_HOST'}\/(.+)\./) { open(TAG, "> $ENV{'DOCUMENT_ROOT'}/$1.txt"); print TAG "$form{'CATEGORY'}$item_number"; close(TAG); } if ($config{'regdir'} ne "") { &oops('We could not open the registration file. This could be a server write issue.') unless (open(REGFILE, ">>$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")); print REGFILE "\n$form{'CATEGORY'}$item_number"; close REGFILE; } print "$form{'TITLE'} was posted under $category{$form{'CATEGORY'}}....
You may want to go to the item to confirm placement.\n\n"; &proctransaction ($form{'ALIAS'}, 1, "$form{'TITLE'} Posted","Start Price $form{'BID'} Reserve $form{'RESERVE'}","-0.10"); if (($config{'bold_charge'} >= ".01") && ($form{'BOLD'} eq "BOLDON")) { &proctransaction ($form{'ALIAS'}, 1, "Item No. $item_number","Bold Item Charge","$config{'bold_charge2'}"); } if (($config{'featured_charge'} >= ".01") && ($form{'CATFEAT'} eq "CATFEATYES")) { &proctransaction ($form{'ALIAS'}, 1, "Item No. $item_number","Featured Category Charge","$config{'featured_charge2'}"); } if (($config{'grabber_charge'} >= ".01") && ($form{'GRABBER'} eq "grabber01")) { &proctransaction ($form{'ALIAS'}, 1, "Item No. $item_number","Attention Grabber Charge","$config{'grabber_charge2'}"); } if (($config{'grabber_charge'} >= ".01") && ($form{'GRABBER'} eq "grabber02")) { &proctransaction ($form{'ALIAS'}, 1, "Item No. $item_number","Attention Grabber Charge","$config{'grabber_charge2'}"); } if (($config{'grabber_charge'} >= ".01") && ($form{'GRABBER'} eq "grabber03")) { &proctransaction ($form{'ALIAS'}, 1, "Item No. $item_number","Attention Grabber Charge","$config{'grabber_charge2'}"); } if (($config{'grabber_charge'} >= ".01") && ($form{'GRABBER'} eq "grabber04")) { &proctransaction ($form{'ALIAS'}, 1, "Item No. $item_number","Attention Grabber Charge","$config{'grabber_charge2'}"); } if (($config{'grabber_charge'} >= ".01") && ($form{'GRABBER'} eq "grabber05")) { &proctransaction ($form{'ALIAS'}, 1, "Item No. $item_number","Attention Grabber Charge","$config{'grabber_charge2'}"); } } else { my $nowtime = localtime(time); my $closetime = localtime($item_number); my $html_description = &strip_scripts(&enable_html($form{'DESC'})); print "

$form{'TITLE'} PREVIEW

Information
\n"; print ""; print "" if ($form{'IMAGE'}); #print "
$form{'TITLE'}
Category: $category{$form{'CATEGORY'}}
Offered By: $form{'ALIAS'}
Current Time: $nowtime
Closes: $closetime
Or $config{'aftermin'} minutes after last bid...
Number of Bids: 0
Last Bid: \$$form{'BID'}
\n"; ########################### print "\n"; print "" if ($form{'BUYIT'} > 0); print "" if ($form{'BUYIT'} <= 0); print "
$form{'TITLE'}
Category: $category{$form{'CATEGORY'}}
Offered By: $form{'ALIAS'}
Current Time: $nowtime
Closes: $closetime
Or $config{'aftermin'} minutes after last bid...
Number of Bids: 0
Last Bid: \$$form{'BID'}
Buy-it Now Price: \$$form{'BUYIT'}
Buy-it Now Price: Not Selected
\n"; ########################### print "
Description
$html_description"; print "
If this looks good, hit , else hit the back button on your browser to edit the item.\n"; foreach my $key (keys %form) { print "\n"; } print "
\n"; } } #-############################################# # Sub: Process Bid # This processes new bids from a posted form sub procbid { my ($password, @userbids); if ($config{'regdir'} ne "") { &oops('Your alias could not be found!') unless ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = &read_reg_file($form{'ALIAS'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('Your password is incorrect.') unless ((lc $password) eq (lc $form{'PASSWORD'})); } &oops('You must enter an alias to track your item.') unless ($form{'ALIAS'}); &oops('You must enter a valid e-mail address.') unless (&check_email($form{'EMAIL'})); &oops('You must enter a valid bid amount.') unless ($form{'BID'} =~ /^(\d+\.?\d*|\.\d+)$/); $form{'BID'} = &parsebid($form{'BID'}); &oops('You must enter your full name.') unless ($form{'ADDRESS1'}); &oops('You must enter your street address.') unless ($form{'ADDRESS2'}); &oops('You must enter you city, state, and zip.') unless ($form{'ADDRESS3'}); my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'CATEGORY'},$form{'ITEM'}); &oops('The item number you entered cannot be found. Maybe it has closed or it was moved since you last loaded the page.') if $title eq ''; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty,$last_high) = &read_bid($bids[$#bids]); if ((time <= $form{'ITEM'}) or (time <= (60 * $config{'aftermin'} + $time))) { &oops('Your bid is too low. Sorry.') if ($form{'BID'} < ($bid+$inc) and ($#bids)) or ($form{'BID'} < $bid); $str=''; $show_bid=$form{'BID'}; $out_bid=$alias; if ($form{'nonproxy'} ne "") { if ($form{'BID'} > $last_high) { $last_high=$form{'BID'}; } } else { if ( ($form{'BID'} < $last_high) && ($form{'BID'} >= ($bid+$inc)) ) { $form{'BID'} = $form{'BID'} + $inc; $email=$form{'EMAIL'}; $out_bid=$form{'ALIAS'}; $old=1; } else { if ($form{'BID'} > $last_high) { $str=$form{'BID'}; $form{'BID'} = $last_high + $inc; $last_high=$str; } } } &oops('We are unable to append your bid to the auction item. It appears to be a file write problem.') unless (open NEW, ">>$config{'basepath'}$form{'CATEGORY'}/$form{'ITEM'}.dat"); if ($config{'flock'}) { flock(NEW, 2); seek(NEW, 0, 2); } $form{'BID'} = parsebid($form{'BID'}); $last_high = parsebid($last_high); if ($old == 1) { print NEW "\n$alias\[\]$email\[\]$form{'BID'}\[\]".time."\[\]$add1\[\]$add2\[\]$add3\[\]$oqty\[\]$soldqty\[\]$last_high"; }else { print NEW "\n$form{'ALIAS'}\[\]$form{'EMAIL'}\[\]$form{'BID'}\[\]".time."\[\]$form{'ADDRESS1'}\[\]$form{'ADDRESS2'}\[\]$form{'ADDRESS3'}\[\]$form{'OQTY'}\[\]$form{'SOLDQTY'}\[\]$last_high"; } close NEW; print "$form{'ALIAS'}, your bid has been placed on item number $form{'ITEM'} for \$$show_bid on ".scalar(localtime(time)).".
You may want to print this notice as confirmation of your bid.

Go back to the item\n"; my $flag=0; my $userbid; foreach $userbid (@userbids) { $flag=1 if ("$form{'CATEGORY'}$form{'ITEM'}" eq $userbid); } if ($flag==0 && $config{'regdir'} ne "") { &oops('We could not open the registration file. This could be a server write issue.') unless (open(REGFILE, ">>$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")); print REGFILE "\n$form{'CATEGORY'}$form{'ITEM'}"; close REGFILE; } &sendemail($email, $config{'admin_address'}, 'You\'ve been outbid!', "UserID: $out_bid You have been outbid on $title\! If you want to place a higher bid, please visit\:\r\n\r\n\thttp://$config{'scripturl'}$ENV{'SCRIPT_NAME'}\?category=$form{'CATEGORY'}\&item=$form{'ITEM'}\r\n\r\nThe current high bid is \$$form{'BID'}.") if ($config{'scripturl'} and $#bids); } else { print "Item number $form{'ITEM'} in category $form{'CATEGORY'} is now closed!
Sorry...\n"; } } #-############################################# # Sub: Process Search # This displays search results sub procsearch { print "

Search Results - $form{'searchstring'}

\n"; print "\n"; print "\n"; my $key; foreach $key (sort keys %category) { opendir THEDIR, "$config{'basepath'}$key" or &oops("Category directory $key could not be opened."); my @allfiles = grep -T, map "$config{'basepath'}$key/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$key\///; $file =~ s/\.dat$//; my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($key,$file); if ($title ne '') { my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); my @closetime = localtime($file); $closetime[4]++; if($form{'searchtype'} eq 'keyword' and ($title =~ /$form{'searchstring'}/i) || ($desc =~ /$form{'searchstring'}/i)) { print "\n"; } elsif($form{'searchtype'} eq 'username' and join(' ',@bids) =~ /$form{'searchstring'}/i) { print "\n"; } } } } print "
ItemClosesNum BidsHigh Bid
$title"; print " [PIC]" if ($image); print "$closetime[4]/$closetime[3]$#bids\$$bid
$title"; print " [PIC]" if ($image); print "$closetime[4]/$closetime[3]$#bids\$$bid
\n"; } #-############################################# # Sub: Change Registration # This allows a user to change information sub creg { print <<"EOF";

Change Street Address and/or Password

This form will allow you to change your street address and/or password.
Your Handle/Alias:
Required for verification
Your Current Password:
Required for verification
Your New Password:
Leave blank if unchanged
Your New Password Again:
Leave blank if unchanged
Contact Information:
Leave blank if unchanged		 Full Name:

Street Address:

City, State, ZIP:
EOF } #-############################################# # Sub: Process Changed Registration # This modifies an account sub proccreg { if ($config{'regdir'}) { &oops('You must enter your alias so we can validate your account.') unless ($form{'ALIAS'}); &oops('You must enter your old password so we can validate your account.') unless ($form{'OLDPASS'}); if ($form{'ADDRESS1'}) { &oops('You must enter all of your contact information. Please enter your street address.') unless ($form{'ADDRESS2'}); &oops('You must enter all of your contact information. Please enter your city, state, and zip.') unless ($form{'ADDRESS3'}); } if ($form{'NEWPASS1'}) { &oops('Your new passwords do not match.') unless ($form{'NEWPASS2'} eq $form{'NEWPASS1'}); } if (my ($password,$email,$add1,$add2,$add3,@past_bids) = &read_reg_file($form{'ALIAS'})) { $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('Your old password does not match up.') 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('We cannot open your account. This could be a server data write issue.') unless (open NEWREG, ">$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat"); print NEWREG "$form{'NEWPASS1'}\n$email\n$form{'ADDRESS1'}\n$form{'ADDRESS2'}\n$form{'ADDRESS3'}"; my $bid; foreach $bid (@past_bids) { print NEWREG "\n$bid"; } close NEWREG; &check_feed($form{'ALIAS'}); 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 new account.\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 reg { print <<"EOF";

New User Registration

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.
Your Handle/Alias:
Used to track your post
Your E-Mail Address:
Must be valid
Contact Information:
Will be given out only to the buyer or seller		 Full Name:

Street Address:

City, State, ZIP:
EOF } #-############################################# # Sub: Process Registration # This adds new accounts to the database sub procreg { if ($config{'regdir'}) { umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$config{'regdir'}", 0777) unless (-d "$config{'basepath'}$config{'regdir'}"); &oops('You must enter an alias that consists of alphanumeric characters.') if $form{'ALIAS'} =~ /\W/ or !($form{'ALIAS'}); &oops('You must enter a valid e-mail address.') unless ($form{'EMAIL'} =~ /^.+\@.+\..+$/); &oops('You must enter your full name so buyers or sellers may contact you.') unless ($form{'ADDRESS1'}); &oops('You must enter a valid street address so buyers or sellers can contact you.') unless ($form{'ADDRESS2'}); &oops('You must enter a valid city, state, and zip code so buyers or sellers can contact you.') unless ($form{'ADDRESS3'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); if (!(-f "$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")) { &oops('We were unable to write to the user directory.') unless (open NEWREG, ">$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat"); my $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'}, $config{'admin_address'}, 'Auction Password', "PLEASE DO NOT REPLY TO THIS E-MAIL.\r\n\r\nThank you for registering to use the online auctions at $config{'sitename'}!\r\n\r\nYour new password is: $newpass\r\nYour alias (as you entered it) is: $form{'ALIAS'}\r\n\r\nThank you for visiting!"); &accountcreate ($form{'ALIAS'}); } 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: Closed items 1 # This displays closed items sub viewclosed1 { print <<"EOF";

View Closed Items

This form will allow you to view the status and contact information for closed auction items you bid on or listed for auction.
Your Username:
Required for verification
Your Password:
Required for verification
EOF } #-############################################# # Sub: Closed items 2 # This displays closed items sub viewclosed2 { &oops('Your alias could not be found!') unless my ($password,$email,$add1,$add2,$add3,@past_bids) = &read_reg_file($form{'ALIAS'}); &oops('Your password is incorrect.') unless ((lc $password) eq (lc $form{'PASSWORD'})); &oops('PASSWORD') unless ((lc $password) eq (lc $form{'PASSWORD'})); print "\n"; print "
\n"; } #-############################################# # Sub: Closed items 3 # This displays closed items sub viewclosed3 { $form{'BIDTOVIEW'} =~ s/\W//g; open (THEFILE, "$config{'basepath'}$config{'closedir'}/$form{'BIDTOVIEW'}.dat") or &oops('We cannot open the item you are looking for. This could be a server read issue.'); my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids); my $html_description = &strip_scripts(&enable_html($desc)); print "

$title

\n"; print "
Description
$html_description"; print "
Bid History
\n"; if ($#bids) { for (my $i=1; $i$alias \($bidtime\) - \$$bid
"; } } else { print "No bids were placed...
"; } print "

Reserve was: \$$reserve
\n"; ############################ my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); print "

Buy-it Now Set Price: \$$buyit

" if ($buyit > 0); print "

Buy-it Now Price: Was Not Selected

" if ($buyit <= 0); print "

Note: This item sold using the Buy-it Now Function.

" if (($buyit > 0) && ($bid == $buyit)); print "

Note: This item did not sell using the Buy-it Now Function.

" if (($buyit > 0) && ($bid > $buyit)); ############################ print "
Contact Information
\n"; if (ucfirst(lc($form{'ALIAS'})) eq (&read_bid($bids[0]))[0]) { print "You were the seller...

\n"; if ($#bids) { my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); print "Buyer Information:
Alias: $alias
E-Mail: $email
Address: ".&strip_html($add1)."
".&strip_html($add2)."
".&strip_html($add3)."

High Bid: \$$bid\n"; print "

Bidder Contact Info:
\n"; for (my $i=1; $i$alias - $email
\n"; } } # print "

You may repost this item if you want to:
\n"; ############################ print "
You may repost this item if you want to:
\n" if (($buyit > 0) && ($bid ne $buyit) or ($reserve > 0) && ($bid ne $reserve) or ($buyit == 0) && ($reserve == 0) && ($#bids == 0)); ############################ } elsif (ucfirst(lc($form{'ALIAS'})) eq (&read_bid($bids[$#bids]))[0]) { print "You were a high bidder...

\n"; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[0]); print "Seller Information:
Alias: $alias
E-Mail: $email
Address: ".&strip_html($add1)."
".&strip_html($add2)."
".&strip_html($add3)."

"; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); print "Your High Bid: \$$bid

\n"; #print "Remember, the seller is not required to sell unless your bid price was above the reserve price..."; ############################ print "Remember, the seller is not required to sell unless your bid price was above the reserve price..." unless (($buyit > 0) && ($bid == $buyit)); ############################ } else { print "You were not a winner... No further contact information is available.\n"; } } #-############################################# # Sub: Admin # Allows the administrator to delete items. sub admin { print <<"EOF";

Delete Items

This form will allow you to delete an item. You will need the administrator password that should be configured in the script.
Category:
Select One
Item Number:
Administrator Password:
Required for verification
EOF } #-############################################# # Sub: Process Admin # Allows the administrator to delete items. sub procadmin { if (lc($form{'PASSWORD'}) eq lc($config{'adminpass'})) { &oops('Bad Item Category or Number!') unless &read_item_file($form{'CATEGORY'},$form{'ITEM'}); if (unlink("$config{'basepath'}$form{'CATEGORY'}/$form{'ITEM'}.dat")) { print "File Successfully Removed!\n"; } else { print "File Could Not Be Removed!\n"; } } else { print "Sorry... Incorrect administrator password for delete!\n"; } } #-############################################# # Sub: Close Auction and send seller and buyer a email # This sets an item's status to closed. sub closeit { my ($cat,$item) = @_; if ($cat ne $config{'closedir'}) { my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($cat,$item); my @lastbid = &read_bid($bids[$#bids]); my @firstbid = &read_bid($bids[0]); #--AccountFirst Closed Item Charge Entry Point---------# # Insert your AF line below if you are using the AF's # # charge when item closes feature #if (($lastbid[2] >= $reserve) && ($lastbid[2] >= $firstbid[2])) { #&transaction_percentage_closed($firstbid[0], "Auction closed, #$item ($title)", #$firstbid[2], $lastbid[2], $reserve, 1, 0, 1); # &transaction_presetrates_closed($firstbid[0], "Auction closed, #$item ($title\)", #$firstbid[2], $lastbid[2], $reserve, 1, 0, 1); #} #--End-------------------------------------------------# if ($#bids) { if (($lastbid[2] >= $reserve) && ($lastbid[0] ne $firstbid[0]) && ($dutch eq $config{'nodutch'})) { &sendemail($lastbid[1], $config{'admin_address'}, "Auction Ended: Item #$item \($title\)", "$firstbid[4] and $lastbid[4]\n Congratulations! This auction has successfully ended. Item Title: $title Item Description: $desc\n Information: Final Price: \$$lastbid[2] Total bids: $#bids Seller User ID: $firstbid[4] Seller E-mail: $firstbid[1] Buyer User ID: $lastbid[4] Buyer E-mail: $lastbid[1]\n Now What? The buyer and seller should contact each other within three business days to complete the sale. Not getting in touch leaves the contract open and can earn you negative feedback. NOTE: If you are a winning bidder, please send your payment directly to the seller.\n We are glad this auction was successful. We hope you have enjoyed using the $config{'sitename'} and will come back often!"); } else { if (($lastbid[2] <= $reserve) && ($firstbid[2] ne $lastbid[2]) && ($dutch eq $config{'nodutch'})) { &sendemail($lastbid[1], $config{'admin_address'}, "Auction Ended: Item #$item \($title\)", "Congratulations! You were the high bidder on auction number $item \($title\). Item Description: $desc\n Your bid was in the amount of \$$lastbid[2]. Unfortunately, your bid did not meet the seller\'s reserve price... You may still wish to contact the seller to negotiate a fair price. This does not mean that they have to reply as they are not required to sell to anyone if their reserve price was not met. If you do wish to contact them, you may do so at the following e-mail address. $firstbid[1]\n We hope you have enjoyed using the $config{'sitename'} and will come back often!"); } } if (($lastbid[2] >= $reserve) && ($lastbid[0] ne $firstbid[0]) && ($dutch eq $config{'nodutch'})) { &sendemail($firstbid[1], $config{'admin_address'}, "Auction Ended: Item #$item \($title\)", "$firstbid[4] and $lastbid[4]\n Congratulations! This auction has successfully ended. Item Title: $title Item Description: $desc\n Information: Final Price: \$$lastbid[2] Total bids: $#bids Seller User ID: $firstbid[4] Seller E-mail: $firstbid[1] Buyer User ID: $lastbid[4] Buyer E-mail: $lastbid[1]\n Now What? The buyer and seller should contact each other within three business days to complete the sale. Not getting in touch leaves the contract open and can earn you negative feedback.\n We are glad this auction was successful.\n We hope you have enjoyed using the $config{'sitename'} and will come back often!"); } } else { if (($lastbid[2] <= $reserve) && ($lastbid[0] ne $firstbid[0]) && ($dutch eq $config{'nodutch'})) { &sendemail($firstbid[1], $config{'admin_address'}, "Auction Ended: Item #$item \($title\)", "Auction number $item is now closed. Item Description: $desc\n Unfortunately, You reserve price was not met. You may repost your item by using the closed auction manager at: $config{'scripturl'}$ENV{'SCRIPT_NAME'}?action=closed.\n Good Luck on the next time around. Thank you for using $config{'sitename'} and will come back often!"); } } if (($lastbid[0] eq $firstbid[0]) && ($dutch eq $config{'nodutch'})) { &sendemail($firstbid[1], $config{'admin_address'}, "Auction Ended: Item #$item \($title\)", "Auction number $item is now closed. Item Description: $desc\n Unfortunately, there were no bids on your item. You may repost your item by using the closed auction manager at: $config{'scripturl'}$ENV{'SCRIPT_NAME'}?action=closed.\n Good Luck on the next time around. Thank you for using $config{'sitename'} and will come back often!"); } if ($dutch eq $config{'godutch'}) { &sendemail($firstbid[1], $config{'admin_address'}, "Auction Close: Item #$item \($title\)", "Auction Number $item Is Now Closed Item Description: $desc\n if you still have items left feel free to repost your dutch auction by following this link: $config{'scripturl'}$ENV{'SCRIPT_NAME'}\?action=closed\n Now What? The buyer and seller should have received contact info a the time dutch bids were placed to be able to contact each other within three business days to complete the sale. Not getting in touch leaves the contract open and can earn you negative feedback.\n We hope you have enjoyed using the $config{'sitename'} and will come back often!"); } if ($config{'closedir'}) { umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$config{'closedir'}", 0777) unless (-d "$config{'basepath'}$config{'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("$config{'basepath'}$cat/$item.dat", "$config{'basepath'}$config{'closedir'}/$cat$item.dat"); unlink("$config{'basepath'}ask/$cat:$item.txt"); } else { print "Please notify the site admin that this item cannot be removed even though it is closed.\n" unless unlink("$config{'basepath'}$cat/$item.dat"); } } } #-############################################# # 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, From, Message) sub sendemail { my ($to,$from,$subject,$message) = @_; my $trash; if ($config{'mailhost'}) { eval('use IO::Socket; 1;') or &oops("IO::Socket could not be loaded by the script. Please see the script documentation for details. It looks like this server is using perl version $]. IO::Socket may not be included with versions of perl prior to 5.00404."); # don't cause errors on machines where IO::Socket is not available my $remote; $remote = IO::Socket::INET->new("$config{'mailhost'}:smtp(25)"); $remote->autoflush(); print $remote "HELO\r\n"; $trash = <$remote>; print $remote "MAIL From:<$config{'admin_address'}>\r\n"; $trash = <$remote>; print $remote "RCPT To:<$to>\r\n"; $trash = <$remote>; print $remote "DATA\r\n"; $trash = <$remote>; print $remote "From: <$from>\r\nSubject: $subject\r\n\r\n"; print $remote $message; print $remote "\r\n.\r\n"; $trash = <$remote>; print $remote "QUIT\r\n"; } else { open MAIL, "|$config{'mailprog'}"; print MAIL "To: $to\r\nFrom: $from\r\nSubject: $subject\r\n\r\n$message\r\n\r\n"; close MAIL; } } #-############################################# # Sub: Get Form Data # This gets data from a post. sub get_form_data { my $temp; my $buffer; my @data; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); foreach $temp (split(/&|=/,$buffer)) { $temp =~ tr/+/ /; $temp =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; $temp =~ s/[\r\n]/ /g; push @data, $temp; } foreach $temp (split(/&|=/,$ENV{'QUERY_STRING'})) { $temp =~ tr/+/ /; $temp =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge; $temp =~ s/[\r\n]/ /g; push @data, $temp; } return @data; } #-############################################# # Sub: Random Password # This generates psudo-random 8-letter # passwords sub randompass { srand(time ^ $$); my @passset = ('a'..'k', 'm'..'n', 'p'..'z', '2'..'9'); my $randpass = ""; for (my $i=0; $i<8; $i++) { $randpass .= $passset[int(rand($#passset + 1))]; } return $randpass; } #-############################################# # Sub: parse bid # This formats a bid amount to look good... # ie. $###.## sub parsebid { $_[0] =~ s/\,//g; my @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 "

Error:
$_[0]

Please hit the back browser on your browser to try again or contact the auction administrator if you believe this to be a server problem.

\n"; print $config{'footer'}; die "Error: $_[0]\n"; } #-############################################# # Sub: Movefile(file1, file2) # This moves a file. Quick and dirty! sub movefile { my ($firstfile, $secondfile) = @_; return 0 unless open(FIRSTFILE,$firstfile); my @lines=; close FIRSTFILE; return 0 unless open(SECONDFILE,">$secondfile"); my $line; foreach $line (@lines) { print SECONDFILE $line; } close SECONDFILE; return 0 unless unlink($firstfile); return 1; } #-############################################# # Sub: Read Reg File (alias) # Reads a registration file sub read_reg_file { my $alias = shift; return '' unless $alias; # verify the user exists &oops('Your alias may not contain any non-word characters.') if $alias =~ /\W/; $alias = ucfirst(lc($alias)); return '' unless -r "$config{'basepath'}$config{'regdir'}/$alias.dat" and -T "$config{'basepath'}$config{'regdir'}/$alias.dat"; open FILE, "$config{'basepath'}$config{'regdir'}/$alias.dat"; my ($password,$email,$add1,$add2,$add3,@past_bids) = ; close FILE; chomp ($password,$email,$add1,$add2,$add3,@past_bids); return ($password,$email,$add1,$add2,$add3,@past_bids); } #-############################################# # Sub: Read Item File (cat, item) # Reads an item file sub read_item_file { my ($cat, $item) = @_; # verify the category exists return '' unless ($cat) and ($item); &oops('The category may not contain any non-word characters.') if $cat =~ /\W/; return '' unless $category{$cat}; # verify the item exists &oops('The item number may not contain any non-numeric characters.') if $item =~ /\D/; return '' unless (-T "$config{'basepath'}$cat/$item.dat") and (-R "$config{'basepath'}$cat/$item.dat"); open FILE, "$config{'basepath'}$cat/$item.dat"; my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = ; close FILE; chomp ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids); return ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids); } #-############################################# # Sub: Read Bid Information (bid_string) # Reads an item file sub read_bid { my $bid_string = shift; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty,$last_high) = split(/\[\]/,$bid_string); return ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty,$last_high); } #-############################################# # # Reads something sub read_watch_file { my $watch = shift; open FILE, "$config{'basepath'}$config{'watchdir'}/$watch.dat"; my (@watch) = ; close FILE; chomp (@watch); return (@watch); } #-############################################# # Sub: Strip Scripts # Strips client-side script tags from HTML sub strip_scripts { my $line = shift; $line =~ s/(<[\s\/]*)(script\b[^>]*>)/$1x$2/gi; while ($line =~ s/(<[^>]*?)\b(on\w+\s*=)/$1x$2/gi) {} return $line; } #-############################################# # Sub: Strip HTML # Strips HTML from text sub strip_html { my $line = shift; $line =~ s/&/&/g; $line =~ s/"/"/g; $line =~ s//>/g; return $line; } #-############################################# # Sub: Enable HTML # Re-enables Stripped HTML sub enable_html { my $line = shift; $line =~ s/"/"/gi; $line =~ s/<//gi; $line =~ s/&/&/gi; return $line; } #-############################################# # Sub: Check E-mail # Checks for valid e-mail address sub check_email { my $mail = shift; #characters allowed on name: 0-9a-Z-._ on host: 0-9a-Z-. on between: @ return 0 if ( $mail !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ ); #must start or end with alpha or num return 0 if ( $mail =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/); #name must end with alpha or num return 0 if ( $mail !~ /([0-9a-zA-Z]{1})\@./ ); #host must start with alpha or num return 0 if ( $mail !~ /.\@([0-9a-zA-Z]{1})/ ); #pair .- or -. or -- or .. not allowed return 0 if ( $mail =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g ); #pair ._ or -_ or _. or _- or __ not allowed return 0 if ( $mail =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g ); #host must end with '.' plus 2-4 alpha characters (may need to be modified for new TLDs) return 0 if ( $mail !~ /\.([a-zA-Z]{2,4})$/ ); return 1; } #-############################################# # Sub: eBay-like Items sorting # This sorts items by: # - items ending first # - newly-listed first # - lowest prices first # - highest prices first # sub sort_items { my @sortedfiles; opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("Category directory $form{'category'} could not be opened."); if (!defined($form{'sort'}) || $form{'sort'} eq 'closes') { @sortedfiles = ( grep -T, map "$config{'basepath'}$form{'category'}/$_", sort { int($main::a) <=> int($main::b) } (readdir THEDIR) ); } else { my @allfiles; @allfiles = readdir THEDIR; my $file; my %pairs; foreach $file (@allfiles) { if (-T "$config{'basepath'}$form{'category'}/$file") { open THEFILE, "$config{'basepath'}$form{'category'}/$file"; my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids); if ($form{'sort'} eq 'starts') { my @firstbid = split(/\[\]/,$bids[$#bids]); $pairs{$file} = $firstbid[3]; } elsif ($form{'sort'} eq 'lowbid') { my @lastbid = split(/\[\]/,$bids[$#bids]); $pairs{$file} = $lastbid[2]; } elsif ($form{'sort'} eq 'highbid') { my @lastbid = split(/\[\]/,$bids[$#bids]); $pairs{$file} = $lastbid[2]; } } } closedir THEDIR; if ($form{'sort'} eq 'starts') { @sortedfiles = sort {$pairs{$main::b} <=> $pairs{$main::a} || ($main::a <=> $main::b) } (keys(%pairs)); } elsif ($form{'sort'} eq 'highbid') { @sortedfiles = sort { ((($pairs{$main::b}) <=> ($pairs{$main::a})) || ($main::a <=> $main::b)) } (keys(%pairs)); } elsif ($form{'sort'} eq 'lowbid') { @sortedfiles = sort { ((($pairs{$main::a}) <=> ($pairs{$main::b})) || ($main::a <=> $main::b)) } (keys(%pairs)); } } return @sortedfiles; } #-############################################# # Sub: Display List Of Featured Items # This creates a "nice" list of items in a # category. sub dispfeatured { print "

$category{$form{'category'}} \n"; print ": Featured Category Listings"; print "

"; print "\n"; print "\n"; opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("Category directory $form{'category'} could not be opened."); my @allfiles = grep -T, map "$config{'basepath'}$form{'category'}/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$form{'category'}\///; $file =~ s/\.dat$//; if (my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$file)) { my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); my ($selleralias, $selleremail, $sellerbid, $sellertime, $selleradd1, $selleradd2, $selleradd3) = &read_bid($bids[0]); if ($catfeat eq 'CATFEATYES') { my @closetime = localtime($file); $closetime[4]++; # print "\n"; } } } print "
ItemClosesBidsHigh Bid
$title"; print "
$title" if ($bold eq 'BOLDOFF'); print "
$title" if ($bold eq 'BOLDON'); print " " if (($sellertime + (86400 * $config{'newdays'})) > time); print " [PIC]" if ($image); print " " if ($#bids >= $config{'hotnum'}); print "$closetime[4]/$closetime[3]$#bids\$$bid
\n"; } #-############################################# # Sub: Buy-it Now Form # This displays the Buy Now Form. sub dispform1 { &oops("Item $form{'item'} could not be opened.") unless (my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$form{'item'})); my $nowtime = localtime(time); my $closetime = localtime($form{'item'}); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[0]); # read first bid my $key; my $file; my $buyit = &parsebid($buyit); print qq|
Using Buy-it Now will end the sale of this item, and it will no longer be open for bidding at auction. By proceeding, you agree to purchase this item at the Buy-it Now price listed below, plus any applicable fees charged by the seller.

Item Title: $title
Lot Number: #$form{'item'}
|; print qq| Buy Now Price: \$$buyit

If you do not have a User Name and Password, please register now.
|; print qq|Return to auction.
Your User Name:
Your Password:

|; } #-############################################# # Sub: Process Buy-it Now Form # This processes the Buy-it Now Form sub procform1 { my $cat; my ($password, @userbids); if ($config{'regdir'} ne "") { &oops('Your alias could not be found!') unless ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = &read_reg_file($form{'ALIAS'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('Your password is incorrect.') unless ((lc $password) eq (lc $form{'PASSWORD'})); my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'CATEGORY'},$form{'ITEM'}); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[0]); &oops('You cannot bid on your own item.') if ((lc $form{'ALIAS'}) eq (lc $alias)); } &oops('You must enter an alias to track your item.') unless ($form{'ALIAS'}); &oops('You must enter a valid e-mail address.') unless ($form{'EMAIL'} =~ /^.+\@.+\..+$/); &oops('You must enter a valid bid amount.') unless ($form{'BID'} =~ /^(\d+\.?\d*|\.\d+)$/); $form{'BID'} = &parsebid($form{'BID'}); &oops('You must enter your full name.') unless ($form{'ADDRESS1'}); &oops('You must enter your street address.') unless ($form{'ADDRESS2'}); &oops('You must enter you city, state, and zip.') unless ($form{'ADDRESS3'}); &oops('The item number you entered cannot be found. Maybe it has closed or it was moved since you last loaded the page.') unless my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'CATEGORY'},$form{'ITEM'}); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); &oops('Bids have been place on this item.') if ($bid > $buyit); if ((time <= $form{'ITEM'}) or (time <= (60 * $config{'aftermin'} + $time))) { &oops('We are unable to append your bid to the auction item. It appears to be a file write problem.') unless (open NEW, ">>$config{'basepath'}$form{'CATEGORY'}/$form{'ITEM'}.dat"); my $nowtime = localtime(time); if ($config{'flock'}) { flock(NEW, 2); seek(NEW, 0, 2); } print NEW "\n$form{'ALIAS'}\[\]$form{'EMAIL'}\[\]$form{'BID'}\[\]".time."\[\]$form{'ADDRESS1'}\[\]$form{'ADDRESS2'}\[\]$form{'ADDRESS3'}\[\]$form{'OQTY'}\[\]$form{'SOLDQTY'}"; close NEW; print qq|$form{'ALIAS'}, you have purchased lot number #$form{'ITEM'} for \$$form{'BID'} on $nowtime.

Within a few minutes, you will receive an automated e-mail response acknowledging the completion and details of the sale.

Go back to the Auction\n|; &closeit2($form{'CATEGORY'},$form{'ITEM'}); my $flag=0; my $userbid; foreach $userbid (@userbids) { $flag=1 if ("$form{'CATEGORY'}$form{'ITEM'}" eq $userbid); } if ($flag==0 && $config{'regdir'} ne "") { &oops('We could not open the registration file. This could be a server write issue.') unless (open(REGFILE, ">>$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")); print REGFILE "\n$form{'CATEGORY'}$form{'ITEM'}"; close REGFILE; } } else { print qq|Item number $form{'ITEM'} in category $form{'CATEGORY'} is now closed!
Sorry...\n|; } } #-############################################# # Sub: Close Buy-it Now Auction # This sets an item's status to closed when the # Buy-it Now Function is used and by-passes # the closeit sub. sub closeit2 { my ($cat,$item) = @_; if ($cat ne $config{'closedir'}) { my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($cat,$item); my @lastbid = &read_bid($bids[$#bids]); my @firstbid = &read_bid($bids[0]); if ($#bids) { &sendemail($lastbid[1], $firstbid[1], "Auction Close: ".&enable_html($title), "Congratulations! You are the winner of auction number $item.\nThe Buy-it Now price for $item is \$$lastbid[2].\n\nThe seller will contact you within 24 hours to make arrangements for payment and shipping:\n\n$firstbid[4]\n$firstbid[5]\n$firstbid[6]\n$firstbid[1]\n\nThanks for using $config{'sitename'}!"); &sendemail($firstbid[1], $lastbid[1], "Auction Close: ".&enable_html($title), "Auction number $item is now closed.\nThe item sold for \$$lastbid[2] using the Buy-it Now option.\n\nPlease contact the high bidder within 24 hours to make any necessary arrangements for $item:\n\n$lastbid[4]\n$lastbid[5]\n$lastbid[6]\n$lastbid[1]\n\nThanks for using $config{'sitename'}!"); } if ($config{'closedir'}) { umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$config{'closedir'}", 0777) unless (-d "$config{'basepath'}$config{'closedir'}"); my $newname = time; print qq|Please notify the site admin that this item cannot be copied to the closed directory even though it is closed.\n| unless rename("$config{'basepath'}$cat/$item.dat", "$config{'basepath'}$config{'closedir'}/$cat$newname.dat"); chmod (0666, "$config{'basepath'}$config{'closedir'}/$cat$newname.dat"); # UNIX thing... &oops('We could not open the registration file. This could be a server write issue.') unless (open(REGFILE, ">>$config{'basepath'}$config{'regdir'}/$lastbid[0].dat")); print REGFILE "\n$cat$newname"; close REGFILE; if ($config{'flock'}) { flock(NEW, 2); seek(NEW, 0, 2); } &oops('We could not open the registration file. This could be a server write issue.') unless (open(REGFILE, ">>$config{'basepath'}$config{'regdir'}/$firstbid[0].dat")); print REGFILE "\n$cat$newname"; close REGFILE; } else { print qq|Please notify the site admin that this item cannot be removed even though it is closed.\n| unless unlink("$config{'basepath'}$cat/$item.dat"); } } } #-############################################# # Sub: Display All Buy-it Now Items # This will display all open auction's using # the Buy-it Now bid function. sub allbuynow { print qq|

Buy-it Now Auctions

\n|; print qq|\n|; print qq|\n|; my $key; foreach $key (sort keys %category) { opendir THEDIR, "$config{'basepath'}$key" or &oops("Category directory $key could not be opened."); my @allfiles = grep -T, map "$config{'basepath'}$key/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$key\///; $file =~ s/\.dat$//; my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($key,$file); my @lastbid = &read_bid($bids[$#bids]); if (($buyit > 0) && ($bids[0]) eq ($bids[$#bids])) { my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); # read last bid my @closetime = localtime($file); $closetime[4]++; my @firstbid = &read_bid($bids[0]); print qq|\n|; } } } print qq|
ItemClosesBuy Now Price
$title |; print qq| [PIC]| if ($image); print qq|$closetime[4]/$closetime[3]\$$buyit
\n|; } #-############################################# # Sub: Pagebreak by Tetramin # This displays pagebreak links sub pagebreak{ my $begin = "
"; my $next = "Next Page >>"; my $nonext = "Next Page >>"; my $previous = "<< Previous Page"; my $noprevious = "<< Previous Page"; my $end = "
"; goto &pagebreak_secure if ($form{PASSWORD} || $form{password}); my $urlfragment; foreach (keys %form) { next if ($_ eq 'pb' || $_ eq 'page'); my $f = $form{$_}; $f =~ s/(\W)/'%'.unpack("H2", $1)/eg; $urlfragment.='&' if $urlfragment; $urlfragment.="$_=$f"; } my($pcount, $pagebreak) = @_; # Print Pagebreak Links print $begin; if ($form{page} > 0) { print " $previous " } else { print " $noprevious " } print "|"; for (0 .. $form{page}-1) { print " @{[$_+1]} " } print " ", int($form{page})+1, " "; for ($form{page} + 1 .. $pcount) { print " @{[$_+1]} " } print "|"; if ($form{page} < $pcount) { print " $next " } else { print " $nonext " } print $end; } sub pagebreak_secure { my $hidden; my $method = 'get'; foreach (keys %form){ next if($_ eq 'pb' || $_ eq 'page'); $method = 'post' if (lc $_ eq 'password'); my $f = $form{$_}; $f =~ s/&/&/g; $f =~ s/"/"/g; $f =~ s/>/>/g; $hidden .= "\n"; } my($pcount, $pagebreak) = @_; my $numpages = $pcount + 1; my $currentpage = $form{page} + 1; my $options = join "", (map "", 0 .. $pcount); my $retval = < $hidden
Page $currentpage/$numpages View page:
EOF return $retval if ($_[2]); print $retval; } ##################################### sub viewfeed { my $usernam; $usernam = $form{'user'}; $usernam = lc($usernam); $usernam = ucfirst($usernam); &check_feed($usernam); print feed_summary($usernam); print <<"EOF";
$usernam 's feedback
leave feedback $usernam was the Seller = S
for $usernam $usernam was the Buyer = B
EOF if ( -e "$config{'basepath'}$config{'feeddir'}/$usernam.feed" ) { open (CFEED, "$config{'basepath'}$config{'feeddir'}/$usernam.feed"); my @readfeed = ; close(CFEED); my $rcount = 0; my $pagebreak = int $form{pb} || ($config{'feedbreak'} + 1); my ($icount, $pcount) = (0,0); foreach my $feed (reverse@readfeed) { if(++$icount > $pagebreak){$icount=1; $pcount++} next if $pcount != $form{page}; my ($user, $date, $stat, $comment, $itemno, $type) = split /:::/, $feed; my $stater; $stater = "Praise" if ($stat eq "1"); $stater = "Neutral" if ($stat eq "2"); $stater = "Negative" if ($stat eq "3"); my $itemrowcolor; if ($rcount % 2 == 1) { $itemrowcolor=$config{'coloroddrow'} } else { $itemrowcolor=$config{'colorevenrow'} } $rcount++; my $currdate = localtime($date); my $showfeed = &get_feed_info($user); if ($user ne "0") { print <<"EOF"; EOF } } print "
Left by Date Item# S/B
$showfeed $currdate $itemno $type
$stater:$comment

"; if ($rcount == 1){ print "
$usernam has no feedback yet

"; } pagebreak($pcount,$pagebreak); } } ################################# # Sub : Feedback Summary # Author: Millennium 06-15-02 # displays a summary of feedbacks at the top of # the feedback page. sub feed_summary { my $fuser = $_[0]; my (@readfeed,$posf,$negf,$neuf,$totalf); if ( -e "$config{'basepath'}$config{'feeddir'}/$fuser.feed" ) { open (CFEED, "$config{'basepath'}$config{'feeddir'}/$fuser.feed"); @readfeed = ; close(CFEED); } my $showfeed = &get_feed_info($fuser); ($posf, $negf, $neuf, $totalf) = (0,0,0,0); foreach my $feed (@readfeed) { my ($user, $date, $stat, $comment, $itemno, $type) = split /:::/, $feed; $posf++ if ($stat == 1); $negf++ if ($stat == 3); $neuf++ if ($stat == 2); } $totalf = ($posf + $negf + $neuf); my $feedrating = ($posf - $negf); my $feed_summary_html = qq~
$fuser has a feedback rating of $feedrating.
Feedback ratings are calculated by adding all positive comments and subtracting any negative comments. Neutral comments do not affect a users rating. See the summary for a breakdown of all comments including neutrals. Scroll down to read comments left by others for $fuser.
$fuser 's Profile   $showfeed
Feedback Summary
Positive $posf
Negative $negf
Neutral $neuf
Total $totalf
~; return($feed_summary_html); } #################################################################### sub get_feed_info { my ($user, @ccu, $chk, $bb, $bb1, $bb2, $bb3, $r1, $r2, $r3); $user = $_[0]; $user = lc($user); $user = ucfirst($user); if ( -e "$config{'basepath'}$config{'feeddir'}/$user.feed" ) { open (CNT, "$config{'basepath'}$config{'feeddir'}/$user.feed"); while () { @ccu = ; } close (CNT); $chk = 0; foreach $bb (@ccu) { ($bb1, $bb2, $bb3) = split /:::/, $bb; if ($bb3 == 1) { $chk++;} elsif ($bb3 == 3) { $chk--;} } } else { $chk = 0; }+ $r1; my($password, $email, $add1, $add2, $add3, @past_bids) = &read_reg_file($user); $r1 = "$user" if ($config{'linkemail'} eq "1"); $r1 = "$user" if ($config{'linkemail'} eq "0"); $r2 = "\($chk\)"; $r3 = ""; if ($chk >= 10 && $chk < 51) {$r3 = "\"10-50\"";} if ($chk >= 51 && $chk < 101) {$r3 = "\"51-100\"";} if ($chk >= 101 && $chk < 501) {$r3 = "\"101-500\"";} if ($chk >= 501 && $chk < 1001) {$r3 = "\"501-1000\"";} if ($chk >= 1001) {$r3 = "\"Over";} return "$r1 $r2 $r3"; } ################################# sub check_feed { my $user = $_[0]; $user = (ucfirst(lc($user))); umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$config{'feeddir'}", 0777) unless (-d "$config{'basepath'}$config{'feeddir'}"); unless (-f "$config{'basepath'}$config{'feeddir'}/$user.feed") { &oops('We were unable to write to the user directory.') unless (open NEWFEED, ">$config{'basepath'}$config{'feeddir'}/$user.feed"); if ($config{'flock'}) { flock(NEWFEED, 2); seek(NEWFEED, 0, 2); } print NEWFEED "0:::0:::0:::0:::0:::0" . "\n"; close NEWFEED; chmod 0777, "$config{'basepath'}$config{'feeddir'}/$user.feed"; } } ################################# # Displays Closed item sub view_feed_closed { opendir (THEDIR, "$config{'basepath'}$config{'closedir'}") || &oops("Unable to open the closed directory"); my @allfiles; @allfiles = grep /\.dat$/, readdir THEDIR; closedir THEDIR; foreach my $file ( @allfiles ) { if ($file =~ $form{'item'}) { open (THEFILE, "$config{'basepath'}$config{'closedir'}/$file") or &oops('This item has been purged from the system.'); my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids); my $html_description = &strip_scripts(&enable_html($desc)); my $closetime = localtime($form{'item'}); print "

$title

Information
\n"; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[0]); # read first bid my $sellerfeed = &get_feed_info($alias); print ""; print "
"; print" "; print ""; print ""; print ""; my $bidderfeed = &get_feed_info($alias); print ""; print "
$title
"; print "
Offered By:$sellerfeed
[View Sellers Other Auctions]
[View Sellers Feedback]
Closed: $closetime
Number of Bids: $#bids
"; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); # read last bid print "High Bid: \$$bid
High Bidder: $bidderfeed
"; print "
Description
$html_description"; print "

"; } } } ############################################## # Sub: search_feedback # form for search for user feedback sub search_feedback { print <<"EOF";

Lookup User Feedback



Username: Enter the Username for the feedback you are looking for.

EOF } ############################################# # Sub: search_feedback2 # Processes feedback search request sub search_feedback2 { $form{'user'} = lc($form{'user'}); $form{'user'} = ucfirst($form{'user'}); if ( -e "$config{'basepath'}$config{'feeddir'}/$form{'user'}.feed" ) { &viewfeed; } else { &oops ('Username cannot be found') } } ############################################# # Sub: E-mail All Users Form # This displays a form to e-mail a message to all users sub emailusersadmin { print <
Send to All Users!


EOF } ############################################# # E-Mail all users! sub emailusers { &oops('You must be admin to send e-mail!.') unless ($form{'GATE'} eq 1); my $mailit = "Hello, This is a message from: $config{'sitename'}: \r\n\r\n$form{'MESSAGE1'} \r\n\r\nThankyou for using $config{'sitename'}"; my $file; opendir THEDIR, "$config{'basepath'}$config{'regdir'}" || die "Fehler: $!"; my @allfiles = readdir THEDIR; closedir THEDIR; foreach $file (sort { int($a) <=> int($b) } @allfiles) { if ("$config{'basepath'}$config{'regdir'}/$file" =~ /\.dat/) { open THEFILE, "$config{'basepath'}$config{'regdir'}/$file"; my ($password,$email,@junk) = ; close THEFILE; chomp($password,$email,@junk); $file =~ s/\.dat//; my $username = $file; &sendemail($email, $config{'admin_address'}, $form{'MAILHEAD'}, $mailit); print $email; } } print "

Message Transmitted!!"; } #-############################################# # Sub: Process Dutch bids sub procdutchbid { my ($password, @userbids); if ($config{'regdir'} ne "") { &oops('Your alias could not be found!') unless ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = &read_reg_file($form{'ALIAS'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); &oops('Your password is incorrect.') unless ((lc $password) eq (lc $form{'PASSWORD'})); } &oops('You must enter an alias to track your item.') unless ($form{'ALIAS'}); &oops('You must enter a valid e-mail address.') unless ($form{'EMAIL'} =~ /^.+\@.+\..+$/); &oops('You must enter a valid dutch bid amount.') unless ($form{'BID'} =~ /^(\d+\.?\d*|\.\d+)$/); $form{'BID'} = &parsebid($form{'BID'}); &oops('You must enter your full name.') unless ($form{'ADDRESS1'}); &oops('You must enter your street address.') unless ($form{'ADDRESS2'}); &oops('You must enter you city, state, and zip.') unless ($form{'ADDRESS3'}); my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'CATEGORY'},$form{'ITEM'}); &oops('The item number you entered cannot be found. Maybe it has closed or it was moved since you last loaded the page.') if $title eq ''; ######### check for bidding on own item. ### my ($selleralias, $selleremail, $sellerbid, $sellertime, $selleradd1, $selleradd2, $selleradd3) = &read_bid($bids[0]); &oops('You cannot bid on your own dutch item!') if ($selleralias eq $form{'ALIAS'}); ##### End check for bidding on own item. ############################### #### Dutch Count Quantity ###################### if(($form{'OQTY'}) > $qty) { print "

You may not bid on more items than are available!
Check quantity available, then check the number of bids.
You need to decrease the number of items that you are bidding on!

\n"; } ######### End Dutch Count Quantity ############# my ($alias, $email, $bid, $time, $add1, $add2, $add3, $oqty, $soldqty) = &read_bid($bids[$#bids]); ######### Dutch Sold Count ############# oops('

All dutch items are sold! Or you need to decrease
the number of items that you are bidding on!

') if (($soldqty+$form{'OQTY'}) > $qty); ######### End Dutch Sold Count ############# if ((time <= $form{'ITEM'}) or (time <= (60 * $config{'aftermin'} + $time))) { oops('

Your bid is too low. Sorry.

') if ($form{'BID'} < ($bid) and ($#bids)) or ($form{'BID'} < $bid); &oops('We are unable to append your bid to the auction item. It appears to be a file write problem.') unless (open NEW, ">>$config{'basepath'}$form{'CATEGORY'}/$form{'ITEM'}.dat"); if ($config{'flock'}) { flock(NEW, 2); seek(NEW, 0, 2); } $form{'SOLDQTY'} = $soldqty+$form{'OQTY'}; print NEW "\n$form{'ALIAS'}\[\]$form{'EMAIL'}\[\]$form{'BID'}\[\]".time."\[\]$form{'ADDRESS1'}\[\]$form{'ADDRESS2'}\[\]$form{'ADDRESS3'}\[\]$form{'OQTY'}\[\]$form{'SOLDQTY'}"; close NEW; print "$form{'ALIAS'}, your bid has been placed on item number $form{'ITEM'} for \$$form{'BID'} on ".scalar(localtime(time)).".
You may want to print this notice as confirmation of your bid.

Go back to the item\n"; my $flag=0; my $userbid; foreach $userbid (@userbids) { $flag=1 if ("$form{'CATEGORY'}$form{'ITEM'}" eq $userbid); } if ($flag==0 && $config{'regdir'} ne "") { &oops('We could not open the registration file. This could be a server write issue.') unless (open(REGFILE, ">>$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")); print REGFILE "\n$form{'CATEGORY'}$form{'ITEM'}"; close REGFILE; } #### Sends the buyer and seller the Dutch Bids my @lastbid = &read_bid($bids[$#bids]); my @firstbid = &read_bid($bids[0]); &sendemail($firstbid[1], $config{'admin_address'}, 'New Dutch Bid!', "$firstbid[4] and $lastbid[4]\n Dutch Item Title: $title Auction number $form{'ITEM'} Category:$form{'CATEGORY'} Item Description: $desc\n Information: Seller User ID: $selleralias Seller E-mail: $selleremail New Bidders User ID: $form{'ALIAS'} Bidders E-Mail: $form{'EMAIL'} DUTCH price: \$$form{'BID'} Quantity bidded on: $form{'OQTY'}\n If you want to view the bid, please visit: $config{'scripturl'}$ENV{'SCRIPT_NAME'}\?category=$form{'CATEGORY'}\&item=$form{'ITEM'}\n Now What? The buyer and seller should contact each other within three business days to complete the sale. Not getting in touch leaves the contract open and can earn you negative feedback.\n We hope you have enjoyed using the $config{'sitename'} and will come back often."); &sendemail($lastbid[1], $config{'admin_address'}, 'Your Dutch Bid!', "$firstbid[4] and $lastbid[4]\n Dutch Item Title: $title Auction number $form{'ITEM'} Category:$form{'CATEGORY'} Item Description: $desc\n Information: Seller User ID: $selleralias Seller E-mail: $selleremail New Bidders User ID: $form{'ALIAS'} Bidders E-Mail: $form{'EMAIL'} DUTCH price: \$$form{'BID'} Quantity bidded on: $form{'OQTY'}\n If you want to view you bid, please visit: $config{'scripturl'}$ENV{'SCRIPT_NAME'}\?category=$form{'CATEGORY'}\&item=$form{'ITEM'}\n Now What? The buyer and seller should contact each other within three business days to complete the sale. Not getting in touch leaves the contract open and can earn you negative feedback.\n We hope you have enjoyed using the $config{'sitename'} and will come back often."); #### End Sends the buyer and seller the Dutch Bids } else { print "Item number $form{'ITEM'} in category $form{'CATEGORY'} is now closed!
Sorry...\n"; } } ############################################## # Sub: forgot # form for requesting username/password sub forgot { print <<"EOF";

Information Request Form



E-Mail Address: Enter your Email address you gave us at registration and your username and password will emailed to you.

EOF } ############################################# # Sub: forgot2 # processes forgotten username/password sub forgot2 { my $file; &oops('You must enter a valid e-mail address.') unless ($form{'EMAIL'} =~ /^.+\@.+\..+$/); opendir THEDIR, "$config{'basepath'}$config{'regdir'}" || die "Unable to open directory: $!"; my @allfiles = readdir THEDIR; closedir THEDIR; my $found = 0; foreach $file (sort { int($a) <=> int($b) } @allfiles) { if ("$config{'basepath'}$config{'regdir'}/$file" =~ /\.dat$/) { open THEFILE, "$config{'basepath'}$config{'regdir'}/$file"; my ($password,$email,@blah) = ; close THEFILE; chomp($password,$email,@blah); if ($form{'EMAIL'} =~ m/$email/i) { $found = 1; $file =~ s/\.dat//; my $username = $file; &sendemail($email, $config{'admin_address'}, "Auction Username/Password Request", "Our system has received a request for your Username and Password, due to it being forgotten.\n\nYour Username is: $username \n\nYour password is: $password \n\nPlease click here to return: $config{'scripturl'}/$ENV{'SCRIPT_NAME'}\n\n\n Thank you for using $config{'sitename'}!"); print "
Please check your email. Your information has been sent.

"; last; } } } &oops("The e-mail address you entered: $form{'EMAIL'} is not in the database") unless $found == 1; } ########################################### # Sub: User Agreement # User must read the agreement and accept before actually being registered to your # auction. sub user { print "
"; print ""; print ""; print "
User Agreement between you and $config{'sitename'}
"; print "
THE FOLLOWING IS THE USER AGREEMENT AS PRESENTED BY $config{'sitename'}. YOU MUST AGREE TO THESE TERMS BEFORE YOU WILL BE ABLE TO POST ITEMS, OR BID ON THEM. IF YOU DO NOT ACCEPT THESE TERMS, PLEASE, DO NOT USE OUR SERVICES. ONCE YOU CLICK THE I ACCEPT BUTTON BELOW, YOU AGREE TO THESE SAID TERMS OF THE USER AGREEMENT BELOW.

"; print "Article 1. Eligibility of membership - This auction site is only available to people who are legally able to form binding contracts with you and the seller/buyer of an auction item. People who are of under age of 18 are not eligible for membership due to security precautions that can result as of those members. If you do not meet these requirements, you are not eligible to use these auction services.

"; print "Article 2. $config{'sitename'} is only providing auction services - We only provide services to people interested in selling and buying merchandise via Internet auction. We do not have control over the items that are posted in the auction site, and cannot guarantee the authenticity and quality of a said product. We are not responsible for the actions the sellers takes, before, during, and after the auction, typographical errors, misprints, loss of merchandise/money, damage or failure of equipment, due to your visit to this auction site. Use of this site is at your own risk, and content is presented 'As-Is'.

"; print "Article 3. Bidding and Selling - As a user, you may bid and/or sell merchandise over $config{'sitename'}. As a bidder, you know that placing a bid is a binding contract with you and the seller, and the bid cannot be retracted unless due to fault by the seller of typographical error, or other error, due to human error on the seller's part. Once you place a bid, and if you win, you will be obligated to buy the product at the said price you indicated as your bid. Placing a bid on this auction site, and winning, then not paying for the product is illegal in most states, and prosecution can result to you. As a seller, the item that you place up for bids must be real. Pre-sales are accepted. Once a bid has been placed for your item, you are being placed in a binding contract with the potential buyer of the product, if that bid shall be the highest bid. Once the auction is over, if over reserve price, you are obligated to sell to the potential buyer which is the highest bidder in your auction. If, reserve price was not met, you are not obligated in any way to sell this item at all. As a seller, you are not in any way to bid on your own items. If reported, your auction will be deleted.

"; print "Article 4. Posting Items - As a user, you are welcome to post items up for sale in the $config{'sitename'}. We do have restrictions on what items you may sell, and what you may not sell. You may not sell illegal merchandise, including pirated software and music, firearms, adult videos, or anything that is affiliated with pornography, etc. Items that are up to bids are subject to review by the staff of $config{'sitename'}, and may be removed without prior notice, if in violation with the User Agreement.

"; print "Article 5. Charges - Posting an item up for bid, bidding on an item, and registering are free on this server. Do not abuse this privilege.

"; print "Article 6. Privacy - We gather your information so that other people will have it on hand when they win your auction, or you win their auction. Personal information is not sold, rented, without your permission. Personal information sent to a user regarding a product bought or sold on the auction is not to be used for any other purpose, except for communication with the auction item.

"; print "Article 7. Warranty - $config{'sitename'} provide this web site in an 'as-is' condition, without a warranty or condition. $config{'sitename'} is not liable for any damages resulting in an auction, or your visit to the site.

"; print "

By Pressing I Accept, You Agree to these terms listed above.
"; print "

"; print "

"; } sub displistnew { print "

$category{$form{'category'}} \n"; print "NEW | "; print "What's HOT | "; #-# print "What's NOT | "; print "Closing Today | "; print "Going, Going, GONE | "; print "

"; print "\n"; print "\n"; opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("Category directory $form{'category'} could not be opened."); my @allfiles = grep -T, map "$config{'basepath'}$form{'category'}/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$form{'category'}\///; $file =~ s/\.dat$//; if (my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$file)) { my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); my ($selleralias, $selleremail, $sellerbid, $sellertime, $selleradd1, $selleradd2, $selleradd3) = &read_bid($bids[0]); if (($sellertime + (86400 * $config{'newdays'})) > time){ my @closetime = localtime($file); $closetime[4]++; print "\n"; } } } print "
ItemClosesNum BidsHigh Bid
$title"; print " " if (($sellertime + (86400 * $config{'newdays'})) > time); print " " if ($image); print " " if ($#bids >= $config{'hotnum'}); #-# print " " if ($#bids <= $config{'nothot'}); print "$closetime[4]/$closetime[3]$#bids\$$bid
\n"; } #-############################################# # Sub: Display List Of HOT Items # This creates a "nice" list of items in a # category. sub displisthot { print "

$category{$form{'category'}} \n"; print "NEW | "; print "What's HOT | "; #-# print "What's NOT | "; print "Closing Today | "; print "Going, Going, GONE | "; print "

"; print "\n"; print "\n"; opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("Category directory $form{'category'} could not be opened."); my @allfiles = grep -T, map "$config{'basepath'}$form{'category'}/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$form{'category'}\///; $file =~ s/\.dat$//; if (my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$file)) { if ($#bids >= $config{'hotnum'}){ my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); my ($selleralias, $selleremail, $sellerbid, $sellertime, $selleradd1, $selleradd2, $selleradd3) = &read_bid($bids[0]); my @closetime = localtime($file); $closetime[4]++; print "\n"; } } } print "
ItemClosesNum BidsHigh Bid
$title"; print " " if (($sellertime + (86400 * $config{'newdays'})) > time); print " " if ($image); print " " if ($#bids >= $config{'hotnum'}); #-# print " " if ($#bids <= $config{'nothot'}); print "$closetime[4]/$closetime[3]$#bids\$$bid
\n"; } #-############################################# # Sub: Display List Of Going Items # This creates a "nice" list of items in a # category. sub displistgone { print "

$category{$form{'category'}} \n"; print "NEW | "; print "What's HOT | "; #-# print "What's NOT | "; print "Closing Today | "; print "Going, Going, GONE | "; print "

"; print "\n"; print "\n"; opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("Category directory $form{'category'} could not be opened."); my @allfiles = grep -T, map "$config{'basepath'}$form{'category'}/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$form{'category'}\///; $file =~ s/\.dat$//; if ($file < (time + (3600 * $config{'goinghours'}))){ if (my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$file)) { my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); my ($selleralias, $selleremail, $sellerbid, $sellertime, $selleradd1, $selleradd2, $selleradd3) = &read_bid($bids[0]); my @closetime = localtime($file); $closetime[4]++; print "\n"; } } } print "
ItemClosesNum BidsHigh Bid
$title"; print " " if (($sellertime + (86400 * $config{'newdays'})) > time); print " " if ($image); print " " if ($#bids >= $config{'hotnum'}); #-# print " " if ($#bids <= $config{'nothot'}); print "$closetime[4]/$closetime[3]$#bids\$$bid
\n"; } #-############################################# # Sub: Display List Of Items Closing Today # This creates a "nice" list of items in a # category. sub displistclose { print "

$category{$form{'category'}} \n"; print "NEW | "; print "What's HOT | "; #-# print "What's NOT | "; print "Closing Today | "; print "Going, Going, GONE | "; print "

"; print "\n"; print "\n"; opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("Category directory $form{'category'} could not be opened."); my @allfiles = grep -T, map "$config{'basepath'}$form{'category'}/$_", sort { int($a) <=> int($b) } (readdir THEDIR); closedir THEDIR; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$form{'category'}\///; $file =~ s/\.dat$//; if ($file < (time + 86400)) { if (my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$file)) { my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); my ($selleralias, $selleremail, $sellerbid, $sellertime, $selleradd1, $selleradd2, $selleradd3) = &read_bid($bids[0]); my @closetime = localtime($file); $closetime[4]++; print "\n"; } } } print "
ItemClosesNum BidsHigh Bid
$title"; print " " if (($sellertime + (86400 * $config{'newdays'})) > time); print " " if ($image); print " " if ($#bids >= $config{'hotnum'}); #-# print " " if ($#bids <= $config{'nothot'}); print "$closetime[4]/$closetime[3]$#bids\$$bid
\n"; } #-#-############################################# #-# Sub: Display List Of Items that are NOT! #-# This creates a "nice" list of items in a #-# category. #-# #-#sub displistnothot { #-# print "

$category{$form{'category'}} \n"; #-# print "NEW | "; #-# print "What's HOT | "; #-# print "What's NOT | "; #-# print "Closing Today | "; #-# print "Going, Going, GONE | "; #-# print "

"; #-# print "\n"; #-# print "\n"; #-# opendir THEDIR, "$config{'basepath'}$form{'category'}" or &oops("Category directory $form{'category'} could not be opened."); #-# my @allfiles = grep -T, map "$config{'basepath'}$form{'category'}/$_", sort { int($a) <=> int($b) } (readdir THEDIR); #-# closedir THEDIR; #-# my $file; #-# foreach $file (@allfiles) { #-# $file =~ s/^$config{'basepath'}$form{'category'}\///; #-# $file =~ s/\.dat$//; #-# if (my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$file)) { #-# if ($#bids >= $config{'hotnum'}){ #-# my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[$#bids]); #-# my ($selleralias, $selleremail, $sellerbid, $sellertime, $selleradd1, $selleradd2, $selleradd3) = &read_bid($bids[0]); #-# my @closetime = localtime($file); #-# $closetime[4]++; #-# print "\n"; #-# } #-# } #-# } #-# print "
ItemClosesNum BidsHigh Bid
$title"; #-# print " " if (($sellertime + (86400 * $config{'newdays'})) > time); #-# print " " if ($image); #-# print " " if ($#bids >= $config{'hotnum'}); #-# print " " if ($#bids <= $config{'nothot'}); #-# print "$closetime[4]/$closetime[3]$#bids\$$bid
\n"; #-#} ############################################### # Sub My Ads Login # Login form for Viewing my ads sub myad{ print <<"EOF";

My $config{'sitename'}

Your Username: ** Required **
Your Password: ** Required **
View Active Bids
EOF } #copy and paste this into your script ############################################### # Sub: View my bids # This displays listings that Alias have the bid on sub mybids { &oops('You must enter an alias that consists of alphanumeric characters.') if $form{'ALIAS'} =~ /\W/ or !($form{'ALIAS'}); $form{'ALIAS'} =~ s/\W//g; $form{'ALIAS'} = lc($form{'ALIAS'}); $form{'ALIAS'} = ucfirst($form{'ALIAS'}); &oops('Your ALIAS does not exist') unless (open(REGFILE, "$config{'basepath'}$config{'regdir'}/$form{'ALIAS'}.dat")); my ($password,$email,$add1,$add2,$add3,$phone1,$phone2,$phone3,@junk) = ; chomp($password,$email,$add1,$add2,$add3,$phone1,$phone2,$phone3,@junk); close REGFILE; &oops('Your password is incorrect.') if $form{'PASSWORD'} ne $password; print "

Listings $form{'ALIAS'} has bid on:

\n"; print "
 

"; print "\n"; print "\n"; my $key; foreach $key (sort keys %category) { opendir THEDIR, "$config{'basepath'}$key" || die "Unable to open directory: $!"; my @allfiles = readdir THEDIR; closedir THEDIR; my $file; foreach $file (sort { int($a) <=> int($b) } @allfiles) { if (-T "$config{'basepath'}$key/$file") { open THEFILE, "$config{'basepath'}$key/$file"; my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = ; close THEFILE; chomp ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids); my @lastbid = split(/\[\]/,$bids[$#bids]); $file =~ s/\.dat//; shift @bids; # remove the first bid (start bid) foreach my $bid (@bids) { my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone1, $phone2, $phone3) = &read_bid($bid); my @closetime = localtime($file); $closetime[4]++; my @firstbid = &read_bid($bids[0]); my $timediff = ($file - time); print "" if ($form{'ALIAS'} eq $alias); print " "if ($form{'ALIAS'} eq $alias && ($bid eq $lastbid[2])); print " "if ($form{'ALIAS'} eq $alias && ($bid ne $lastbid[2])); print "\n"if ($form{'ALIAS'} eq $alias && ($bid eq $lastbid[2])); print "\n"if ($form{'ALIAS'} eq $alias && ($bid ne $lastbid[2])); print " "if ($form{'ALIAS'} eq $alias && ($bid eq $lastbid[2])); print ""if ($form{'ALIAS'} eq $alias && ($bid ne $lastbid[2])); } } } } print "
ItemMy BidHigh BidStatus
$title" if ($form{'ALIAS'} eq $alias && ($bid eq $lastbid[2])); print "
$title" if ($form{'ALIAS'} eq $alias && ($bid ne $lastbid[2])); print "   $config{'imageiconpath'}" if ($image && ($form{'ALIAS'} eq $alias)); print "   $config{'hoticonpath'} " if ($config{'hotitemnum'} <= $#bids && ($form{'ALIAS'} eq $alias)); print "   $config{'newiconpath'} " if (time<($config{'newdays'} * 86400 + $firstbid[3]) && ($form{'ALIAS'} eq $alias)) ; print "   $config{'endiconpath'} " if ($timediff<($config{'endhours'} * 3600) && ($form{'ALIAS'} eq $alias)); print "   $config{'auctionicon'} " if ($type eq 'Auction' && ($form{'ALIAS'} eq $alias)); print "   $config{'classicon'} " if ($type eq 'Classified' && ($form{'ALIAS'} eq $alias)); print "   $config{'wantedicon'} " if ($type eq 'Wanted' && ($form{'ALIAS'} eq $alias)); print "\$ $bid\$ $bid\$ $lastbid[2]\$ $lastbid[2]$config{'highbiddericon'}
Out Bid
"; print "
 
"; } sub ask { umask(000); mkdir("$config{'basepath'}ask", 0777) unless (-d "$config{'basepath'}ask"); my ($title, $reserve, $inc, $desc, $image, $grabber, $catfeat, $buyit, $bold, $dutch, $qty, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, $pay7, $pay8, @bids) = &read_item_file($form{'category'},$form{'item'}); my ($alias, $email, $bid, $time, $add1, $add2, $add3) = &read_bid($bids[0]); my $time=localtime(time); &oops('You must enter your username.') if $form{'ALIAS'} =~ /\W/ or !($form{'ALIAS'}); my $password; my @userbids; &oops('Your alias could not be found!') unless ($password, $form{'EMAIL'}, $form{'ADDRESS1'}, $form{'ADDRESS2'}, $form{'ADDRESS3'}, @userbids) = &read_reg_file($form{'ALIAS'}); $form{'ALIAS'} = ucfirst(lc($form{'ALIAS'})); $alias = ucfirst(lc($alias)); &oops('Your password is incorrect.') unless ((lc $password) eq (lc $form{'PASSWORD'})); &oops('You must enter a question or answer.') if (!($form{'question'})); &oops('We are unable to post your question or answer. This could be a write permissions problem.') unless (open (NEW, ">>$config{'basepath'}ask/$form{'category'}:$form{'item'}.txt")); if ($alias ne $form{'ALIAS'}) { print NEW "Question about this item from $form{'ALIAS'}
\n$time
\n$form{'question'}

\n\n"; close NEW; &sendemail($email, $config{'admin_address'}, "A question about item $title", "A buyer has posted a question about item $title.\r\n\r\nTo respond to go to\r\nhttp://$config{'scripturl'}/cgi-bin/auction.pl?category=$form{'category'}\&item=$form{'item'}\r\n\r\nThanks for using $config{'sitename'}!"); print "
Question posted

Return to item page."; } if ($alias eq $form{'ALIAS'}) { print NEW "Response from $form{'ALIAS'} (seller)
\n$time
\n$form{'question'}

\n\n"; close NEW; print "
Response posted

Return to item page."; } }