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/)か。