$config{'sitename'}

"; print "

"; print ""; print "

"; print "

Description

$html_description"; print "

"; print "

"; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print ""; print "

Item Condition

$itmcond

Will Ship To

$shipto

Shipping Method

$ship

Payment Options

"; print "| $pay0 | " if $pay0 ne "" ; print "| $pay1 | " if $pay1 ne "" ; print "| $pay2 | " if $pay2 ne "" ; print "| $pay3 | " if $pay3 ne "" ; print "| $pay4 | " if $pay4 ne "" ; print "| $pay5 | " if $pay5 ne "" ; ## print "| $pay6 | " if $pay6 ne "" ; print "

"; print ""; print "

"; print "

Bid History
"; my $lowest_new_bid; if ($#bids) { ## for (my $i=1; $i= 1; $i--) { ## Reverse Bid History ## my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &read_bid($bids[$i]); my $bidtime = localtime($time); my $bidderfeed = &get_feed_info($alias); ## print "$bidderfeed $$bidtime$ - $config{'currency'}$bid
"; print "$alias $$bidtime$ - $config{'currency'}$bid"; if ($time=~/\#beaten/) {print " - beaten by a proxy bid\n"} print "

"; } $lowest_new_bid = &parsebid($bid+$inc); } else { print "No bids yet...
"; $lowest_new_bid = (&read_bid($bids[0]))[2]; } if($config{'loginalias'} ne 'Guest' && $config{'loginalias'} ne '') { print ""; print ""; print "

"; print "

Ask a Question

Ask the seller a question about this item
Questions and answers will be posted below

"; print "

"; print "
"; print ""; print ""; 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"; } } } # either the item is closed or we will display a bid form my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = read_bid($bids[$#bids]); # read the last bid my $lowest_new_bid; $lowest_new_bid = parsebid($bid+$inc); #-#### Stuart's Closed Auction Viewer if (((time > int($form{'item'})) && (time > (60 * $config{'aftermin'} + $time))) || ($closed)) { print qq|

BIDDING IS NOW CLOSED

|; &closeit($form{'category'},$form{'item'}) unless ($closed); print qq|If you were the item seller or the winning bidder you may view additional information using our closed item viewer
|; #-#### END Stuart's Closed Auction Viewer } else { if($config{'loginalias'} ne 'Guest' && $config{'loginalias'} ne '') { if ($bid <= $buyit) { #-#### Buy-It-Now my @lastbid = &read_bid($bids[$#bids]); my @firstbid = &read_bid($bids[0]); print "

Buy Now

Buy-it Now: $config{'currency'}$buyit"; print "

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.

"; print "

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.

"; print "

$\"link\"$ Buy Now

" if (($buyit ne "") & ($bid < $buyit)); #-#### END Buy-It-Now } print qq|

Place A Bid

The High Bid Is: $config{'currency'}$bid
The Lowest You May Bid Is: $config{'currency'}$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 places, 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!

|; if ($config{'regdir'}) { print qq|

Your Handle/alias: (used to track your bid)
Your password: (must be valid)
Your Highest Bid:$config{'currency'}

|; } else { print qq|

Your Handle/alias: (used to track your bid)
Your E-Mail Address:
Your Bid: $config{'currency'}

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

Street Address:

Town, County, Postal Code:

Phone:

|; } print qq|

|; print "

"; } } } #-############################################# # Sub: Add New Item # This allows a new item to be put up for sale sub new { my $alias = $config{'loginalias'}; my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids); my $inc = '1.00'; # 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, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids); } } print qq|

Post A New Item

|; if ($form{'action'} eq 'uploaddone') { $form{'imageupload'} = "YES"; if ($form{'extension'} ne '') { print ""; } $image = $form{'image'}; print ""; } else { $form{'imageupload'} = "NO"; print ""; $image = $form{'pictureurl'} if $form{'pictureurl'}; } print "

Image: "; print "" if $form{'image'}; print "" if !$form{'image'}; print "

" if $form{'pictureurl'}; print qq|

Title/Item Name:
No HTML

Category:
Select One

Days Until Close:
Length of time for the auction to remain open:

Description:
May include HTML - This should include the condition of the item, payment and shipping information, and any other information the buyer should know.

Item Condition:

Will Ship To:

Shipping Method:

Payment Method(s):
Choose all payment methods you will accept. (Double click to deselect if you make a mistake)

Paypal	Cash	Cheque
Postal Order	Credit/Debit card	Bank Transfer
Any of the above

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!

|; if ($config{'regdir'}) { print qq|

Your Handle/alias:
Used to track your post

Your password:
Must be valid

Your Starting bid:

$config{'currency'}

Your Reserve Price:
You are not obligated to sell below this price. Leave blank if none.

$config{'currency'}

bid Increment:

$config{'currency'}

Buy-it Now:
Optional, this feature allows the first bidder to win the auction with a bid at this set price.

$config{'currency'}

|; } else { print qq| Your Handle/alias:
Used to track your post Your E-Mail Address:
Your Starting bid: $config{'currency'} Your Reserve Price:
You are not obligated to sell below this price. Leave blank if none. $config{'currency'} bid Increment: $config{'currency'} Buy-it Now:
Optional, this feature allows the first bidder to win the auction with a bid at this set price. $config{'currency'} Contact Information:
Will be given out only to the buyer Full Name:

Street Address:

Town, County, Postal Code:

Phone:

|; } print qq|

