CGIをテストする2。

http://d.hatena.ne.jp/kou21058/20050615/p2からちょっと進化。POSTに対応。少しはマシになった、気がする。
ところで、これじゃ画像が見れないじゃん。

#! /usr/bin/perl
use strict;
use warnings;

use IPC::Open2;
use Socket;

my $script = $0 . ".cgi";
my $port = 21058;
%ENV = ();

socket( CLIENT_WAITING, PF_INET, SOCK_STREAM, 0 )
        or die "socket :$!";
setsockopt( CLIENT_WAITING, SOL_SOCKET, SO_REUSEADDR, 1 )
        or die "setsockopt :$!";
bind( CLIENT_WAITING, pack_sockaddr_in( $port, INADDR_ANY ) )
        or die "bind :$!";
listen( CLIENT_WAITING, SOMAXCONN )
        or die "listen :$!";

for(;;){
        my $paddr = accept( CLIENT, CLIENT_WAITING );
        select( CLIENT ); $|=1;

        my $request_line = <CLIENT>;
        my( $method, $query ) = ( $request_line =~ m|^(\w+)\s+[\w/\.\-\_]+\??([\w\.\-_=&%]*)\s+HTTP/\d+\.\d+| );

	$ENV{REQUEST_METHOD} = $method;
	$ENV{QUERY_STRING} = $query if $query;
	my $content_length = 0;
        while(<CLIENT>){
		last if /^\s*$/;
		($content_length) = /^Content-Length:\s*(\d+)/ if /^Content-Length:/;
	}
	$ENV{CONTENT_LENGTH} = $content_length if $content_length;

        open2( \*CGIR, \*CGIW, "./$script" );

	if( $content_length ){
		my $length = 0;
		my $content = '';
		my $buf;
		while( $length < $content_length ){
			$length += read( CLIENT, $buf, $content_length );
			$content .= $buf;
		}
		print CGIW $content;
	}
	close CGIW;
	$_ = <CGIR>;
        print "HTTP/1.1 200 OK\n" unless /^HTTP/;
	print;
        print while <CGIR>;
        close CGIR;
        close CLIENT;
}
__END__

参考 : http://ja.wikipedia.org/wiki/Common_Gateway_Interface *1
そういえば、read使ったの初めてかもしれない。

*1:次に参考にすべきは、ここら辺(http://hoohoo.ncsa.uiuc.edu/cgi/)かな。それともこっち(http://cgi-spec.golux.com/)か。