#!/usr/bin/perl

# http_wrapperl.pl v0.9.0 by dree <dree@perlmongers.it>
#
# Copyleft: Nordest Perl Mongers (http://www.perlmongers.it)
#
# License: GPL (http://www.gnu.org/copyleft/gpl.html)

use strict;
use CGI;
use LWP::UserAgent;
use HTTP::Request::Common;

my $q=new CGI;
my $ua = LWP::UserAgent->new;

###############
# CONFIGURATION
###############

my $target_base_address=q[http://www.mysite.suffix]; # site target

######
# MAIN
######

my $method;
my $content;
my $submit;
my $content_type;
my $target_remaining_address=$q->path_info();

# method acknowledgment
if ($ENV{REQUEST_METHOD} eq 'POST') {

        $method='POST';

} elsif ($ENV{REQUEST_METHOD} eq 'GET') {

        $method='GET';

} elsif (index($target_remaining_address,'GET',0) > -1) {

        $target_remaining_address=~s#^/GET(.+)#$1#;
	$method='GET';

} elsif (index($target_remaining_address,'POST',0) > -1) {

        $target_remaining_address=~s#^/POST(.+)#$1#;
	$method='POST';

} else {

	$method='GET';
}

# management of images & other (if presents) on a *POST* request
if ($method eq 'POST') {

        my $other_remaining_on_POST=uc substr($target_remaining_address,-3,3);

        if ($other_remaining_on_POST eq '.JS') {

	        $method='GET';

        } else {

	        $other_remaining_on_POST=uc substr($target_remaining_address,-4,4);

	        if (($other_remaining_on_POST eq '.GIF')
                or ($other_remaining_on_POST eq '.JPG')
                or ($other_remaining_on_POST eq '.PNG')
                or ($other_remaining_on_POST eq '.CSS')) {

		        $method='GET';

        	} else {

	        	$other_remaining_on_POST=uc substr($target_remaining_address,-5,5);

		        if ($other_remaining_on_POST eq '.JPEG') {

			        $method='GET';
		        }
	        }
        }
}

my $target_full_address=$target_base_address.$target_remaining_address;

if ($ENV{QUERY_STRING}) {

	$target_full_address.="?$ENV{QUERY_STRING}";
}

if ($method eq 'POST') {

	foreach my $key ($q->param) {

		my $val=$q->param("$key");
                my $name_attach;
                my $tmpfilename;

		if (eval {$tmpfilename = $q->tmpFileName($val);}) {

			($name_attach=$val)=~s#.+\\(.+)#$1#;

			my $type = $q->uploadInfo($val)->{'Content-Type'};

			if (!$type) {

				$type='application/octet-stream';
			}

			$content.=qq{$key => ["$tmpfilename",'$name_attach',Content_Type=>'$type'],};
			$method='POST-ATTACH';

		} else {

			$content.=qq{$key => '$val',};
		}
	}
}

if ($method eq 'GET') {

	$submit=qq{GET '$target_full_address'};

} else {

	$submit=qq{POST '$target_full_address'};

	if ($method eq 'POST') {

		$content_type=q{application/x-www-form-urlencoded};

	} elsif ($method eq 'POST-ATTACH') {

		$content_type=q{form-data};
	}

	if ($content) {

		chop($content);

		$submit.=qq{,
			Content_Type => '$content_type',
			Content => [$content]
		};
	}
}

my $ua_out=eval "\$ua->request($submit)";
my $result=${$ua_out}{'_content'};

if (${$ua_out}{'_rc'} eq '302') {

	my $location=${$ua_out}{'_headers'}{'location'};
        # eventually $location=~s#.+/(.+)#$1#;
	$location="http://$ENV{HTTP_HOST}"."$ENV{SCRIPT_NAME}/$location";
	print "Location: $location\n\n";
	exit;
}

no strict 'refs';

if (${$ua_out}{'_headers'}{'content-type'}[0]) {

        $content_type="${$ua_out}{'_headers'}{'content-type'}[0]"

} else {

        $content_type="${$ua_out}{'_headers'}{'content-type'}";
}

print "Content-Type: $content_type\n\n";
print $result;

exit;