|; } #-############################################# # Sub: Process New Item # This processes new item to be put up for # sale from a posted form sub procnew { my ($password, $image, $image2, $item_number); my ($key, $nowtime, $closetime); my @userbids; if ($config{'regdir'} ne "") { &oops('Your alias could not be found!!!') unless ($password, $form{'email'}, $form{'address1'}, $form{'address2'}, $form{'address3'}, $form{'phone'}, @userbids) = &read_reg_file($form{'alias'}); &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); } my $check_title = $form{'title'}; my $check_desc = $form{'desc'}; my $word_filter = 0; &oops('unable to open badword file.') unless (open BADWORDFILE,"<$config{'censor'}/censor.txt"); my $info = ; close BADWORDFILE; my (@badwords) = split(/\|/,$info); my $word; foreach $word(@badwords){ $word =~ s/\s//i; $word_filter++ if (($check_title =~ /$word.*/i) || ($check_desc =~ /$word.*/i)); } if ($word_filter >=1) { &sendemail($config{'admin_address'}, $form{'email'}, 'Auction Badwordfilter', "Hello Admin,\n\n$config{'sitename'} Badword Filter active!\n\nDetails\n\nTitle: $form{'title'}\n\nText: $form{'desc'}\n\nSeller: $form{'alias'}\n\nEmail: $form{'email'}\n\n$form{'address1'}, $form{'address2'}, $form{'address3'}\n\n$form{'phone'}\n\nAuction Administration\n"); ### Adjust the online error text according to your needs ### &oops('You have used unacceptable words
please correct and refrain...') if (($check_title =~ /$word.*/i) || ($check_desc =~ /$word.*/i)); } #-#### Security Check and Remove possible violations $form{'title'} =~ s/\/\>\;/g; $form{'title'} =~ s/['\'\}\{\)$\+]//g; $form{'title'} =~ s/\s*//g; $form{'title'} =~ s/[\~\^]//g; $form{'title'} =~ s/~!/ ~!/g; $form{'title'} =~ s/<*(javascript)[^>]+>//gi; $form{'title'} =~ s/(<[\s\/]*)(script\b[^>]*>)/$1x$2/gi; $form{'title'} =~ s/<*(script)[^>]+>//gi; $form{'title'} =~ s/<*(applet)[^>]+>//gi; $form{'title'} =~ s/<*(embed)[^>]+>//gi; $form{'title'} =~ s/system\(.+//g; $form{'title'} =~ s/alert//g; $form{'title'} =~ s/param//g; $form{'title'} =~ s/hash//g; $form{'title'} =~ s/exec//g; $form{'title'} =~ s/grep//g; $form{'title'} =~ s/eval//g; $form{'desc'} =~ s/['\'\}\{$$\+]//g; $form{'desc'} =~ s/(<[\s\/]*)(script\b[^>]*>)/$1x$2/gi; $form{'desc'} =~ s/\s*//g; $form{'desc'} =~ s/[\~\^]//g; $form{'desc'} =~ s/~!/ ~!/g; $form{'desc'} =~ s/<*(javascript)[^>]+>//gi; $form{'desc'} =~ s/<*(script)[^>]+>//gi; $form{'desc'} =~ s/<*(applet)[^>]+>//gi; $form{'desc'} =~ s/<*(embed)[^>]+>//gi; $form{'desc'} =~ s/system\(.+//g; $form{'desc'} =~ s/alert//g; $form{'desc'} =~ s/param//g; $form{'desc'} =~ s/hash//g; $form{'desc'} =~ s/exec//g; $form{'desc'} =~ s/grep//g; $form{'desc'} =~ s/eval//g; $form{'image'} =~ s/['\'\}\{$\(\+]//g; $form{'image'} =~ s/(<[\s\/]*)(script\b[^>]*>)/$1x$2/gi; $form{'image'} =~ s/\s*//g; $form{'image'} =~ s/[\~\^]//g; $form{'image'} =~ s/~!/ ~!/g; $form{'image'} =~ s/<*(javascript)[^>]+>//gi; $form{'image'} =~ s/<*(script)[^>]+>//gi; $form{'image'} =~ s/<*(applet)[^>]+>//gi; $form{'image'} =~ s/<*(embed)[^>]+>//gi; $form{'image'} =~ s/system\(.+//g; $form{'image'} =~ s/alert//g; $form{'image'} =~ s/param//g; $form{'image'} =~ s/hash//g; $form{'image'} =~ s/exec//g; $form{'image'} =~ s/grep//g; $form{'image'} =~ s/eval//g; $form{'image'} =~ s/iframe//g; $form{'image'} =~ tr/a-z_A-Z0-9.:_\///cd; #-#### END Security Check &oops('You must have an item title that is up to 50 characters.') unless ($form{'title'} && (length($form{'title'}) < 51)); $form{'title'} =~ s/\/\>\;/g; &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 60.') unless (($form{'days'} > 0) and ($form{'days'} < 61)); &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($config{'loginemail'})); &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)); $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 town, county, and postal 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'}) { foreach $key (keys %form) { $form{$key} =~ s/\[greaterthansign\]/\>/gs; $form{$key} =~ s/\[lessthansign\]/\$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{'itmcond'}\n$form{'buyit'}\n$form{'shipto'}\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{'alias'}\[\]$form{'email'}\[\]".&parsebid($form{'bid'})."\[\]".time."\[\]$form{'address1'}\[\]$form{'address2'}\[\]$form{'address3'}\[\]$form{'phone'}\[\]0"; print NEW "$form{'title'}\n$form{'reserve'}\n$form{'inc'}\n$form{'desc'}\n$form{'image'}\n$form{'itmcond'}\n$form{'buyit'}\n$form{'shipto'}\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{'alias'}\[\]$form{'email'}\[\]".&parsebid($form{'bid'})."\[\]".time."\[\]$form{'address1'}\[\]$form{'address2'}\[\]$form{'address3'}\[\]$form{'phone'}\[\]0"; close NEW; # &update_ticker($form{'category'}, $item_number, $form{'title'}); if ($config{'regdir'} ne "") { #### Prune Reg File Mod by Stuart #&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; #### Replaced by: &add_reg_file($form{'alias'}, "$form{'category'}$item_number"); #### } # my $nowtime = localtime(time); my $nowtime = strftime "%a %b %d, %I:%M %p", gmtime(time + ($config{'systemtime'}* 3600 )); ### 24 Hr clock ###### #my $nowtime = localtime(time + ($config{'systemtime'}* 3600 )); # my $closetime = localtime($item_number); my $closetime = strftime "%a %b %d, %I:%M %p", gmtime($item_number + ($config{'systemtime'}* 3600 )); &sendemail($form{'email'}, $config{'admin_address'}, "Confirmation of Item Posting", "PLEASE DO NOT REPLY TO THIS E-MAIL.\r\n\r\nThank you for posting $form{'title'} on $config{'sitename'}!\r\n\r\nItem Information: \r\nTitle: $form{'title'} \r\nStarting Bid: $config{'currency'}$form{'bid'}\r\nReserve Price: $config{'currency'}$form{'reserve'}\r\n\r\nYour Item closes at $closetime\r\n\r\nYou can visit your auction by going to this url: http://www.opportunitynowhere.co.uk/cgi-bin/auction3/auction.pl?category=$form{'category'}&item=$item_number\r\n\r\nThank you for visiting!"); print "

New Item Posting confirmed

"; print "

$form{'title'} was posted under $category{$form{'category'}}...
You may want to go to

the item

to confirm placement.\n"; &sendemail($config{'admin_address'}, $config{'admin_address'}, 'New Item Listed', "NOTE TO THE ADMINISTRATOR : New Item Posting on $config{'sitename'}!\r\n\r\nALIAS: $form{'alias'}\r\n\r\nITEM:$form{'title'} was posted under $category{$form{'category'}}\r\n\r\nClick on $config{'scripturl'}$ENV{'SCRIPT_NAME'}\?category=$form{'category'}\&item=$item_number to view the item"); } else { # my $nowtime = localtime(time); my $nowtime = strftime "%a %b %d, %I:%M %p", gmtime(time + ($config{'systemtime'}* 3600 )); ### 24 Hr clock ###### #my $nowtime = localtime(time + ($config{'systemtime'}* 3600 )); # my $closetime = localtime($item_number); my $closetime = strftime "%a %b %d, %I:%M %p", gmtime($item_number + ($config{'systemtime'}* 3600 )); if ($form{'imageupload'} eq 'NO') { $image = "

\n"; undef $image if $form{'image'} eq 'http://'; undef $image if $form{'image'} eq 'NONE'; } elsif ($form{'imageupload'} eq 'YES' and $form{'image'} =~ /(\.gif$|\.jpg$)/i) { $image = "

\n"; } my $html_description = &strip_scripts(&enable_html($form{'desc'})); print "

"; print "

New Item Preview

"; print ""; print ""; print "" if ($form{'title'}); print ""; print "" if ($form{'category'}); print "" if ($form{'desc'}); print "" if ($form{'itmcond'}); print "" if ($form{'shipto'}); print "" if ($form{'ship'}); print ""; print ""; print "" if ($form{'reserve'}); print "" if ($form{'inc'}); print "" if ($form{'buyit'}); print ""; print ""; print "

Item Image:	Image is not displayed in Preview
Auction Title:	$form{'title'}
Seller Handle:	$form{'alias'}
Auction Category:	$category{$form{'category'}}
Item Description:	$html_description
Item Condition:	$form{'itmcond'}
Will Ship To:	$form{'shipto'}
Shipping Method:	$form{'ship'}
Payment Options:	"; print "\| $form{'pay0'} \| " if ($form{'pay0'}); print "\| $form{'pay1'} \| " if ($form{'pay1'}); print "\| $form{'pay2'} \| " if ($form{'pay2'}); print "\| $form{'pay3'} \| " if ($form{'pay3'}); print "\| $form{'pay4'} \| " if ($form{'pay4'}); print "\| $form{'pay5'} \| " if ($form{'pay5'}); print "\| $form{'pay6'} \| " if ($form{'pay6'}); print "
Beginning Bid:	$config{'currency'}$form{'bid'}
Reserve Price:	$config{'currency'}$form{'reserve'}
Bid Increment:	$config{'currency'}$form{'inc'}
Buy It Now Price:	$config{'currency'}$form{'buyit'}
Current Time:	$nowtime
Closes:	$closetime

"; print "

If this looks good, hit else go back and edit ! \n"; foreach my $key (keys %form) { print "\n"; print ""; } print "\n"; } } sub confirmregbid { # Allows user to their confirm regular/proxy # bid before posting my $lowbid; &oops('Your Username could not be found!!!') unless my ($password,$email,$add1,$add2,$add3,$phone,@userbids) = &read_reg_file($form{'alias'}); &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); &oops('You must enter a valid bid amount.') unless ($form{'bid'} =~ /^(\d+\.?\d*|\.\d+)$/); $form{'bid'} = &parsebid($form{'bid'}); if ($form{'bid'} < $form{'lowbid'}) { &oops("You must bid a minimum of $config{'currency'}$form{'lowbid'}."); } my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($form{'category'},$form{'item'}); &oops('The item is now closed') if $title eq ''; my @lastbid = &read_bid($bids[$#bids]); my @firstbid = &read_bid($bids[0]); if ($form{'alias'} eq $firstbid[0]) { &oops('Sellers may not bid on their own auctions'); } if ($firstbid[0] ne $lastbid[0]) { $lowbid = $lastbid[2] + $inc; $lowbid = &parsebid($lowbid); } else { $lowbid = &parsebid($lastbid[2]); } my $sellerfeed = &get_feed_info($firstbid[0]); my $seller = $firstbid[0]; print qq|

Review bid for $title $Item # $form{'item'}$

Your bid was in the amount of: $config{'currency'}$lowbid
Your maximum bid was in the amount of: $config{'currency'}$form{'bid'}

\n Before finalizing your bid:
\n 1. View comments left by other users in the Feedback Profile for the seller: $sellerfeed

\n 2. Understand the seller's payment and shipping terms and conditions.
\n Your bid means that you accept them and will comply if you are the winning bidder.

\n 3. KEEP IN MIND THAT IF YOUR MAXIMUM BID MEETS OR BEATS THE SELLERS RESERVE PRICE, YOUR BID WILL BE SET TO THE RESERVE AMOUNT

\n 4.Your maximum bid will be kept secret and the system will bid on your behalf up to your maximum bid in the event your current bid is outbid.

