Perl HTTP Services

Perl CGI

Decoding HTML requests:

	($command, $request, $method) = split(" ",$command);
	($document, $request) = split("\\\?",$request);
	for (split("&",$request) ) {
		s/\+/ /g;
		($key, $val) = split("=",$_); 
		$key =~ s/%(..)/pack("c",hex($1))/ge;
		$val =~ s/%(..)/pack("c",hex($1))/ge;
		$query{$key} = $val;

sub escapeHTML {
         my ($self,$toencode,$newlinestoo) = CGI::self_or_default(@_);
         return undef unless defined($toencode);
         return $toencode if ref($self) && $self->{'dontescape'};
         $toencode =~ s{&}{&}gso;
         $toencode =~ s{<}{&lt;}gso;
         $toencode =~ s{>}{&gt;}gso;
         $toencode =~ s{"}{&quot;}gso;
         my $latin = uc $self->{'.charset'} eq 'ISO-8859-1' ||
                     uc $self->{'.charset'} eq 'WINDOWS-1252';
         if ($latin) {  # bug in some browsers
                $toencode =~ s{'}{&#39;}gso;
                $toencode =~ s{\x8b}{&#139;}gso;
                $toencode =~ s{\x9b}{&#155;}gso;
                if (defined $newlinestoo && $newlinestoo) {
                     $toencode =~ s{\012}{&#10;}gso;
                     $toencode =~ s{\015}{&#13;}gso;
                }
         }
         return $toencode;
}

sub unescapeHTML {
    my ($self,$string) = CGI::self_or_default(@_);
    return undef unless defined($string);
    my $latin = defined $self->{'.charset'} ? $self->{'.charset'} =~ /^(ISO-8859-1|WINDOWS-1252)$/i
                                            : 1;
    # thanks to Randal Schwartz for the correct solution to this one
    $string=~ s[&(.*?);]{
	local $_ = $1;
	/^amp$/i	? "&" :
	/^quot$/i	? '"' :
        /^gt$/i		? ">" :
	/^lt$/i		? "<" :
	/^#(\d+)$/ && $latin	     ? chr($1) :
	/^#x([0-9a-f]+)$/i && $latin ? chr(hex($1)) :
	$_
	}gex;
    return $string;
}

Encodeing CGI Environment Variables for handoff to a CGI program

$ENV{SERVER_SOFTWARE} = 'MyHTTPd/0.1';
$ENV{SERVER_NAME} = Sys::Hostname::hostname();
$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
$ENV{SERVER_PROTOCOL} = $protocol;
$ENV{SERVER_PORT} = $PORT;
$ENV{REQUEST_METHOD} = $method;
$ENV{QUERY_STRING} = $querydata;
$ENV{REMOTE_ADDR} = $client->peerhost;
$ENV{HTTP_ACCEPT} = $request{'Accept'};
$ENV{HTTP_USER_AGENT} = $request{'User_Agent'};
$ENV{SCRIPT_NAME} = $request->url->epath;
$ENV{CONTENT_LENGTH} = 0;

See also

• http://www.perl.com/pub/doc/manual/html/pod/perlipc.html#TCP_Servers_with_IO_Socket Perl Internet servers
• http://www.fastnetltd.ndirect.co.uk/ a Perl HTTP server with in-process CGI support.

  .