sub connectToHost {
...
    connect($Sock, $remote_port) || return (undef,"Socket Connect Error: $!");
...
}

...
sub processRequest {
...
    my( $UrlSock, $err ) = connectToHost( $Request{ host }, 80 );
...
    foreach my $line (@request){
        print $UrlSock $line;
    }

##</code><code>##

Can't use an undefined value as a symbol reference at ...

##</code><code>##

    $hash->{url} = ($firstline =~ m|(http://\S+)|)[0];
    if($hash->{url}=~/\?(.+)/s){
        $hash->{getdata}=$1;
        }
...
    $hash->{url}=~s/\?.*//s;

##</code><code>##

    if($firstline =~ m!(GET|POST|HEAD) http://([^/:]+):?(\d*)!){
        $method=$1;
        $host=$2;
        $port=$3
        }
    elsif($firstline=~m!(CONNECT) ([^/:]+):?(\d*)!){
        $method=$1;
        $host=$2;
        $port=$3
        }
    $hash->{method}=$method;
...
    if ($method=~/^POST$/is && $len) {

##</code><code>##

    #Get Reply Header
    my %Reply = ();
    my @reply = &readSocket( \%Reply, $UrlSock );
    if(
	defined $Reply{ 'content-type' }
    	and
    	$Reply{ 'content-type' } =~ m[^(image|application)]is
    ) {
        binmode $UrlSock;
        binmode $Client;
    }

##</code><code>##

sub worker {
    my $tid = threads->tid();
	local $SIG{__DIE__} = sub{ $ThreadStatus{$tid} = 'died'; };
...

##</code><code>##

#!/usr/bin/perl
use strict;
use threads qw[ yield ];
use threads::shared;
use Thread::Queue;
use Thread::Queue::Any;
use Socket;

$|=1;

my $worker_cnt = 6;    #Number of worker threads to start
my $hostname = `hostname`;
$hostname = strip($hostname);
my $hostip = (gethostbyname($hostname))[4];
my %SocketInfo = (
    hostname    => $hostname,
    hostip        => $hostip,
);

print "creating thread queues ...";
my $Qwork       = new Thread::Queue::Any;
my $Qprint    = new Thread::Queue::Any;
my %ThreadStatus : shared = ();
my %ClientAddr : shared = ();
print "Done\n";

my @threads = ();
print "starting 1 writer thread ... \n";
my $cthread = threads->new(\&writer);
push(@threads,$cthread);
print "starting $worker_cnt worker threads ... ";

for(my $x = 0;$x<$worker_cnt;$x++){
    $cthread = threads->new(\&worker);
    push(@threads,$cthread);
}
print "Done\n";
my $threadcnt = @threads;

my $port = 8080;
my $address = '';
my $Server;
my ($name, $aliases, $protocol) = getprotobyname('tcp');
if ($port !~ /^\d+$/) {($name, $aliases, $port) = getservbyport($port, 'tcp');}
my $proto = getprotobyname('tcp');
socket($Server,PF_INET,SOCK_STREAM,$proto) || die "Socket Connection Error : $!";
setsockopt($Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))     || die "SettingSocket Option Error: $!";
bind($Server, sockaddr_in($port, INADDR_ANY)) || die "Cannot bind Socket : $!";
listen($Server,SOMAXCONN) || die "Error listening on Socket: $!";
binmode $Server;
select($Server);$| = 1;
select(STDOUT);$|= 1;

###  Listener on Socket for Client Requests
# Use fileno to pass Globs between threads
#     http://www.perlmonks.org/index.pl?node_id=395373
print "Listening on port $port\n";
my $Client;
while (my $addr = accept($Client, $Server)){
    $Qwork->enqueue(fileno $Client,$addr,"");
    #sleep for 1 millisecond to avoid pegging the CPU
    select(undef,undef,undef,.01);
}

###  send a Die message to each thread by putting a die message in the queue for each thread to get.

$Qwork->enqueue(["",'DIE_NOW']) for 1 .. @threads;

###  Join threads - cleanup and exit
#$_->join for @threads;  - this should work but causes a crash.. Let windows clean up the threads.
use POSIX qw[_exit];
_exit( 0 );
#################################################################

sub writer {
    #Grab items from the Qprint queue and print them to STDOUT
    my $tid = threads->tid();
    $ThreadStatus{$tid} = 'idle';
    while(1){
        select(undef,undef,undef,.01) until $Qprint->pending();
        $ThreadStatus{$tid} = 'working';
        my ($thrid,$msg) = $Qprint->dequeue;
        last if length($msg) && $msg=~/^DIE NOW$/is;
        print "[$thrid] $msg\n";
        #Show the state of each thread
        foreach my $tid (sort(keys(%ThreadStatus))){
            print STDOUT "\t$tid is $ThreadStatus{$tid}\n";
        }
        $ThreadStatus{$tid} = 'idle';
        #sleep for 1 millisecond to avoid pegging the CPU
        select(undef,undef,undef,.01);
    }
    return 1;
}

sub worker {
    my $tid = threads->tid();
    local $SIG{__DIE__} = sub{ $ThreadStatus{$tid} = 'died'; };
    $ThreadStatus{$tid} = 'idle';
    while(1){
        select undef, undef, undef, .01  until $Qwork->pending();
        $ThreadStatus{$tid} = 'working';
        my ($fno,$addr,$action) = $Qwork->dequeue;
        last if length($action) && $action ne 'DIE NOW';
        open( $Client, "+<&=$fno" ) || last;
        #Process Request;
        processRequest( $Client, $addr, $tid );
        close($Client);
        $ThreadStatus{$tid} = 'idle';
    }
    return 1;
}

sub processRequest {
    my $Client = shift || return;
    my $addr = shift || return;
    my $tid = shift;

    $Qprint->enqueue( $tid, "Processing" );
    $ThreadStatus{ $tid } = 'processing';

    my $socket_format = 'S n a4 x8';
    my @tmp = unpack( $socket_format, $addr );
    my $port = $tmp[ 1 ];
    my $inetaddr = $tmp[2];
    my @inetaddr = unpack('C4',$inetaddr);
    my $client_ip = join(".", @inetaddr);
    my $client_host = gethostbyaddr( $inetaddr, AF_INET );
    my %Request = ();
    my @request = readSocket( \%Request, $Client );
    my( $UrlSock, $err ) = connectToHost( $Request{ host }, 80 );

    #Send Request to the internet
    $request[0] =~ s[http://[^/]+][];
    $request[0] =~ s[HTTP/1.1][HTTP/1.0];
    foreach my $line (@request){
        print $UrlSock $line;
    }
    if( exists $Request{ postdata } and length( $Request{ postdata } ) ) {
        print $UrlSock $Request{ postdata };
    }

    #Get Reply Header
    my %Reply = ();
    my @reply = &readSocket( \%Reply, $UrlSock );
    if(
		defined $Reply{ 'content-type' }
    	and
    	$Reply{ 'content-type' } =~ m[^(image|application)]is
    ) {
        binmode $UrlSock;
        binmode $Client;
    }

    #Print the Reply Header to the browser client
    print $Client @reply;
    $Qprint->enqueue(
		$tid,
		sprintf "Listening for %s from %s",
			$Reply{'content-type'}||'Unknown content type',
			$Request{host} || 'Unknown host'
    );
    $ThreadStatus{ $tid } = 'waiting for reply [0]';
    my $clen = 0;
    my $linecnt = 0;
    while( <$UrlSock> ) {
        my $line = $_;
        $linecnt++;
        $ThreadStatus{$tid} = "reading reply line $linecnt";
        print $Client $line;
        if( $Reply{'content-length'} && $Reply{'content-length'} > 0 ){
            $clen += length($line);
            last if $clen >= $Reply{'content-length'};
        }
        last if $line=~/\<\/html\>/is;
        last if $line=~/^0$/s;
        if($line=~/\<\/body\>$/is){
            print $Client qq|</html>|;
            last;
        }
    }
}

sub readSocket{
    my $hash = shift || return "No Hash Reference";
    my $Socket = shift || return "No Socket";
    binmode $Socket;
    my @lines = ();
    %{$hash} = ();
    #Read in First line and process it
    my $firstline = <$Socket>;
    $hash->{ request } = strip( $firstline );
    push( @lines, $firstline );
    if(
		$hash->{url} = ( $firstline =~ m[(http://\S+)] )[ 0 ]
		and
		$hash->{url} =~ m[\?(.+)]s
    ){
        $hash->{getdata} = $1;
    }
    #Method,host,port
    my( $method, $host, $port );
    #POST http://www.basgetti.com/cgi-bin/wasql.pl HTTP/1.1
    #CONNECT www.netteller.com:443 HTTP/1.1
    if( $firstline =~ m[(GET|POST|HEAD) http://([^/:]+):?(\d*)] ) {
        $method = $1;
        $host = $2;
        $port = $3
    }
    elsif( $firstline =~ m[(CONNECT) ([^/:]+):?(\d*)] ) {
        $method = $1;
        $host = $2;
        $port = $3
    }
    $hash->{method} = $method;
    $hash->{host} = $host;
    $hash->{port} = $port;
    #Read in rest of Header
    while( <$Socket> ) {
        next if m[(Proxy-Connection:|Keep-Alive:|Accept-Encoding:)];
        if( m[^([a-z\-]+)\:(.+)]is ) {
            my $attr = lc strip( $1 );
            my $val = lc strip( $2 );
            $hash->{$attr} = $val;
        }
        push @lines,$_;
        last if m[^[\s\x00]*$];
    }
    my $len = $hash->{'content-length'} ? $hash->{'content-length'} : 0;
    if( defined $method and $method =~ m[^POST$]is && $len ) {
        my $data = '';
        my $dlen = 0;
        my $bytes = $len > 2048 ? 2048 : $hash->{'content-length'};
        while( $dlen < $len ){
            my $cdata;
            my $n = read( $Socket, $cdata, $bytes );
            $data .= $cdata;
            $dlen = length($data);
            last if $n==0;
            last if !defined $n;
            select(undef,undef,undef,.01);
        }
        $hash->{'postdata'} = $data;
    }
    $hash->{url} =~ s[\?.*][]s if exists $hash->{url} and defined $hash->{url};
    return @lines;
}

sub connectToHost {
    # Create a socket that connects to a certain host
    # connectToHost($MainSock, $remote_hostname, $port)
    my( $remote_hostname, $port ) = @_;
    my $Sock;
    my( $socket_format, $proto, $packed_port, $cur );
    my( $remote_addr, @remote_ip, $remote_ip );
    my( $local_port, $remote_port );
    if( $port !~ m[^\d+$] ) {
        $port = ( getservbyname( $port, "tcp" ) )[ 2 ];
        $port = 80 unless $port;
    }
    $proto = ( getprotobyname( 'tcp' ) )[ 2 ];
    $remote_addr = ( gethostbyname( $remote_hostname ) )[ 4 ];
    if( !$remote_addr ) {
        return ( undef, "Unknown host: $remote_hostname" );
    }
    @remote_ip = unpack("C4", $remote_addr);
    $remote_ip = join(".", @remote_ip);
    $socket_format = 'S n a4 x8';
    $local_port = pack($socket_format, &AF_INET, 0, $SocketInfo{hostip});
    $remote_port = pack($socket_format, &AF_INET, $port, $remote_addr);
    socket($Sock, &AF_INET, &SOCK_STREAM, $proto) || return (undef,"Socket Error: $!");
    bind($Sock, $local_port) || return (undef,"Socket Bind Error: $!");
    connect($Sock, $remote_port) || return (undef,"Socket Connect Error: $!");
    $cur = select($Sock);
    $| = 1; # Disable buffering on socket.
    select($cur);
    return $Sock;
}

sub strip{
    #usage: $str=strip($str);
    #info: strips off beginning and endings returns, newlines, tabs, and spaces
    my $str = shift;
    if( length($str) == 0 ){return;}
    $str=~s/^[\r\n\s\t]+//s;
    $str=~s/[\r\n\s\t]+$//s;
    return $str;
}