\n If your bid amount is correct, click the 'place bid' button below.
\n Otherwise, click here to go back and make the necessary corrections.
\n Once you place your bid, you cannot cancel it.
\n

|; print "

"; } #-############################################# # Sub: Process bid # This processes new bids from a posted form sub procbid { my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($form{'category'},$form{'item'}); # Info on Item my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &read_bid($bids[0]); # Info on Poster &oops('You cannot bid on items you posted.') if ($form{'alias'} eq $alias); my ($password, @userbids); if ($config{'regdir'} ne "") { &oops('Your alias could not be found!') unless ($password, $form{'email'}, $form{'address1'}, $form{'address2'}, $form{'address3'}, $form{'phone'}, @userbids) = &read_reg_file($form{'alias'}); &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); } &oops('You must enter an alias to track your item.') unless ($config{'loginalias'}); # &oops('You must enter a valid e-mail address.') unless (&check_email($config{'loginemail'})); &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 your town, county, and postal code.') unless ($form{'address3'}); &oops('You must enter your phone number.') unless ($form{'phone'}); my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @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,$phone) = &read_bid($bids[$#bids]); ##Start check for Seller banned email addresses my $nobid; if (open (NOTO, "$config{'basepath'}$config{'bandir'}/$form{'seller'}.txt")) { my @allnoto=; close NOTO; chomp(@allnoto); foreach $nobid (@allnoto) { if($form{'alias'} eq $nobid){ &oops(' Sorry... that seller does not allow you to bid on their auctions. '); } } } ## End check for Seller banned email addresses if ((time <= $form{'item'}) or (time <= (60 * $config{'aftermin'} + $time))) { if(($form{bid} < $bid + $inc && $#bids) || $form{bid} < $bid){ &oops("
Your bid is too low. Sorry...

Go Back to the Item

"); } &oops('Cannot update bidhistory.') unless open NEW, ">>$config{basepath}$form{category}/$form{item}.dat"; my $flag=0; my $userbid; foreach $userbid (@userbids) { $flag=1 if ("$form{'category'}$form{'item'}" eq $userbid); } 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{'phone'}"; close NEW; print "

"; print ""; print "
Your bid is placed

"; print "

$form{'alias'}, your bid has been placed on item number $form{'item'} for $config{'currency'}$form{'bid'} on ".scalar(localtime(time)).".
You may want to print this notice as confirmation of your bid.

Go back to the item\n"; if ($flag==0 && $config{'regdir'} ne "") { #### Prune Reg File Mod by Stuart #&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; #### Replaced by: &add_reg_file($form{'alias'}, "$form{'category'}$form{'item'}"); #### &sendemail($email, $config{'admin_address'}, 'You have a Bid!', "Someone just placed a bid on $title\! You can view your item at\:\r\n\r\n\thttp:// $config{'scripturl'}$ENV{'SCRIPT_NAME'}\?category=$form{'category'}\&item=$form{'item'}\r\n\r\nThe current bid is now $config{'currency'}$form{'bid'}."); } &sendemail($email, $config{'admin_address'}, 'You have been outbid!', "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 $config{'currency'}$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, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($key,$file); if ($title ne '') { my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &read_bid($bids[$#bids]); my @closetime = localtime($file); # my $closetime = strftime "%a %b %d, %I:%M %p", gmtime($item_number + ($config{'systemtime'}* 3600 )); $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 "

Item	Closes	Num bids	High bid
$title"; print " [PIC]" if ($image); print "	$closetime[3]/$closetime[4]	$#bids	$config{'currency'}$bid
$title"; print " [PIC]" if ($image); print "	$closetime[3]/$closetime[4]	$#bids	$config{'currency'}$bid

\n"; } #-############################################# # Sub: Change Registration # This allows a user to change information sub creg { print qq|

Change your contact details

This form will allow you to change your street address etc.
Your Handle/alias:
Your E-Mail Address:
Your Current password: Required for verification
Contact Information: Leave blank if unchanged	`Full Name:` `Street Address:` `Town County, Postal Code:` `Phone:`

|; } #-############################################# # 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 password so we can validate your account.') unless ($form{'password'}); 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 town, county, and postal code.') unless ($form{'address3'}); &oops('You must enter all of your contact information. Please enter your phone number.') unless ($form{'phone'}); } if (my ($password,$email,$add1,$add2,$add3,$phone,@past_bids) = &read_reg_file($form{'alias'})) { &oops('You must enter a valid e-mail address.') unless ($config{'loginemail'} =~ /^.+\@.+\..+$/); &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); $form{'address1'} = $add1 if !($form{'address1'}); $form{'address2'} = $add2 if !($form{'address2'}); $form{'address3'} = $add3 if !($form{'address3'}); $form{'phone'} = $phone if !($form{'phone'}); &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 "$password\n$email\n$form{'address1'}\n$form{'address2'}\n$form{'address3'}\n$form{'phone'}"; my $bid; foreach $bid (@past_bids) { print NEWREG "\n$bid"; } close NEWREG; print "
$form{'alias'}, your information has been successfully changed.
\n"; } else { print "
Sorry... That Username is not valid. If you do not have an alias (or cannot remember it) you should create a 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 qq|

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:
Contact Information: Will be given out only to the buyer or seller	`Full Name:` `Street Address:` `Town, County, Postal Code:`
Phone Number:

|; } #-############################################# # Sub: Prevent Double e-mail Registration # Disable email registration more then once sub MultiEmails { my $reg_email = shift; $reg_email = (lc($reg_email)); my (@allfiles, $file, $email); opendir THEDIR, "$config{'basepath'}$config{'regdir'}" || die "Unable to open directory: $!"; @allfiles = readdir THEDIR; closedir THEDIR; foreach $file (@allfiles) { if ($file =~ /\.dat/) { $file = substr($file, 0, -4); (undef, $email, undef, undef, undef, undef) = &read_reg_file($file); &oops("E-mail address is already registered in our database.") if ($reg_email eq (lc($email))); } } return(); } #-############################################# sub confirmreg { $form{'alias'} = $config{'loginalias'}; $form{'password'} = $config{'loginpassword'}; $form{'email'} = $config{'loginemail'}; if ($config{'regdir'}) { umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$config{'regdir'}", 0777) unless (-d "$config{'basepath'}$config{'regdir'}"); mkdir("$config{'basepath'}$config{'newestmember'}", 0777) unless (-d "$config{'basepath'}$config{'newestmember'}"); #-#### Security Check and Remove possible violations $form{'alias'} =~ s/[\>\<'\'\}\{\)$\%\&\+\\]//g; $form{'alias'} =~ s/alert//g; $form{'alias'} =~ s/script//g; $form{'alias'} =~ s/param//g; $form{'alias'} =~ s/HASH//g; $form{'alias'} =~ s/CGI//g; $form{'email'} =~ s/[\>\<'\'\}\{$$\%\&\+\\]//g; $form{'email'} =~ s/alert//g; $form{'email'} =~ s/script//g; $form{'email'} =~ s/param//g; $form{'email'} =~ s/HASH//g; $form{'email'} =~ s/CGI//g; $form{'address1'} =~ s/[\>\<'\'\}\{$$\%\&\+\\]//g; $form{'address1'} =~ s/alert//g; $form{'address1'} =~ s/script//g; $form{'address2'} =~ s/[\>\<'\'\}\{$$\%\&\+\\]//g; $form{'address2'} =~ s/alert//g; $form{'address2'} =~ s/script//g; $form{'address3'} =~ s/[\>\<'\'\}\{$$\%\&\+\\]//g; $form{'address3'} =~ s/alert//g; $form{'address3'} =~ s/script//g; $form{'phone'} =~ s/[\>\<'\'\}\{$\(\%\&\+]//g; $form{'phone'} =~ s/alert//g; $form{'phone'} =~ s/script//g; #-#### END Security Check my $testmail = $form{'email'}; if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ || $testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) { &oops('You must enter a valid e-mail address.'); } &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 town, county, and postal code so buyers or sellers can contact you.') unless ($form{'address3'}); &oops('You must enter a valid phone Number.') unless ($form{'phone'}); if (!(-f "$config{'basepath'}$config{'regdir'}/$form{'alias'}.dat")) { print ""; print ""; print "

Confirm your Registration

"; print qq|

Confirm your Registration Informations

Here is your account information:
Username: $form{'alias'}
Email Address: $form{'email'}
Your Full Name: $form{'address1'}
Street Address: $form{'address2'}
Town, County, Postal Code: $form{'address3'}
Phone Number: $form{'phone'}

Please make sure this information is correct. If it is click the Confirm button below.

|; print ""; print ""; print "

"; } else { print ""; print ""; print "

Registration is not confirmed

"; print "Sorry... that alias is taken. Hit back to try again!\n"; print ""; print ""; print "

"; } } else { print ""; print ""; print "

Registration is not confirmed

"; print "User Registration is Not Implemented on This Server! The System Administrator did Not Specify a Registration Directory...\n"; print ""; print ""; print "

