I've been bouncing my head off the keys for two days now while trying to write a fast proxy. The idea is simple. Listen on a socket, get the data, (do something with the data if you want) connect to server, send data to server, get data from server (do something with the data if you want) and then send data along to client. I'm not using any pre-made modules for certain reasons (different conversation). The problem is waiting for a return from the server. Anyway, here is a clipped version of the code that is giving me issues. If I change line 145 to use _pass_thru(), its much faster :/ Any help would be appreciated. PS This is a module in the real program. 
#!/usr/bin/perl
use 5.008008;
use strict;
use Carp;
use POSIX 'WNOHANG';
use IO::Socket;
use Socket;
use Data::Dumper;

our $VERSION = '0.01';

# some defaults
our %defaults = (
    localIP         => "127.0.0.1",
    max_connections => 1,                 # Not forking
    port            => "80",
    server          => "216.92.118.23",
);

__PACKAGE__->make_accessors(
    qw( localIP max_connections port server rules Alerter kids),
    keys %defaults );

my @kids;

new();

######################################################################
+##########
sub new {
    my $class = shift;

    my %params = @_;

    # non modifiable defaults
    my $self = bless {}, $class;

    # get attributes
    $self->{$_} = exists $params{$_} ? delete( $params{$_} ) : $defaul
+ts{$_}
      for keys %defaults;

    $self->{Socket} = IO::Socket::INET->new(
        Listen    => 1,
        Reuse     => 1,
        LocalAddr => $self->localIP,
        LocalPort => $self->port,
        Proto     => 'tcp'
    );

    die "Could not create socket: $!\n" unless $self->{Socket};

    #   $self->{Socket}->autoflush(1);

    while ( my $client = $self->{Socket}->accept() ) {
        if ( my $pid = fork() ) {    #Parent
            push @kids, $pid;
            next;
        }
        else {                       #Child handles this conection
            print "New Connection $$" . time() . "\n";
            $self->_handle_connection($client);
            exit();                  # Child exits
        }
    }
    reap_zombies();
}

