#!/usr/bin/perl

print "Content-type: text/html\n\n";

print "RESP=OK";

my ($category, $item) = &read_item_file($form{'category'},$form{'item'});

print "<P><A HREF=http://efret.com/cgi-bin/member215.pl?action=buynow&category=&item=$form{'item'}>Buy
Now</A></FONT>";


use vars qw(%config %category %form); 
use strict; 
local %config; 
$config{'basepath'} = '/home/httpd/vhosts/efret.com/httpdocs/apps/auction/'; 
$config{'closedir'} = 'closed'; 
$config{'regdir'} = 'reg'; 
%category = ( 
computer => 'Computer Hardware and Software', 
elec => 'Consumer Electronics', 
other => 'Other Junk', 
); 
$config{'adminpass'} = 'auction'; 
$config{'scripturl'} = 'www.efret.com'; 
config{'colortablehead'} = '#BBBBBB'; 
$config{'colortablebody'} = '#EEEEEE'; 
$config{'sitename'} = 'Your Site Name Here'; 
$config{'aftermin'} = 5; 
$config{'flock'} = 1; 
$config{'newokay'} = 1; 




local %form = &get_form_data; 
if ($form{'action'} eq 'hello') { &hello; } 
elsif ($form{'action'} eq 'whatever1') { &whatever1; } 
elsif ($form{'action'} eq 'whatever2') { &whatever2; } 
else { &hello; } 
print $config{'footer'}; 
#-############################################# 
sub hello { 
print qq| 
My Test Script 
|; 
} 
#-############################################# 
sub whatever1 { 
print qq| 
Put a sub here 
|; 
} 
#-############################################# 
sub whatever2 { 
print qq| 
Put a sub here 
|; 
} 
#-############################################# 
# Sub: Read Reg File (alias) 
sub read_reg_file { 
my $alias = shift; 
return '' unless $alias; 
# verify the user exists 
&oops('Your alias may not contain any non-word characters.') if $alias =~ /\W/; 
$alias = ucfirst(lc($alias)); 
return '' unless -r "$config{'basepath'}$config{'regdir'}/$alias.dat" and -T "$config{'basepath'}$config{'regdir'}/$alias.dat"; 
open FILE, "$config{'basepath'}$config{'regdir'}/$alias.dat"; 
my ($password,$email,$add1,$add2,$add3,@past_bids) = <FILE>; 
close FILE; 
chomp ($password,$email,$add1,$add2,$add3,@past_bids); 
return ($password,$email,$add1,$add2,$add3,@past_bids); 
} 
#-############################################# 
# Sub: Read Item File (cat, item) 
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, @bids) = <FILE>; 
close FILE; 
chomp ($title, $reserve, $inc, $desc, $image, @bids); 
return ($title, $reserve, $inc, $desc, $image, @bids); 
} 
#-############################################# 
# Sub: Read Bid Information (bid_string) 
sub read_bid { 
my $bid_string = shift; 
my ($alias, $email, $bid, $time, $add1, $add2, $add3) = split(/\[\]/,$bid_string); 
return ($alias, $email, $bid, $time, $add1, $add2, $add3); 
} 
#-############################################# 
# Sub: Oops! 
sub oops { 
print "<P><HR SIZE=1 NOSHADE><FONT COLOR=#FF0000><B>Error:</B></FONT><BR>$_[0]<P>Please hit the back browser on your browser to try again or contact <A HREF=\"mailto:$config{'admin_address'}\">the auction administrator</A> if you belive this to be a server problem.<HR SIZE=1 NOSHADE>\n"; 
print $config{'footer'}; 
die "Error: $_[0]\n"; 
} 
#-############################################# 
# Sub: parse bid 
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: Get Form Data 
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; 
} 
#-############################################# 





</readmore>