"; } } #-############################################# # 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'}"); mkdir("$config{'basepath'}$config{'newestmember'}", 0777) unless (-d "$config{'basepath'}$config{'newestmember'}"); #-#### Security Check and Remove possible violations $form{'alias'} =~ s/[\>\<'\'\}\{\)$\%\&\+\\]//g; $form{'alias'} =~ s/alert//g; $form{'alias'} =~ s/script//g; $form{'alias'} =~ s/param//g; $form{'alias'} =~ s/HASH//g; $form{'alias'} =~ s/CGI//g; $form{'email'} =~ s/[\>\<'\'\}\{$$\%\&\+\\]//g; $form{'email'} =~ s/alert//g; $form{'email'} =~ s/script//g; $form{'email'} =~ s/param//g; $form{'email'} =~ s/HASH//g; $form{'email'} =~ s/CGI//g; $form{'address1'} =~ s/[\>\<'\'\}\{$$\%\&\+\\]//g; $form{'address1'} =~ s/alert//g; $form{'address1'} =~ s/script//g; $form{'address2'} =~ s/[\>\<'\'\}\{$$\%\&\+\\]//g; $form{'address2'} =~ s/alert//g; $form{'address2'} =~ s/script//g; $form{'address3'} =~ s/[\>\<'\'\}\{$$\%\&\+\\]//g; $form{'address3'} =~ s/alert//g; $form{'address3'} =~ s/script//g; $form{'phone'} =~ s/[\>\<'\'\}\{$\(\%\&\+]//g; $form{'phone'} =~ s/alert//g; $form{'phone'} =~ s/script//g; #-#### END Security Check my $testmail = $form{'email'}; if ($testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ || $testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) { &oops('You must enter a valid e-mail address.'); } &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 town, county, and postal code so buyers or sellers can contact you.') unless ($form{'address3'}); &oops('You must enter a Phone number so buyers or sellers can contact you.') unless ($form{'phone'}); 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 = $config{'loginpassword'}; print NEWREG "$newpass\n$form{'email'}\n$form{'address1'}\n$form{'address2'}\n$form{'address3'}\n$form{'phone'}"; close NEWREG; &check_feed($form{'alias'}); ### Feedback &oops('We were unable to write to the user directory.') unless (open NEWMEMBER, ">$config{'basepath'}$config{'newestmember'}/newmember.dat"); print NEWMEMBER "$form{'alias'}\n$form{'email'}"; close NEWMEMBER; print ""; print ""; print "

Registration successfull !

"; print "$form{'alias'}, you should receive an e-mail to $form{'email'} in a few minutes.
Thank you for registering to use the Online Auction. Happy Bidding.\n"; &sendemail($form{'email'}, $config{'admin_address'}, 'Auction Registration', "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 password is the same as your forum password\r\n\rYour alias is your forum name\r\n\r\nThank you for visiting!"); &sendemail($config{'admin_address'}, $config{'admin_address'}, 'New User Registration', "NOTE TO THE ADMINISTRATOR : A new user was registered at $config{'sitename'}!\r\n\r\nAlias: $form{'alias'}\r\n\r$form{'address1'}\r\n\r$form{'address2'}\r\n\r$form{'address3'}\r\n\r$form{'phone'}\r\n"); } else { print ""; print ""; print "

Registration was not successfull !

"; print "Sorry... that alias is taken. Hit back to try again!\n"; } } else { print ""; print ""; print "

Registration is not activated at this time !

"; print "User Registration is Not Implemented on This Server! The System Administrator Did Not Specify a Registration Directory...\n"; } } ############################################### # Sub: List All Closed Auctions # Form sub list_closed1 { my $max_days = $config{'closedays'} - 1; print <<"EOF";

List Closed Auctions

Please check a button

List all closed auctions

List auctions that closed within the last 30 days

List auctions that closed within the last 21 days

List auctions that closed within the last 14 days

List auctions that closed within the last 7 days

List Closed Auctions

"; print "\n"; print "\n"; opendir THEDIR, "$config{'basepath'}$config{'closedir'}" || 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'}$config{'closedir'}/$file") { open THEFILE, "$config{'basepath'}$config{'closedir'}/$file"; my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids); my $html_description = &strip_scripts(&enable_html($desc)); my @lastbid = split(/\[\]/,$bids[$#bids]); $file =~ s/\.dat//; $file = substr($file, -10, 10); #my $nowtime = time; my $nowtime = strftime "%a %b %d, %I:%M %p", gmtime(time + ($config{'systemtime'}* 3600 )); my @closetime = localtime($file); #my $closetime = strftime "%a %b %d, %I:%M %p", gmtime($item_number + ($config{'systemtime'}* 3600 )); $closetime[4]++; my $diff = ($nowtime - $file); if ($number_of_days == 7 && $diff < 7*86400) { print ""; } elsif ($number_of_days == 14 && $diff < 14*86400) { print ""; } elsif ($number_of_days == 21 && $diff < 21*86400) { print ""; } elsif ($number_of_days == 30 && $diff < 30*86400) { print ""; } elsif ($number_of_days == $max_days) { print ""; } } } print "

Item Number	Item	Description	Closes	Num Bids	High Bid	Reserve Price	High Bidder
$file	$title	$html_description	$closetime[4]/$closetime[3]	$#bids	$lastbid[2]	$reserve	$lastbid[0]
$file	$title	$html_description	$closetime[4]/$closetime[3]	$#bids	$lastbid[2]	$reserve	$lastbid[0]
$file	$title	$html_description	$closetime[4]/$closetime[3]	$#bids	$lastbid[2]	$reserve	$lastbid[0]
$file	$title	$html_description	$closetime[4]/$closetime[3]	$#bids	$lastbid[2]	$reserve	$lastbid[0]
$file	$title	$html_description	$closetime[4]/$closetime[3]	$#bids	$lastbid[2]	$reserve	$lastbid[0]

"; } } #-############################################# # Sub: Close Auction # This sets an item's status to closed. sub closeit { my ($cat,$item) = @_; if ($cat ne $config{'closedir'}) { my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($cat,$item); my @lastbid = &read_bid($bids[$#bids]); my @firstbid = &read_bid($bids[0]); if ($#bids) { if ($lastbid[2] >= $reserve) { &sendemail($lastbid[1], $firstbid[1], "Auction Close: ".&enable_html($title), "Congratulations! You are the winner of auction number $item.\r\nYour winning bid was $config{'currency'}$lastbid[2].\r\n\r\nPlease contact the seller to make arrangements for payment and shipping:\r\n\r\n$firstbid[4]\r\n$firstbid[5]\r\n$firstbid[6]\r\n$firstbid[1]\r\n\r\nThanks for using $config{'sitename'}!"); } else { &sendemail($lastbid[1], $firstbid[1], "Auction Close: ".&enable_html($title), "Congratulations! You were the high bidder on auction number $item.\r\nYour bid was $config{'currency'}$lastbid[2].\r\n\r\nUnfortunately, your bid did not meet the seller\'s reserve price...\r\n\r\nYou may still wish to contact the seller to negotiate a fair price:\r\n\r\n$firstbid[4]\r\n$firstbid[5]\r\n$firstbid[6]\r\n$firstbid[1]\r\n\r\nThanks for using $config{'sitename'}!"); } &sendemail($firstbid[1], $lastbid[1], "Auction Close: ".&enable_html($title), "Auction number $item is now closed.\r\nThe high bid was $config{'currency'}$lastbid[2] (your reserve was: $config{'currency'}$reserve).\r\n\r\nPlease contact the high bidder to make any necessary arrangements:\r\n\r\n$lastbid[4]\r\n$lastbid[5]\r\n$lastbid[6]\r\n$lastbid[1]\r\n\r\nThanks for using $config{'sitename'}!"); } else { &sendemail($firstbid[1], $config{'admin_address'}, "Auction Close: ".&enable_html($title), "Auction number $item is now closed.\r\nThere were no bids on your item. You may repost your item by using the closed auction manager at http://$config{'scripturl'}$ENV{'SCRIPT_NAME'}. Thanks 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'}"); 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: 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 ""; print ""; print ""; print ""; print "

Error:
$_[0]

Please hit the back browser on your browser to try again or contact the auction administrator if you belive 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 = $form{'alias'}; return '' unless $alias; # verify the user exists 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,$phone,@past_bids) = ; close FILE; chomp ($password,$email,$add1,$add2,$add3,$phone,@past_bids); return ($password,$email,$add1,$add2,$add3,$phone,@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, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = ; close FILE; chomp ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids); return ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @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, $phone) = split(/\[\]/,$bid_string); return ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone); } #-############################################# # 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 chk_suspended { opendir THEDIR, "$config{'basepath'}$config{'bannedusers'}" || die "Unable to open directory: $!"; my @allfiles = readdir THEDIR; closedir THEDIR; chomp(@allfiles); my $file; foreach $file (@allfiles) { if($config{'loginemail'} eq $file){ &oops('You have been suspended from using this auction'); } } } #-########################################### # Feedback mod sub viewfeed { my $usernam; $usernam = $form{'user'}; &check_feed($usernam); print feed_summary($usernam); print qq|

$usernam 's feedback

$\"link\"$ leave feedback for $usernam		$usernam was the Seller = S
		$usernam was the Buyer = B

|; 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 qq| |; } } print "

