#!/usr/local/bin/perl -w

use strict;
use vars qw(%CONFIG @amazon_url_refs $buffer);
my $real_path;
if($^O =~ m#win32#i){
	if($ENV{'PATH_TRANSLATED'} ne ""){
		$real_path = $ENV{'PATH_TRANSLATED'};
		$real_path =~ s#\\#/#g;
		$real_path =~ s#[^/]*$##;
		chdir($real_path);
	}
}
else{
	if($ENV{'SCRIPT_FILENAME'} ne ""){
		$real_path = $ENV{'SCRIPT_FILENAME'};
		$real_path =~ s#[^/]*$##;
		chdir($real_path);
	}
}

use LWP::UserAgent;
use HTML::LinkExtor;
use URI::URL;



chdir("..");
require "tools.pm";
%CONFIG = &read_config;
chdir("affiliates");

my $base = $ENV{'QUERY_STRING'};
my $method = $ENV{'REQUEST_METHOD'};
my $http_user_agent = $ENV{'HTTP_USER_AGENT'};

my $url = $base;

if($url =~ m#^https:#i){
	print "Location: $url\n\n";
	exit;	
}

if($url !~ m#amazon\.com#i){
	print "Location: $url\n\n";
	exit;	
}


if(lc($method) eq "post"){
	read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}

my $html = get_amazon_content($url,$method, $http_user_agent);
print "Content-type: text/html\n\n";
print $html;



sub get_amazon_content {
	my ($url, $method, $http_user_agent) = @_;
	my $req;
	my $ua = new LWP::UserAgent;
	$ua->agent($http_user_agent);
	@amazon_url_refs = ();
	my $p = HTML::LinkExtor->new(\&callback);
	if(lc($method) eq "get"){
		$req = HTTP::Request->new(GET => $url);
	}
	elsif(lc($method) eq "post"){
		$req = HTTP::Request->new(POST => $url);
		$req->content_type('application/x-www-form-urlencoded');
		$req->content($buffer);
	}

	my $res = $ua->request($req);
	my $base = $res->base;
	if($base !~ m#amazon\.com#i){
		print "Location: $base\n\n";
		exit;	
	}
	my $html = $res->content;
	$p->parse($html);
	@amazon_url_refs = map { [$_->[0], $_->[1], url($_->[1], $base)->abs] } @amazon_url_refs;


	for my $ref (@amazon_url_refs){
		my $attr = $ref->[0];
	 	my $val = $ref->[1];
		my $val_t = quotemeta($val);
		my $full_val = $ref->[2];
		$full_val =~ s#/ASIN/([^/]*)/[^"]*#/ASIN/$1/$CONFIG{'AMAZON_ASSOCIATES_ID'}#;
		$html =~ s#\%0A##g;
		$html =~ s#$attr\s*=\s*"?$val_t"?#$attr="$full_val"#is;
	}
	return $html;

}

sub callback {
	my($tag, %attr) = @_;
	while (my ($key,$value) = each %attr) {
		next if $key eq 'usemap';
		push(@amazon_url_refs, [$key, $value]);
	}
}