ウィリアムのいたずらの開発日記

#!c:/perl/bin/Perl.exe
use Socket;

$HOST    = '127.0.0.1';
$PORT    = '80';
$PATH   = '/cgi-bin/formsend.cgi';
$TIMEOUT = '10';

$QUERY = 'abcd=123'; # 適当に入れてください。

print "Content-Type: text/xml￥n￥n";
print Header_Cut(Location_Post($HOST, $PORT, $PATH, $QUERY));

exit;

#
#==============================================//
#	Postで送信する	　			//
#	$host ホスト名				//
#	$port ポート番号			//
#	$path ホストのHomeからのパス(/で始まる)	//
#	$msg  送信内容				//
#	返り値：ヘッダーつきデータ		//
#==============================================//

sub Location_Post($$$$)
{

        my($host, $port, $file, $query) = @_;
        my($len) = length($query);

        # ソケットのオープン
        if (!socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')))
	{
		return "error:open socket";
        }

        # ポートへの接続
        if (!connect(SOCK, sockaddr_in($port,inet_aton($host))))
	{
                close(SOCK);
		return "error:connect socket";
        }

        # ソケットのバッファリングを停止
        select(SOCK);
        $| = 1;
        select(STDOUT);


        # HTTP 要求ヘッダー
        # POST メソッドで要求します。
        print SOCK "POST $file HTTP/1.0" . "￥r￥n";

        # Content-Length: を送る（クエリーのバイト数）
        # ヘッダーの最後は２回改行する
        print SOCK "Content-Length: $len" . "￥r￥n￥r￥n";

        # POST 内容送信
        print SOCK "$query";

        # タイムアウトアラーム開始
        $SIG{'ALRM'} = ￥&_socket_timeout;
        alarm($TIMEOUT);

        # 受信
	$ret = "";
        while(＜SOCK＞)
	{
		$ret = $ret . $_;
        }

        # タイムアウトアラーム解除
        alarm(0);

        # ソケットを閉じる
        close(SOCK);

	return $ret;
}


#===============================================//
# ソケット通信タイムアウト時の処理		//
#==============================================//
sub _socket_timeout
{
        close(SOCK);
        exit;
}
#==============================================//
#	ヘッダーをきる	　			//
#	$buf  ：ヘッダーつきデータ		//
#	返り値：ヘッダをカットした本文		//
#==============================================//
sub Header_Cut($)
{
        my($msg) = @_;
	$pos = index($msg,"￥r￥n￥r￥n");
	if ( $pos ＞= 0 )
	{
		$pos += 4;
	}
	else
	{
		$pos = index($msg,"￥n￥n");
		if ( $pos ＞= 0 )
		{
			$pos += 2;
		}
	}

	if ( $pos	＜	0 )
	{
		return "error";
	}

	return substr($msg,$pos);
}