Left by	Date	Item#	S/B
$showfeed	$currdate	$itemno	$type
$stater:$comment

"; #if ($rcount == 1) { #print "$usernam has no feedback yet-$rcount
"; #} 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,$time,$perc,$percent,$t,$u,$v,$w,@a,@b,@c,@d,@e,@f,@y,@z,%a,%b,%c,%z,$a,$b,$c,$p,$q,$z); 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); my ($posf,$negf,$neuf,$totalf,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o)=(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); $t = time; $u = $t - (365 * 86400); $v = $t - (30 * 86400); $w = $t - (180 * 86400); foreach my $feed (@readfeed) { my ($user, $date, $stat, $comment, $itemno, $type) = split /:::/, $feed; if ($stat == 1) { if($date>$u){ $d++; push @a, $user if $config{'showunique'}; } $e++ if $date>$v; $f++ if $date>$w; push @a, $user if $config{'showunique'}; } if ($stat == 2) { if($date>$u){ $j++; push @c, $user if $config{'showunique'}; } $k++ if $date>$v; $l++ if $date>$w; } if ($stat == 3) { if($date>$u){ $g++; push @b, $user if $config{'showunique'}; } $h++ if $date>$v; $i++ if $date>$w; push @b, $user if $config{'showunique'}; } } $m = $d+$j+$g; $n = $e+$k+$h; $o = $f+$l+$i; if ($config{'showunique'}) { foreach(@a){push(@d,$_)unless($a{$_}++)} foreach(@b){push(@e,$_)unless($b{$_}++)} foreach(@c){push(@f,$_)unless($c{$_}++)} push(@y,@d,@e,@f); foreach(@y){push(@z,$_)unless($z{$_}++)} $a = @d; $b = @e; $c = @f; $z = @z; $p = " (from "; $q = " unique users)"; $a = "$p$a$q"; $b = "$p$b$q"; $c = "$p$c$q"; $z = "$p$z$q"; } if ( -e "$config{'basepath'}$config{'ratingsdir2'}/$fuser.dat" ) { open FILE, "$config{'basepath'}$config{'ratingsdir2'}/$fuser.dat"; ($posf,$neuf,$negf,$totalf) = ; close FILE; chomp($posf,$neuf,$negf,$totalf); } my $feedrating = ($posf - $negf); $perc = sprintf("%.1f", (($posf/$totalf)*100)) if ($posf && $totalf); $percent = "Positive feedback percentage: $perc\%

" if ($perc); 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.

$percent

$fuser 's Profile $showfeed Feedback Summary
	Past Month	Past 6 Months	Past Year	Total
Positive	$e	$f	$d$a	$posf
Neutral	$k	$l	$j$c	$neuf
Negative	$h	$i	$g$b	$negf
Total	$n	$o	$m$z	$totalf

~; return($feed_summary_html); } #################################################################### sub get_feed_info { my ($user, $chk, $r1, $r2, $r3); $user = $_[0]; if ( -e "$config{'basepath'}$config{'ratingsdir'}/$user.dat" ) { open (CNT, "$config{'basepath'}$config{'ratingsdir'}/$user.dat"); $chk = ; close (CNT); } else { $chk = 0; } if ($config{'linkemail'} eq "1") { my($password,$email,$add1,$add2,$add3,$phone,@past_bids) = &read_reg_file($user); $r1 = "$user" } else { $r1 = "$user" } $r2 = "($chk)"; if ($chk >= 1 && $chk < 11) {$r3 = " $\"1-10\"$ "} if ($chk >= 11 && $chk < 51) {$r3 = " $\"11-50\"$ "} if ($chk >= 51 && $chk < 101) {$r3 = " $\"51-100\"$ "} if ($chk >= 101 && $chk < 1001) {$r3 = " $\"101-1000\"$ "} if ($chk >= 1001) {$r3 = " $\"Over$ "} return "$r1 $r2 $r3"; } ################################# sub check_feed { my $user = $_[0]; umask(000); # UNIX file permission junk mkdir("$config{'basepath'}$config{'feeddir'}", 0777) unless (-d "$config{'basepath'}$config{'feeddir'}"); mkdir("$config{'basepath'}$config{'ratingsdir'}", 0777) unless (-d "$config{'basepath'}$config{'ratingsdir'}"); mkdir("$config{'basepath'}$config{'ratingsdir2'}", 0777) unless (-d "$config{'basepath'}$config{'ratingsdir2'}"); 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, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids); my $html_description = &strip_scripts(&enable_html($desc)); my $closetime = localtime($form{'item'}); # my $closetime = strftime "%a %b %d, %I:%M %p", gmtime($item_number + ($config{'systemtime'}* 3600 )); print ""; print ""; print "" if ($image); print "

$title

"; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &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

Offered By: $alias - $sellerfeed
[View Sellers Other Activities]
[View Sellers Feedback]

Closed: $closetime

Number of Bids: $#bids

"; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &read_bid($bids[$#bids]); # read last bid print "High Bid: $config{'currency'}$bid

High Bidder: $bidderfeed

"; print ""; print "

Description

$html_description"; print "

Item Condition:

$itmcond"; print "

"; } } } ############################################## # Sub: search_feedback # form for search for user feedback sub search_feedback { print qq|

Lookup User Feedback

|; } ############################################# # 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: 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 = ""; 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]} " } if($pcount>0){ print " All " } print "|"; if($form{page} < $pcount){ print " $next " } else{ print " $nonext " } print $end; } #-############################################# # 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, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($form{'category'},$form{'item'})); # my $nowtime = localtime(time); my $nowtime = strftime "%a %b %d, %I:%M %p", gmtime(time + ($config{'systemtime'}* 3600 )); ### 24 Hr clock ###### #my $nowtime = localtime(time + ($config{'systemtime'}* 3600 )); my $closetime = localtime($form{'item'}); # my $closetime = strftime "%a %b %d, %I:%M %p", gmtime($item_number + ($config{'systemtime'}* 3600 )); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &read_bid($bids[0]); # read first bid my $key; my $file; my $buyit = &parsebid($buyit); print qq| |; } #-############################################# # 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'}, $form{'phone'}, @userbids) = &read_reg_file($form{'alias'}); &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($form{'category'},$form{'item'}); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $ph) = &read_bid($bids[0]); &oops('You cannot bid on your own item.') if ($form{'alias'} eq $alias); } &oops('You must enter an alias to track your item.') unless ($form{'alias'}); &oops('You must enter a valid e-mail address.') unless ($config{'loginemail'} =~ /^.+\@.+\..+$/); &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 your town, county, and Postal code.') unless ($form{'address3'}); &oops('You must enter your phone number.') unless ($form{'phone'}); &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, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($form{'category'},$form{'item'}); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &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); my $nowtime = strftime "%a %b %d, %I:%M %p", gmtime(time + ($config{'systemtime'}* 3600 )); ### 24 Hr clock ###### #my $nowtime = localtime(time + ($config{'systemtime'}* 3600 )); 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{'phone'}"; close NEW; print qq|$form{'alias'}, you have purchased lot number #$form{'item'} for $config{'currency'}$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, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @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 the auction for $title.\nThe Buy-it Now price for $item is $config{'currency'}$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), "The item $title sold for $config{'currency'}$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'}"); 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"); } 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: 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|; print qq|\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 $rcount = 0; my $file; foreach $file (@allfiles) { $file =~ s/^$config{'basepath'}$key\///; $file =~ s/\.dat$//; my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @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, $phone) = &read_bid($bids[$#bids]); # read last bid my @closetime = localtime($file); # my $closetime = strftime "%a %b %d, %I:%M %p", gmtime($item_number + ($config{'systemtime'}* 3600 )); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &read_bid($bids[$#bids]); my ($selleralias, $selleremail, $sellerbid, $sellertime, $selleradd1, $selleradd2, $selleradd3, $sellerphone) = &read_bid($bids[0]); $closetime[4]++; my @firstbid = &read_bid($bids[0]); my $itemrowcolor; if ($rcount % 2 == 1) { $itemrowcolor=$config{'colorevenrow'} } else { $itemrowcolor=$config{'coloroddrow'} } $rcount++; print qq|\n|; print qq|\n|; } } } print qq|

