aaa.pl

use strict;
use warnings;

use Encode;
use Encode::Locale;
use LWP::Protocol;
use URI;

sub dump_env { join ", ", map { "$_: ".($ENV{$_}||'(undef)') } qw/REQUEST_METHOD HTTP_PROXY CGI_HTTP_PROXY/ }

sub env_proxy {
    my($k,$v);
    while(($k, $v) = each %ENV) {
        if ($ENV{REQUEST_METHOD}) {
            # Need to be careful when called in the CGI environment, as
            # the HTTP_PROXY variable is under control of that other guy.
            next if $k =~ /^HTTP_/;
            $k = "HTTP_PROXY" if $k eq "CGI_HTTP_PROXY";
        }
        $k = lc($k);
        next unless $k =~ /^(.*)_proxy$/;
        $k = $1;
        if ($k eq 'no') {
            #$self->no_proxy(split(/\s*,\s*/, $v));
        }
        elsif ($v) {
            # Ignore random _proxy variables, allow only valid schemes
            next unless $k =~ /^$URI::scheme_re\z/;
            # Ignore xxx_proxy variables if xxx isn't a supported protocol
            next unless LWP::Protocol::implementor($k);
            warn "$v is used";
        }
    }
}

#sub env_proxy {
#    my $proxy = 'no proxy';
#    unless (defined $ENV{REQUEST_METHOD}) {
#        $proxy = $ENV{HTTP_PROXY} || '';
#    }
#    $proxy ||= $ENV{CGI_HTTP_PROXY};
#    warn $proxy || 'no proxy';
#}


undef $ENV{FTP_PROXY};
undef $ENV{HTTP_PROXY};
undef $ENV{HTTPS_PROXY};

undef $ENV{REQUEST_METHOD};
undef $ENV{HTTP_PROXY};
undef $ENV{CGI_HTTP_PROXY};
warn "--- 1: ", dump_env;
env_proxy;

$ENV{REQUEST_METHOD} = "GET";
undef $ENV{HTTP_PROXY};
undef $ENV{CGI_HTTP_PROXY};
warn "--- 2: ", dump_env;
env_proxy;

undef $ENV{REQUEST_METHOD};
$ENV{HTTP_PROXY} = "HTTP_PROXY";
undef $ENV{CGI_HTTP_PROXY};
warn "--- 3: ", dump_env;
env_proxy;

$ENV{REQUEST_METHOD} = 'GET';
$ENV{HTTP_PROXY} = "HTTP_PROXY";
undef $ENV{CGI_HTTP_PROXY};
warn "--- 4: ", dump_env;
env_proxy;

undef $ENV{REQUEST_METHOD};
undef $ENV{HTTP_PROXY};
$ENV{CGI_HTTP_PROXY} = "CGI_HTTP_PROXY";
warn "--- 5: ", dump_env;
env_proxy;

$ENV{REQUEST_METHOD} = 'GET';
undef $ENV{HTTP_PROXY};
$ENV{CGI_HTTP_PROXY} = "CGI_HTTP_PROXY";
warn "--- 6: ", dump_env;
env_proxy;

undef $ENV{REQUEST_METHOD};
$ENV{HTTP_PROXY} = "HTTP_PROXY";
$ENV{CGI_HTTP_PROXY} = "CGI_HTTP_PROXY";
warn "--- 7: ", dump_env;
env_proxy;

$ENV{REQUEST_METHOD} = "GET";
$ENV{HTTP_PROXY} = "HTTP_PROXY";
$ENV{CGI_HTTP_PROXY} = "CGI_HTTP_PROXY";
warn "--- 8: ", dump_env;
env_proxy;

result:

--- 1: REQUEST_METHOD: (undef), HTTP_PROXY: (undef), CGI_HTTP_PROXY: (undef) at aaa.pl line 53.
--- 2: REQUEST_METHOD: GET, HTTP_PROXY: (undef), CGI_HTTP_PROXY: (undef) at aaa.pl line 59.
--- 3: REQUEST_METHOD: (undef), HTTP_PROXY: HTTP_PROXY, CGI_HTTP_PROXY: (undef) at aaa.pl line 65.
HTTP_PROXY is used at aaa.pl line 31.
--- 4: REQUEST_METHOD: GET, HTTP_PROXY: HTTP_PROXY, CGI_HTTP_PROXY: (undef) at aaa.pl line 71.
--- 5: REQUEST_METHOD: (undef), HTTP_PROXY: (undef), CGI_HTTP_PROXY: CGI_HTTP_PROXY at aaa.pl line 77.
--- 6: REQUEST_METHOD: GET, HTTP_PROXY: (undef), CGI_HTTP_PROXY: CGI_HTTP_PROXY at aaa.pl line 83.
CGI_HTTP_PROXY is used at aaa.pl line 31.
--- 7: REQUEST_METHOD: (undef), HTTP_PROXY: HTTP_PROXY, CGI_HTTP_PROXY: CGI_HTTP_PROXY at aaa.pl line 89.
HTTP_PROXY is used at aaa.pl line 31.
--- 8: REQUEST_METHOD: GET, HTTP_PROXY: HTTP_PROXY, CGI_HTTP_PROXY: CGI_HTTP_PROXY at aaa.pl line 95.
CGI_HTTP_PROXY is used at aaa.pl line 31.