comment on

#!/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_addres
+s,-3,3);

        if ($other_remaining_on_POST eq '.JS') {

            $method='GET';

        } else {

            $other_remaining_on_POST=uc substr($target_remaining_addre
+ss,-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_a
+ddress,-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',Conten
+t_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;
[download]

In reply to http wrapper by dree

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.


laziness, impatience, and hubris
	PerlMonks