Item	Status	Closes	Buy Now Price
$title\|; print qq\|	\| if (($sellertime + (86400 * $config{'newdays'})) > time); print qq\| \| if ($image); print qq\| \| if ($#bids >= $config{'hotitemnum'}); print qq\| \| if ($file < (time + $config{'endhours'} * 86400)); print qq\| \| if ($buyit > '0.00') && ($#bids eq '0'); print qq\| \| if ($reserve > '0.00') && ($reserve > $bid); print qq\| \| if ($bid >= $reserve) && ($reserve > '0.00'); # print qq\| [PIC]\| if ($image); print qq\|	$closetime[3]/$closetime[4]	$config{'currency'}$buyit

\n|; } #-############################################# # Sub: Suggest a Category form # This allows a user to suggest a category sub suggest { print qq| |; } #-############################################# # Sub: Process Category form # This process's the form sub procsuggest { if ($config{'regdir'}) { &oops('You must enter your alias so we can validate your account.') unless ($form{'alias'}); &oops('You must enter your password so we can validate your account.') unless ($form{'password'}); if ($form{'suggest'}) { &oops('You must enter a category you wish to suggest.') unless ($form{'suggest'}); } close NEWREG; print ""; print ""; print "

Suggest an Auction Category

"; print "$form{'alias'}, the Auction Administrator has been notified about your suggested category.\n"; &sendemail($config{'admin_address'}, $config{'admin_address'}, ' User has Suggested a New Category', "NOTE TO THE ADMINISTRATOR :\n The User $form{'alias'} has suggested a new category for the auction.\n The Category is: $form{'suggest'}\n" ); } } #-############################################# # Sub Contact Us # sub cu1 { print qq|
|; } #-############################################# # Sub Contact Us # sub cu2 { &oops('Please enter your name.') unless ($form{'cname'}); &oops('Please enter your email.') unless ($form{'cemail'}); &oops('Please enter a comment.') unless ($form{'ccomments'}); print qq| |; &sendemail($config{'admin_address'}, $form{'cemail'}, "FROM AUCTION - Customer Contact/Feedback", "We have recieved a $form{'ctype'} form from: $form{'cname'} at $form{'cemail'}.\n\nComments:\n\n$form{'ccomments'}"); } #-############################################# # Sub: Contact A User - form # Lets users contact each other without revealing their email sub contact { print qq| |; } #-############################################# # Sub: Contact A User - Process # Lets users contact each other without revealing their email sub proccontact { my ($password, @junk) = &read_reg_file($form{'alias'}); &oops('Your username is incorrect.') unless ($password); &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); &oops('The user you wish to contact does not exist.') unless ($form{'user'} && (-e "$config{'basepath'}reg/$form{'user'}.dat")); &oops('You must enter a message that is less than 100,000 characters.') unless ($form{'message'} && (length($form{'message'}) < 100000)); my ($password, $email, @junk) = &read_reg_file($form{'user'}); &sendemail($email, $config{'admin_address'}, "Message from a user at $config{'sitename'}", "Hello,\nA user at $config{'sitename'}, $form{'alias'}, has a question for you.\n\nThe message is the following:\n\n$form{'message'}\n\nYou may respond to $form{'alias'} using the following link:\n\nhttp://$config{'scripturl'}$ENV{'SCRIPT_NAME'}\?action=contact&alias=$form{'user'}&user=$form{'alias'}\n\nSincerely,\n$config{'sitename'}"); print "

Contact A User

"; print "Your e-mail was sucessfully sent to $form{'user'}."; } #-############################################# # Sub: User Agreement # User must read the agreement and accept before actually being registered to your # auction. sub user { print "

"; print "

Auction User Agreement

"; 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 my 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: report Fraud # This allows a user to Report Auction Fraud sub fraud { print qq| |; } #-############################################# # Sub: Process report Fraud # This allows a user to Report Auction Fraud sub procfraud { if ($config{'regdir'}) { &oops('You must enter your alias so we can validate your account.') unless ($form{'alias'}); &oops('You must enter your password so we can validate your account.') unless ($form{'password'}); if ($form{'suggest'}) { &oops('You must enter a user name you wish to report.') unless ($form{'suggest'}); } close NEWREG; print ""; print ""; print "

Report User Fraud

"; print "$form{'alias'}, the Auction Administrator has been notified about the user commiting fraud.\n"; &sendemail($config{'admin_address'}, $config{'admin_address'}, ' User reporting fraud', "NOTE TO THE ADMINISTRATOR :\n The User $form{'alias'} has reported user: $form{'fraud'} as commiting fraud\n\n$form{'desc'}\n" ); } } sub verifyuserid { print qq| |; } #-############################################# # Verifies the user id # Advanced Sell Item Verification Version 1.0 # By: Pro Z sub proc_verifyuserid { &oops('your screen name could not be found.') unless my ($password,$email,$add1,$add2,$add3,$phone,@past_bids) = &read_reg_file($form{'alias'}); &oops('your screen name could not be found!!!') unless (open(REGFILE, "$config{'basepath'}$config{'regdir'}/$form{'alias'}.dat")); my ($password,$email,$add1,$add2,$add3,$phone,@past_bids) = ; chomp($password,$email,$add1,$add2,$add3,$phone,@past_bids); close REGFILE; &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); print qq|

|; } #-############################################# sub thingstodo { print qq|

My Auction Sticky Notes

Sticky Notes

This is your Auction Sticky Note Area. You can use this to keep track of ideas, auctions etc., Your things to do. List them all here, and check back to either complete them or delete them! You may post 10 or more things to do.

Add Item

Note:To view the list you might need to refresh the page.

|; } #-############################################# # Sub: Help Screen # This is the help section # auction. sub help { print qq|

Auction Help

How to use $config{'sitename'}

This is a guide to buying and selling on $config{'sitename'}. As we believe most of the operation of the site is self-explanatory, we will try and provide a basic overview to the concepts rather than in-depth details of the operation of the site. We hope this will answer most of your questions but if not please feel free to contact us using the link at the bottom of this page!

Listing an item for Sale: Simply click on the "Post New Item" from the menu and the form will be displayed. A picture of the item will draw attention to it. Browse for the photo on your PC, click on upload and wait while the picture is stored on our site. Once this is complete, the system will add the location of the picture to the listing form (do not amend this url!). Listing an item is totally free for $config{'sitename'}. Once you've completed the details for your item just click preview and you will see your listing! If it looks how you expected just click post and it's on!

If it doesn't sell: If your closing date is reached and you have received no bids for your item, or if your reserve price is not met, then you can repost the item. Cick on closed auctions, select the right item, and you will get the option of reposting it

Topping up your account: If you list a lot of items, you will eventually have to top up your account balance. There are two ways to do this - through the referal scheme on the home page, or by using PayPal. Just view your account and you will see the PayPal facility.

Bidding for an item: Once you find an item you want it's time to bid for it! You must be registered to bid! You can choose to bid by proxy - just enter the maximum amount you want to pay along with the other details and click the bid button. $config{'sitename'} will place a bid for you which is the bid increment above the current highest bid. $config{'sitename'} will then automatically monitor the auction and will continue to bid on your behalf until your maximum is reached! So you might not even have to pay the amount you enter! You can also choose to just place one bid, in this case you just enter the amount and click the 'not by proxy' button. It's then a good idea to add the item to your watch list so you can easily log on and see the status of your bids. Of course if you can't wait and the seller has listed a 'buy-it now price, just click the 'buy-it now' link and the deal will be done there and then! Please remember in all auctions to take note of the delivery or shipping methods as there may be additional costs.

Closing the deal: When an auction is won, $config{'sitename'} puts the buyer and seller in touch by e-mail. It's then up to them to arrange payment and delivery of the goods. $config{'sitename'} does not get involved in this final stage. Please remember that both buyer and seller have agreed that by participating in the auction that the sale is binding on both parties! $config{'sitename'} does provide a feedback system to allow buyers and sellers to leave feedback. This provides a rating for users which are visible to all other users of $config{'sitename'}

|; } #-############################################# # Sub: Welcome Message # This will give out a welcome message to # the newest member; call it everywhere you # like with &welcome_msg sub welcome_msg { return '' unless -r "$config{'basepath'}$config{'newestmember'}/newmember.dat" and -T "$config{'basepath'}$config{'newestmember'}/newmember.dat"; open FILE, "$config{'basepath'}$config{'newestmember'}/newmember.dat"; my ($alias,$email) = ; close FILE; chomp ($alias,$email); print "

$config{'sitename'} welcomes its newest member $alias