######################################################################
+###########
sub reap_zombies {
    my $self = shift;
    while (1) {
        my $pid = waitpid( -1, WNOHANG );
        last if $pid == 0 || $pid == -1;    # AS/Win32 returns negativ
+e PIDs
        @kids = grep { $_ != $pid } @kids;
        print "$pid PM child died\n";
        $self->Alerter->log( "debug",
            "PortManager $$ Socket pid $pid closed @kids remain active
+" );
    }
}

######################################################################
+##############################
sub _pass_thru {

    # Default action when no rules hit or is an unknwon protocol.
    my $self       = shift;
    my $client     = shift;
    my $first_line = shift;
    my $client_ip  = $client->peerhost();
    my $out_handle;    # socket to the server
    $self->_connect_server( \$out_handle );

#    $self->Alerter->log( "info",
#        "Pass_Thru OPEN from $client_ip to " . $self->server );

    binmode $out_handle;
    binmode $client;

    $client->autoflush(1);
    $out_handle->autoflush(1);
    my $c;
    my $len = 1;

    if ( my $pid = fork() ) {    # parent sends from Server to Client
        undef $/;
        undef $|;

        while ( $len == 1 ) {
            $len = sysread( $out_handle, $c, 1 );
            syswrite( $client, $c, $len );
        }
    }

    else {                       # Child sends from Client to Server
        undef $/;
        undef $|;
        syswrite( $out_handle, $first_line, length($first_line) );
        while ( $len == 1 ) {
            $len = sysread( $client, $c, 1 );
            syswrite( $out_handle, $c, $len );
        }
    }
    close $client;
    close $out_handle;
    $self->Alerter->log( "info",
        "Pass_Thru CLOSE from $client_ip to " . $self->server );

    exit;
}

######################################################################
+####################
######################################################################
+####################
# Will be broken up later
######################################################################
+####################
######################################################################
+####################
sub _handle_connection {
    my $self   = shift;
    my $client = shift;
    my $REQUEST;
    my $REPLY;
    my $out_handle;    # Will be a handle to the server side of the so
+cket.
    my $first_line;

    sysread( $client, $first_line, 4 );

    # Change this to use _pass_thru()
    #    if ($first_line =~ /^GET $|^POST$/)
    if ( $first_line !~ /^GET $|^POST$/ ) {
        $self->_pass_thru( $client, $first_line );
    }

    else {
        $REQUEST = $first_line . <$client>;
        while ( my $line = <$client> ) {
            $REQUEST .= $line;
            last if ( $line =~ /^\r\n/ );
        }
    }
    print "New Connection $$ READ" . time() . "\n";
    $REQUEST .= "\r\n\r\n";    # JUST TO BE SURE ITS THERE

    $REQUEST =~ s/HTTP\/1\.1/HTTP\/1\.0/;

    # print $REQUEST;

    $self->_connect_server( \$out_handle );
    print "New Connection $$ Connected " . time() . "\n";

    # Send
    select( ( select($out_handle), $| = 1 )[0] );
    syswrite( $out_handle, $REQUEST, length($REQUEST) );

    select( ( select(STDOUT), $| = 1 )[0] );
    print "New Connection $$ REQUEST SENT " . time() . "\n";

    #  print "URI: " .$object->{Request}->{URI}->{uri} ."\n";

### SLOW PART HERE
    select( ( select($out_handle), $| = 1 )[0] );

    my $bit;
    my $len = 1;
    until ( $len == 0 ) {
        $len = sysread( $out_handle, $bit, 1 );
        $REPLY .= $bit;
    }

## END SLOW PART

    print "New Connection $$ GOT DATA " . time() . "\n";



    select( ( select($client), $| = 1 )[0] );

    #     print $client $REPLY;
    syswrite( $client, $REPLY, length($REPLY) );
    print "New Connection $$ RCV SENT" . time() . "\n";

    close $client;
    close $out_handle;
    print "New Connection $$ DEAD" . time() . "\n";

    exit;
}

######################################################################
+##########
sub _connect_server {
    my $self   = shift;
    my $server = $self->server;
    my $port   = $self->port;
    my $sock   = shift;

    #my $proto = getprotobyname('tcp');
    #my $paddr = sockaddr_in($port, inet_aton($server));
    #socket($$sock, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
    #connect($$sock, $paddr) || die "connect: $!";

    $$sock = new IO::Socket::INET(
        PeerAddr => $server,
        PeerPort => $port,
        Proto    => 'tcp',
        Reuse    => 1
    );

    use Socket qw(IPPROTO_TCP TCP_NODELAY);
    setsockopt( $$sock, IPPROTO_TCP, TCP_NODELAY, 1 );

    if ( !$$sock ) {

        #        $self->Alerter->log("info", "Connec to Server failed.
+ $!");
        exit;

    }
    $$sock->timeout(.001);

    #print "Timeout is " .$$sock->Timeout() ."\n";
    #$$sock->autoflush(1);

    return (1);

}

######################################################################
+###########
# private reaper sub
sub reap_zombies {
    my $self = shift;
    my $kids = $self->kids;

    while (1) {
        my $pid = waitpid( -1, WNOHANG );
        last if $pid == 0 || $pid == -1;    # AS/Win32 returns negativ
+e PIDs
        @$kids = grep { $_ != $pid } @$kids;
        $self->{conn}++;    # Cannot use the interface for RO attribut
+es
    }
}

######################################################################
+###########
# class method
sub make_accessors {
    my $class = shift;

    for my $attr (@_) {
        no strict 'refs';
        *{"$class\::$attr"} = sub {
            $_[0]{$attr} = $_[1] if defined $_[1];
            $_[0]{$attr};
        };
    }
}

1;

[download]
A
Entities should not be multiplied unnecessarily.

In reply to Slow sockets by Bagarre

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • 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, details, 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, summary, 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:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.