print "

Buy Now" if (($buyit ne "") & ($bid < $buyit)); #### print " - PayPal " if ($config{'allowpaypal'} != 0); #### #!/usr/bin/perl # # IPN Perl Script # # This sample script will read iKobo IPN message, parse it and save it into /tmp/ipn.txt # /tmp/ directory is available and allows writing on most Unix systems # printf "Content-type: text/plain\n\n"; #read(STDIN,$buffer,$ENV{CONTENT_LENGTH}); $buffer = $ENV{'QUERY_STRING'}; @in = split(/&/,$buffer); open F, ">/tmp/ipn.txt"; printf( F "buffer=%s\n", buffer ); foreach $i (0 .. $#in) { # Convert plus's to spaces $in[$i] =~ s/\+/ /g; # Split into key and value. ($key, $val) = split(/=/,$in[$i],2); # splits on the first =. # Convert %XX from hex numbers to alphanumeric $key =~ s/%(..)/pack("c",hex($1))/ge; $val =~ s/%(..)/pack("c",hex($1))/ge; # Associate key and value $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator $in{$key} .= $val; printf( F "%s=%s\n", $key, $val ); if ( lc($key) eq "option_list" ) # parse option list { @options = split(/,/,$val); foreach $j (0 .. $#options) { # printf( F "parsing option_list for item $j: %s\n", $options[$j] ); @item_options = split( /:/, $options[$j] ); foreach $k (0 .. $#item_options) { # Split into key and value. ($opt_group, $opt_name, $opt_price) = split( /[=+]/, $item_options[$k] ); print( F "item $j, option group=$opt_group, name=$opt_name, price=$opt_price\n" ); } } } } close F; print( "RESP=OK\r\n" ); #### sub postal_login { my ($paymentmethod) = $_[0]; my $currentbalance = &priceformat($form{'balance'},"html"); my $payment; $payment = &parsebid($form{'balance'} * -1) if ($form{'balance'} < 0); if ($paymentmethod eq "paypal") { &oops ('PayPal Payment Not Allowed At Present') unless ($config{'allowpaypal'} == 1); print <<"EOF";

`PayPal Payment.`


	


This form will allow you to make a PayPal payment to your account at $config{'sitename'}  



 




Registration is required.
Your Username:
Required for verification

Your Password:
Required for verification


Notes:
Any additional notes 






Enter The Amount You Wish To Pay

Current Balance $currentbalance


$config{'currency'}






















 










EOF
	}
	else {
		&oops ('Postal Payment Not Allowed At Present') unless ($config{'allowpostal'} == 1);
		print "Postal Payment\n";
		print "Current Balance $currentbalance

" if ($form{'balance'});
		print <<"EOF";
This form will allow you to make a postal payment to your account at $config{'sitename'}  

Your Check or Money Order should be made payable to $config{'postal_add1'}


You may include any additional notes in the form field provided.

Please allow up to 10 Days for verification, Thank You.




Registration is required.
Your Username:
Required for verification

Your Password:
Required for verification

Amount:
The amount you wish to pay $config{'currency'}
Notes:
Any additional notes 
By Pressing Continue You Agree 

To Send The Above Stated Amount.



EOF

	}
}
##

##

#!/usr/bin/perl

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

print "RESP=OK";

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

print "Buy
Now";


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) = ; 
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) = ; 
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 "
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: 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; 
} 
#-#############################################

Registration is required.
Your Username: Required for verification
Your Password: Required for verification
Amount: The amount you wish to pay	$config{'currency'}
Notes: Any additional notes
By Pressing Continue You Agree To Send The Above Stated Amount.