"; } sub add_reg_file { my ($alias, $newline) = @_; $alias = $config{'loginalias'}; my (@newreg, @archive, $cat, $item, $flag); open (OLDREG, "$config{'basepath'}$config{'regdir'}/$alias.dat") or &oops('Cannot open reg file'); while () { $flag = 1 if (/$newline/); if(/^(\w+)(\d{10})$/) { if (($2 < (time - ($config{'prune_reg_days'} * 86400))) && ($category{$1})) { push(@archive, $_) } else{ push(@newreg, $_) } }else{ push(@newreg, $_) } } close (OLDREG); push(@newreg, "\n" . $newline) if (($newline ne '') && ($flag != 1)); # Avoid Dupes & blanks open (NEWREG, "> $config{'basepath'}$config{'regdir'}/$alias.dat") or &oops('Cannot re-write reg file'); flock (NEWREG, 2) if ($config{'flock'}); print NEWREG @newreg; flock (NEWREG, 8) if ($config{'flock'}); close (NEWREG); if ((@archive) && ($config{'archivedir'})) { umask(000); # Make Archive dir if not present mkdir("$config{'basepath'}$config{'archivedir'}", 0777) unless (-d "$config{'basepath'}$config{'archivedir'}"); open (ARCHIVE, ">> $config{'basepath'}$config{'archivedir'}/$alias.dat") or &oops('Cannot update Archives'); print ARCHIVE @archive; close (ARCHIVE); } } ############################################## # Sub: Buy It # This begins the process of allowing items to be purchased sub dispbuy { &oops("Item $form{'item'} could not be opened.") unless (my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($form{'category'},$form{'item'})); # my $nowtime = localtime(time); my $nowtime = strftime "%a %b %d, %I:%M %p", gmtime(time + ($config{'systemtime'}* 3600 )); ### 24 Hr clock ###### #my $nowtime = localtime(time + ($config{'systemtime'}* 3600 )); my $closetime = localtime($form{'item'}); # my $closetime = strftime "%a %b %d, %I:%M %p", gmtime($item_number + ($config{'systemtime'}* 3600 )); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &read_bid($bids[0]); # read first bid # my $nowtime = localtime; my $nowtime = strftime "%a %b %d, %I:%M %p", gmtime(time + ($config{'systemtime'}* 3600 )); ### 24 Hr clock ###### #my $nowtime = localtime(time + ($config{'systemtime'}* 3600 )); my $key; my $file; my $sellerfeed = &get_feed_info($alias); $buyit = &parsebid($buyit); print qq|

|; } #-############################################# # Sub: Process Buy-It # This processes Buy-It from a posted form sub procbuy { 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'}, $form{'phone'}, @userbids) = &read_reg_file($form{'alias'}); &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); } &oops('You must enter an alias to track your item.') unless ($form{'alias'}); &oops('You must enter a valid bid amount.') unless ($form{'bid'} =~ /^(\d+\.?\d*|\.\d+)$/); $form{'bid'} = &parsebid($form{'bid'}); &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, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($form{'category'},$form{'item'}); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &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); &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); } print NEW "\n$form{'alias'}\[\]$form{'email'}\[\]$form{'bid'}\[\]".time."\[\]$form{'address1'}\[\]$form{'address2'}\[\]$form{'address3'}\[\]$form{'phone'}"; close NEW; print "

$form{'alias'}, you have Purchased item number $form{'item'} for $config{'currency'}$form{'bid'} on ".scalar(localtime(time)).".

You may want to print this notice as confirmation of your Purchase.
Please give the seller 24 Hours to contact you.

Go back to the Auction

\n"; &closeitb($form{'category'},$form{'item'}); #&count_bid; 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'}, 'Item Sold!', "Item : $title\! Has Been Sold Using the Buy-It Button. Please Visit $config{'sitename'} again.") if ($config{'scripturl'} and $#bids); } else { print "Item number $form{'item'} in category $form{'category'} is now closed!
Sorry...\n"; } } #-############################################# # Sub: Close Auction Buy It # This sets an item's status to closed. sub closeitb { my ($cat,$item) = @_; if ($cat ne $config{'closedir'}) { my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($cat,$item); my @lastbid = &read_bid($bids[$#bids]); my @firstbid = &read_bid($bids[0]); if ($#bids) { if ($lastbid[2] >= $reserve) { &sendemail($lastbid[1], $firstbid[1], "Auction Close: $title", "Congratulations! You are the winner of auction number $item.\nYour winning bid was $config{'currency'}$lastbid[2].\n\nPlease contact the seller to make arrangements for payment and shipping:\n\n$firstbid[4]\n$firstbid[5]\n$firstbid[6]\n$firstbid[1]\n\nThanks for using $config{'sitename'}!"); &sendemail($firstbid[1], $lastbid[1], "Auction Close: $title", "Auction number $item is now closed.\nThe high bid was $config{'currency'}$lastbid[2] (your reserve was: $config{'currency'}$reserve).\n\nPlease contact the high bidder to make any necessary arrangements:\n\n$lastbid[4]\n$lastbid[5]\n$lastbid[6]\n$lastbid[1]\n\nThanks for using $config{'sitename'}!"); } else { &sendemail($lastbid[1], $firstbid[1], "Auction Close: $title", "Congratulations! You were the high bidder on auction number $item.\nYour bid was $config{'currency'}$lastbid[2].\n\nUnfortunately, your bid did not meet the seller\'s reserve price...\n\nYou may still wish to contact the seller to negotiate a fair price:\n\n$firstbid[4]\n$firstbid[5]\n$firstbid[6]\n$firstbid[1]\n\nThanks for using $config{'sitename'}!"); &sendemail($firstbid[1], $lastbid[1], "Auction Close: $title", "Auction number $item is now closed.\nThe high bid was $config{'currency'}$lastbid[2] (your reserve was: $config{'currency'}$reserve).\n\nPlease contact the high bidder to make any necessary arrangements:\n\n$lastbid[4]\n$lastbid[5]\n$lastbid[6]\n$lastbid[1]\n\nThanks for using $config{'sitename'}!"); } #&sendemail($firstbid[1], $lastbid[1], "Auction Close: $title", "Auction number $item is now closed.\nThe high bid was $config{'currency'}$lastbid[2] (your reserve was: $config{'currency'}$reserve).\n\nPlease contact the high bidder to make any necessary arrangements:\n\n$lastbid[4]\n$lastbid[5]\n$lastbid[6]\n$lastbid[1]\n\nThanks for using $config{'sitename'}!"); } else { &sendemail($firstbid[1], $config{'admin_address'}, "Auction Close: $title", "Auction number $item is now closed.\nThere were no bids on your item. You may repost your item by using the closed auction manager at http://$config{'scripturl'}$ENV{'SCRIPT_NAME'}. Thanks 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'}"); 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"); } 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 contseller { my $alias = $config{'loginalias'}; my $password = $config{'loginpassword'}; print <<"EOF";

EOF } ############### # Sub: Contact Seller Process sub proccontseller { my ($password, @junk) = &read_reg_file($form{'alias'}); &oops('username is incorrect.') unless ($password); &oops('password is incorrect.') unless ($password ne $form{'password'}); &oops('You must enter your password so we can validate your account.') unless ($form{'password'}); &oops('This user does not exist.') unless ($form{'user'} && (-e "$config{'basepath'}reg/$form{'user'}.dat")); &oops('Message must contain some content but exeed 600 letters.') unless ($form{'message'} && (length($form{'message'}) < 600)); my ($password, $email, @junk) = &read_reg_file($form{'user'}); &sendemail($email, $config{'admin_address'}, "Message from an Auction member", "Information from the Auction\n\nHello $form{'user'},\n\na user from the $config{'sitename'}, $form{'alias'},\nhas been sent you a message.\nThe message contains:\n\n$form{'message'}\n\nYou can reply to $form{'alias'} if you click the following link:\n\nhttp://$config{'scripturl'}$ENV{'SCRIPT_NAME'}\?action=contseller&alias=$form{'user'}&user=$form{'alias'}\n\nThe Auctions Administration\n\n"); print <<"EOF";

Your message has been forwarded sucessfully

$form{'user'} will hopefully contact you asap

Return to the auctions

