jl2 · June 24, 2010 21:07
diff --git a/select_demo.pl b/select_demo.pl
 #!/usr/bin/perl

 # select_demo.pl

 # Copyright (c) 2010, Jeremiah LaRocco [email protected]

 # Permission to use, copy, modify, and/or distribute this software for any
 # purpose with or without fee is hereby granted, provided that the above
 # copyright notice and this permission notice appear in all copies.

 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

 # Very simple demonstration of IO::Socket and IO::Select

 use IO::Socket;
 use IO::Select;
 use Net::hostent;

 use strict;
 use warnings;

 sub main {
    my $PORT = 9000;			# pick something not in use
    my $server = IO::Socket::INET->new( Proto     => 'tcp',
                                        LocalPort => $PORT,
                                        Listen    => SOMAXCONN,
                                        Reuse     => 1);
    my $read_set = new IO::Select(); # create handle set for reading
    $read_set->add($server);

    while (1) {

        my ($rh_set) = IO::Select->select($read_set, undef, undef, 5);

        if (not $rh_set) {
            print "Timed out!!\n";
        } else {
            for my $rh (@$rh_set) {

                if ($rh == $server) {
                    my $nc = $rh->accept();
                    $read_set->add($nc);
                    
                } else {
                    my $buf;
                    my $len = sysread $rh, $buf, 2048;
                    $read_set->remove($rh);
                    if ($len < 2048 && $len > 0) {
                        if ($buf =~ /GET \/ HTTP/) {
                            my $hostinfo = gethostbyaddr($rh->peeraddr);
                            printf("Got a 'GET' from %s\n", $hostinfo ? $hostinfo->name : $rh->peerhost);

                            binmode($rh);
                            print $rh "<html><body>Go!</body></html>";
                            close $rh;
                        }
                    } else {
                        print "Figure out what went wrong...\n";
                    }
                }
            }
        }
    }
 }

 main;
	#!/usr/bin/perl

	# select_demo.pl

	# Copyright (c) 2010, Jeremiah LaRocco [email protected]

	# Permission to use, copy, modify, and/or distribute this software for any
	# purpose with or without fee is hereby granted, provided that the above
	# copyright notice and this permission notice appear in all copies.

	# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
	# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
	# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
	# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
	# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
	# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
	# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

	# Very simple demonstration of IO::Socket and IO::Select

	use IO::Socket;
	use IO::Select;
	use Net::hostent;

	use strict;
	use warnings;

	sub main {
	my $PORT = 9000; # pick something not in use
	my $server = IO::Socket::INET->new( Proto => 'tcp',
	LocalPort => $PORT,
	Listen => SOMAXCONN,
	Reuse => 1);
	my $read_set = new IO::Select(); # create handle set for reading
	$read_set->add($server);

	while (1) {

	my ($rh_set) = IO::Select->select($read_set, undef, undef, 5);

	if (not $rh_set) {
	print "Timed out!!\n";
	} else {
	for my $rh (@$rh_set) {

	if ($rh == $server) {
	my $nc = $rh->accept();
	$read_set->add($nc);

	} else {
	my $buf;
	my $len = sysread $rh, $buf, 2048;
	$read_set->remove($rh);
	if ($len < 2048 && $len > 0) {
	if ($buf =~ /GET \/ HTTP/) {
	my $hostinfo = gethostbyaddr($rh->peeraddr);
	printf("Got a 'GET' from %s\n", $hostinfo ? $hostinfo->name : $rh->peerhost);

	binmode($rh);
	print $rh "<html><body>Go!</body></html>";
	close $rh;
	}
	} else {
	print "Figure out what went wrong...\n";
	}
	}
	}
	}
	}
	}

	main;