#!/usr/bin/perl
#
#  PayPal Linking Script
#
# PayPalLinkingScript.cgi
# Version 1.0
# September 16, 2007
# Copyright 2007, Bontrager Connection, LLC
###########################################
#
#     I N S T R U C T I O N S
#
# See the "PayPal Link Instead of 'Buy Now' Button" article at
#   http://bontragerconnection.com/library/paypal_buy_link.shtml
#   for more implementation information.
#
#
# Two places need customization.
#
#
# Place 1 --
# Get the code for one PayPal "buy" button. Paste the code into 
#   the area below, replacing the indicated line. Leave the 
#   "my $PayPalButtonCode = <<'PAYPALBUTTONCODE';" line as is.
my $PayPalButtonCode = <<'PAYPALBUTTONCODE';

<form action="https://www.paypal.com/cgi-bin/webscr" method="post">
<input type="hidden" name="cmd" value="_xclick">
<input type="hidden" name="business" value="frederique@ile-de-nouvelle-caledonie.com">
<input type="hidden" name="item_name" value="silk_scarf">
<input type="hidden" name="amount" value="25.95">
<input type="hidden" name="shipping" value="25.00">
<input type="hidden" name="return" value="http://www.silkhandpainted.com/thankyou.html">
<input type="hidden" name="currency_code" value="AUD">
<input type="submit" name="submit" value="Buy Now">
</form>

PAYPALBUTTONCODE
# Leave above "PAYPALBUTTONCODE" line as is.
#
#
# Place 2 --
# This is optional.
# If you wish to specify item numbers and have the amounts 
#   automatically filled in, use this section. A return URL 
#   for the item may also be specified.
# Type one item number per line (blank lines are okay) with 
#   the item number, amount, and optional URL separated 
#   with an equal sign character.
# These are the formats:
#          ItemNumber=Amount
#          ItemNumber=Amount=ReturnURL
# NOTE: To work correctly, the item number may not contain 
#       an equal sign character.
# When an item number is sent to this software with the 
#   "buy" link, it will use the amount specified here, 
#   even if a different amount is in the link. If a 
#   return URL is also specified here for the item number, 
#   that URL will be used. Leave the line 
#   "my $ItemNumberProtection = <<'ITEMNUMBERPROTECTION';" as is.
my $ItemNumberProtection = <<'ITEMNUMBERPROTECTION';

TestABC=9.05=http://example.com/page2.html
TestDEF=44.95
TestGHI=444.00=http://example.com/expensive.html

ITEMNUMBERPROTECTION
# Leave above "ITEMNUMBERPROTECTION" line as is.
#
# No other customizations are necessary.
#
###########################################

use strict;
use CGI;
my (%In,%Number) = ();
$ItemNumberProtection =~ s/^\s*//s;
$ItemNumberProtection =~ s/\s*$//s;
for my $line (split /[\r\n]+/,$ItemNumberProtection)
{
	my @line = split / *= */,$line,3;
	unshift @line unless $line[$#line] =~ /\w/;
	my $k = shift @line;
	$line[0] =~ s/[^0-9\.]//s;
	$Number{$k} = join "\t",@line unless $Number{$k};
}
$PayPalButtonCode =~ s!<form.?action="?([^" >]+)!!i;
my $RedirectURL = $1;
while($PayPalButtonCode =~ s!<select(.*?)</select!!si)
{
	my $chunk = $1;
	$chunk =~ /name="?([^"> ]+)/i;
	my $key = $1;
	$In{$key} = '';
	$In{$key} = $1 if $chunk =~ /value="?([^"> ]+)/i;
}
while($PayPalButtonCode =~ s!<input([^>]+)>!!si)
{
	my $chunk = $1;
	$chunk =~ /type="?([^" >]+)/i;
	my $type = $1;
	if($type =~ /text|hidden/i)
	{
		$chunk =~ /name="?([^"> ]+)/i;
		my $key = $1;
		$In{$key} = '';
		$In{$key} = $1 if $chunk =~ /value="?([^"> ]+)/i;
	}
}
delete $In{bn};
my $Query = new CGI;
{
	my @names = $Query->param;
	for(@names) { $In{$_} = join("\t",($Query->param($_))); }
}
if($Number{$In{item_number}} =~ /\d/)
{
	my ($amount,$url) = split /\t/,$Number{$In{item_number}};
	$In{amount} = $amount;
	$In{return} = $url if $url =~ /\w/;
}
$RedirectURL = $RedirectURL.'?';
if($In{cmd} =~ /\w/)
{
	$RedirectURL .= "cmd=$In{cmd}\&";
	delete $In{cmd};
}
my @Parameters = ();
for my $k (keys %In)
{
	$In{$k} =~ s/([^a-zA-Z0-9])/'%'.unpack('H2',$1)/ges;
	push @Parameters,"$k=$In{$k}";
}
$RedirectURL .= join '&',@Parameters;
print "Location: $RedirectURL\n\n";
exit;
# end of file