jl2/select_demo.pl

## select_demo.pl
#!/usr/bin/perl

# select_demo.pl

# Copyright (c) 2010, Jeremiah LaRocco jeremiah.larocco@gmail.com

# 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 jeremiah.larocco@gmail.com

	# 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;