EOF } sub ask { umask(000); mkdir("$config{'basepath'}ask", 0777) unless (-d "$config{'basepath'}ask"); my ($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = &read_item_file($form{'category'},$form{'item'}); my ($alias, $email, $bid, $time, $add1, $add2, $add3, $phone) = &read_bid($bids[0]); my $time=localtime(time); my $password; my @userbids; &oops('Your alias could not be found!') unless ($password, $form{'email'}, $form{'address1'}, $form{'address2'}, $form{'address'}, $form{'phone'}, @userbids) = &read_reg_file($form{'alias'}); &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); &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'}$ENV{'SCRIPT_NAME'}\?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."; } } ############################################## # Sub: Seller Banned Bidders # This allows sellers to enter/remove/list bidders they do not want to bid on their auctions sub banmenu { print <<"EOF"; EOF } ############################################## # Sub: Enter banned Sellers # This allows sellers to enter bidders they do not want to bid on their auctions # sub addban { my $alias = $config{'loginalias'}; &oops('You must fill in your password') unless ($form{'password'}); #Check if banned user exists &oops('Sorry, the username you are trying to ban is not registered at this auction') unless (open(BIDDERFILE, "$config{'basepath'}$config{'regdir'}/$form{'bidder'}.dat")); close BIDDERFILE; #Check if user exists &oops('Your Username was not found.') unless (open(ALIASFILE, "$config{'basepath'}$config{'regdir'}/$config{'loginalias'}.dat")); my ($password,$email,$add1,$add2,$add3,$phone,@junk) = ; chomp($password,$email,$add1,$add2,$add3,$phone,@junk); close ALIASFILE; if ($form{'password'} eq $config{'loginpassword'}) { open(BANNED,">>$config{'basepath'}$config{'bandir'}/$form{'alias'}.txt") || die "Cannot open file: $form{'alias'} for input.\n"; ### Add banned user to data file print BANNED "$form{'bidder'}\n"; close BANNED; ### Advise user banned user added print "
$form{'bidder'} has been successfully added to your banned bidders list.
"; } else { &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); } } ############################################## # Sub: Removes banned Sellers # This allows sellers to remove bidders they have banned to bid on their auctions # sub remban { &oops('You ust fill in your password') unless ($form{'password'}); #Check if banned user exists &oops('Sorry the username you are trying to ban Does Not Exist') unless (open(BIDDERFILE, "$config{'basepath'}$config{'regdir'}/$form{'bidder'}.dat")); close BIDDERFILE; #Check if user exists &oops('Incorrect Username') unless (open(ALIASFILE, "$config{'basepath'}$config{'regdir'}/$form{'alias'}.dat")); my ($password,$email,$add1,$add2,$add3,$phone,@junk) = ; chomp($password,$email,$add1,$add2,$add3,$phone,@junk); close ALIASFILE; if ($form{'password'} eq $config{'loginpassword'}) { open(BANNED,"$config{'basepath'}$config{'bandir'}/$form{'alias'}.txt") || die "Cannot open file: $form{'alias'} for input.\n"; my @banlist = ; my $banned; close BANNED; chomp(@banlist); open(NEWBANNED,">$config{'basepath'}$config{'bandir'}/$form{'alias'}.txt"); my $remove = 0; foreach $banned (@banlist) { if($form{'bidder'} eq $banned){ print "
$form{'bidder'} was removed from your Banned Seller List.
\n"; my $removed = 1; } else { print NEWBANNED "$banned\n"; } } close NEWBANNED; my $removed; if ($removed = 0) { print "
$form{'bidder'} was not in your Banned Bidders List
"; } } else { &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); } } ############################################## # Sub: List banned Sellers # This allows sellers to list bidders they have banned to bid on their auctions # sub listban { &oops('You must fill in your password') unless ($form{'password'}); #Check if user exists &oops('Incorrect Username') unless (open(ALIASFILE, "$config{'basepath'}$config{'regdir'}/$config{'loginalias'}.dat")); my ($password,$email,$add1,$add2,$add3,$phone,@junk) = ; chomp($password,$email,$add1,$add2,$add3,$phone,@junk); close ALIASFILE; if ($form{'password'} eq $config{'loginpassword'}) { open(BANNED,"$config{'basepath'}$config{'bandir'}/$form{'alias'}.txt") || die "Cannot open file: $form{'alias'} for input.\n"; my @banlist = ; close BANNED; chomp(@banlist); my $banned; print "

$form{'alias'} here is your list of banned users
"; foreach $banned(@banlist) { print "
$banned
"; } print "
Please Note: None of these users may bid on your items unless you remove them from your banned list.

"; } else { &oops('Incorrect Password'); } } sub sortdisplist { 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, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids); if ($form{'sort'} eq 'file') { $pairs{$file} = $file; } elsif ($form{'sort'} eq 'item') { $pairs{$file} = $title; } elsif ($form{'sort'} eq 'numbids') { $pairs{$file} = $#bids; } elsif ($form{'sort'} eq 'highbid') { my @lastbid = split(/\[\]/,$bids[$#bids]); $pairs{$file} = $lastbid[2]; } } } closedir THEDIR; if ($form{'sort'} eq 'file') { @sortedfiles = ( sort { ((lc($pairs{$main::a}) cmp lc($pairs{$main::b})) || ($main::a <=> $main::b)) } (keys(%pairs)) ); } elsif ($form{'sort'} eq 'item') { @sortedfiles = ( sort { ((lc($pairs{$main::a}) cmp lc($pairs{$main::b})) || ($main::a <=> $main::b)) } (keys(%pairs)) ); } elsif ($form{'sort'} eq 'numbids') { @sortedfiles = sort { ((int($pairs{$main::b}) <=> int($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)); } } return @sortedfiles; } #-############################################# # Sub: update_ticker # Update latest item ticker sub update_ticker { my $new_cat = $_[0]; my $new_item = $_[1]; my $new_title = $_[2]; # if $new_cat[0] { my $new_line = " * $new_title \n"; # } # else # my $new_line = " * \n"; # } open (TICKER, "+>> $config{'basepath'}latest/ticker.txt") or &oops('Can\'t open Item Ticker'); if ($config{'flock'}) { flock(TICKER, 2); } seek(TICKER, 0, 0); my @allitems = (); unshift (@allitems, $new_line); pop (@allitems) unless ($#allitems < $config{'max_new_items'}); seek(TICKER, 0, 0); truncate TICKER, 0; print TICKER @allitems; close TICKER; } #-############################################# # Sub: Closed items 1 # This displays closed items sub viewclosed1 { my ($alias, $password); $alias = $config{'loginalias'}; my($password,$email,$add1,$add2,$add3,$phone) = &read_reg_file($alias); print ""; print ""; print "

View all closed items

"; print <<"EOF"; 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,$phone,@past_bids) = &read_reg_file($form{'alias'}); &oops('Your password is incorrect!') if ($form{'password'} ne $config{'loginpassword'}); print "\n"; } 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, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids) = ; close THEFILE; chomp($title, $reserve, $inc, $desc, $image, $itmcond, $buyit, $shipto, $ship, $pay0, $pay1, $pay2, $pay3, $pay4, $pay5, $pay6, @bids); my $html_description = &strip_scripts(&enable_html($desc)); print "

"; print "

$title

\n"; print "

Description

$html_description"; print "

Bid History

\n"; if ($#bids) { for (my $i=1; $i$alias $$bidtime$ - $config{'currency'}$bid
"; } } else { print "No bids were placed...
"; } print "

Reserve was: $config{'currency'}$reserve
\n"; print "

Contact Information

\n"; if (($config{'loginalias'}) eq (&read_bid($bids[0]))[0]) { print "You were the seller...

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

High Bid: $config{'currency'}$bid\n"; print "

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

\n"; } elsif (($config{'loginalias'}) eq (&read_bid($bids[$#bids]))[0]) { print "You were a high bidder...

\n"; my ($alias, $email, $bid, $time, $add1, $add2, $add3, $ph) = &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, $ph) = &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 "

"; } else { print "You were not a winner... No further contact information is available.\n"; print "

Category List	Post New Item	Change Registration	My Sticky Notes
View New Auctions	View Hot Auctions	View Closing Auctions	View All Auctions
View My Closed Items	View buyit Now Auction	View All Closed Auctions	Seller Ban Menu
View All Sellers Items	View Your Bids	View Watched Items	Reserved
Create/Edit your My Page	View a users My Page	Create Or Edit Your Store	View A Users Store
Contact Admin	Contact a User	Suggest a Category	Report Auction Fraud
Leave Feedback	Search Feedback	Auction HELP

Category	Items

$category{$key}	$numfiles

You can contact the Seller or interested parties of this item here
your Alias Name:
password:
Contact Name:
Message:

This will allow you to enter a bidder's username that you do not want to bid on your future auctions.
Your Username:
Your Password: Required for verification
Banned Bidder's User Name:
Ban Bidder: Remove Ban: List Banned Bidders:

$category{$form{'category'}}

Post A New Item

New Item Posting confirmed

New Item Preview

Review bid for $title \(Item # $form{'item'}\)

Search Results - $form{'searchstring'}

Change your contact details

New User Registration

List Closed Auctions

List Closed Auctions

$title

Lookup User Feedback

Buy-it Now Auctions

Suggest an auction category

Suggest an Auction Category

Contact Site Admin

Contact site Admin

Contact A User

Contact A User

Auction User Agreement

Report possible Fraud

Sell Your Item, Verify User

Verify User

My Auction Sticky Notes

Auction Help

Buy-It Now Rules and User Agreement

View all closed items

$title

Random Auction

Pigeonglobe Online Auction
Title:	$title
Description:	$html_description
Category:	$category{$key}
Closes:	$closetime[4].$closetime[3]
Topbid:	$config{'currency'}$lastbid[2]
Seller:	$selleralias

Item No	Item	Closes	Bids	High Bid
$file	$\"link\"$ $title"; print " " if (($sellertime + (86400 * $config{'newdays'})) > time); print " " if ($image); print " " if ($reserve > '0.00') && ($reserve > $bid); print " " if (($bid >= $reserve) and ($reserve > 0)); print " " if (($buyit > '0') && ($#bids eq '0') && ($reserve <= '0') or ($buyit > '0') && ($reserve > '0') && ($reserve > $bid)); print " " if ($#bids >= $config{'hotitemnum'}); print " " if ($file < (time + $config{'endhours'} * 86400)); print "	$closetime[3]/$closetime[4]	$bidnum	$config{'currency'}$bid

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:
Your Password: Required for verification