Logn Pollingを使ったストレスの少ないチャットを作ってみた

Perl web ajax

従来ののチャットといえば、メタタグやJavascript等で定期的に更新処理がされていたのでストレスだったはず。サーバが送りたいタイミング（プッシュ型通信）でクライアントに更新をかけられれば、無駄な更新はしなくても良いし、無駄なトラフィックも無くなる。

しかし、Webブラウザではサーバからのプッシュ型通信はできない。ユーザの操作とかタイマとかをトリガにして動かすしかない。。そこで登場した技術がLong Polling。詳しくはググってもらった方が良くわかると思うので、ここでは省略。基本は、Ajaxの非同期通信を利用して、ブラウザが投げたリクエストをサーバ（今回はPerlCGI）で掴みっぱなしにして、サーバの好きなタイミングでレスポンスを返すというもの。

とりあえず、Long Pollingを使ったチャットを作ってみました。性格にはプッシュ型とはいえないかもしれないけど、Long Pollingという手法を使ってやってみた。

でも、Cometd*1とかShootingStar*2とかを使いたくなかったのでPerlのみで実装してみた。
意外と簡単に出来たので公開です。
※なぜかIEではワガママを言って動かないので、FFとかOperaで2ウィンドウ開いてやってみてくらはい。

「Please say ほげほげ.」：http://www.xtal-u.com/lp_chat/

index.cgi

#!/usr/bin/perl

use strict;
use warnings;
use CGI qw(:standard);

my $MAX_POLLING      = 30;
my $DEFAULT_LIST_NUM = 10;
my $TITLE_NAME       = "Please say ほげほげ.";
my $LOG_FILE         = './log_file.txt';

my $cgi = new CGI;
my $max_no = getMaxNo();

# GET
if ( lc($ENV{REQUEST_METHOD}) eq 'get' ) {
	my $cmd = $cgi->param('cmd') || '';
	my $get_no = $cgi->param('no') || 0;

	# Long Polling
	printJson($get_no) if $cmd eq 'polling';

	# メイン画面
	printHTML() if $cmd eq '';
}
# POST
elsif ( lc($ENV{REQUEST_METHOD}) eq 'post' ) {
	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime();
	my $date = sprintf("%4d/%02d/%02d %02d:%02d:%02d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
	my $name = htmlEscape($cgi->param('name') || '');
	my $comment = htmlEscape($cgi->param('comment') || '');
	my $get_no = $cgi->param('no') || 0;

	if ( $name ne '' && $comment ne '') {
		open (FH, ">> $LOG_FILE");
		print FH join('<>', ($max_no + 1, $date, $name, $comment)) . "\n";
		close(FH);
	}
}

exit;

# メイン画面出力
sub printHTML {
	print "Content-Type: text/html; charset=utf-8\n\n";
	print <<HTML;
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
   "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja" lang="ja">
	<head>
		<meta http-equiv="content-script-type" content="text/html;charset=UTF-8" />
		<meta http-equiv="content-style-type" content="text/html;charset=UTF-8" />
		<title>$TITLE_NAME</title>
		<link rel="stylesheet" type="text/css" href="_.css" media="screen" />
		<script type="text/javascript" language="javascript" src="prototype.js"></script>
		<script type="text/javascript" language="javascript" src="_.js"></script>
		<script type="text/javascript">
		//<![CDATA[
			var no = $max_no - $DEFAULT_LIST_NUM;
			longPolling();
		//]]>
		</script>
	</head>
	<body>
		<h1>$TITLE_NAME</h1>
		<form name="say_form" onsubmit="return checkSend();">
			<input type="text" id="IName" value="なまえ" onfocus="onFocusTB('IName');" onblur="onBlurTB('IName')" /> says 
			<input type="text" id="IComment" value="ほげほげ" onfocus="onFocusTB('IComment');" onblur="onBlurTB('IComment')" />.
			<input type="submit" value="send" /><br />
		</form>
		<hr />
		<div id="Say"></div>
		<hr />
		<div id="footer">Copyright 2008 Htz. All Rights Reserved.</div>
	</body>
</html>
HTML
}

# HTMLエスケープ
sub htmlEscape {
	my $str = shift || return undef;
	$str =~ s/&/&amp;/g;
	$str =~ s/</&lt;/g;
	$str =~ s/>/&gt;/g;
	$str =~ s/\"/&quot;/g;
	$str =~ s/\'/&#39;/g;
	$str =~ s/[\r\n]//g;
	return $str;
}

# 一番新しい番号を取得
sub getMaxNo {
	open(IN, $LOG_FILE);
	my @log = <IN>;
	close(IN);

	return (sort {$b <=> $a} map {(split(/<>/, $_))[0]} @log )[0] || 0;
}

# JSON形式で新しいメッセージを送信
sub printJson {
	my $get_no = shift;

	# ここで新しいメッセージを発見するまで監視。
	for (my $t = $MAX_POLLING; $t > 0 && $max_no <= $get_no; $t--) {
		$max_no = getMaxNo();
		sleep 1;
	}

	# メッセージをファイルから取り出す
	open(IN, $LOG_FILE);
	my @line = <IN>;
	close(IN);

	my @data = ();
	foreach ( @line ) {
		my ($no, $date, $name, $comment) = split /<>/, $_;
		$comment =~ s/\s*(.*)\s*/$1/;
		push(@data, "{no : \"$no\", date : \"$date\", name : \"$name\", comment : \"$comment\"}") if $no > $get_no;
	}

	# JSON形式で、新しいメッセージを全て送信
	print "Content-Type: text/plain; charset=utf-8\n\n";
	print "{no : \"$max_no\", data : [" . join(',', @data) . ']}';
}

_.js

var focus_flg = {
	IName    : false,
	IComment : false
};
var focus_msg = {
	IName    : 'なまえ',
	IComment : 'ほげほげ'
};

function onFocusTB(id){
	if(!focus_flg[id]){
		$(id).value = '';
		$(id).style.color = '#000000';
		focus_flg[id] = true;
	}
}

function onBlurTB(id){
	if(focus_flg[id] && $F(id) == ''){
		$(id).value = focus_msg[id];
		$(id).style.color = '#c0c0c0';
		focus_flg[id] = false;
	}
}

function checkSend(){
	var name = document.getElementById('IName').value;
	var comment = document.getElementById('IComment').value;

	if(name == '' || comment == ''){
		alert('Please input name and comment.');
		return false;
	}

	var param = {
		no      : no,
		name    : $F('IName'),
		comment : $F('IComment'),
		now     : new Date().getTime()
	};
	$('IComment').value = '';
	onBlurTB('IComment');

	new Ajax.Request(
		"index.cgi", {
			method     : 'POST',
			parameters : $H(param).toQueryString()
		}
	);

	return false;
}

function longPolling(){
	var param = {
		cmd : 'polling',
		no  : no,
		now : new Date().getTime()
	};

	new Ajax.Request(
		"index.cgi", {
			method     : 'GET',
			parameters : $H(param).toQueryString(),
			onComplete : update,
			onFailure  : longPolling
		}
	);
}

function update(httpObj){
	var json = eval('(' + httpObj.responseText + ')');

	no = json.no;
	json.data.each(function(d){
		new Insertion.Top('Say', '<div class="Say1 autopagerize_page_element"><div class="Say2"><div class="Comment">' + d.comment + '</div><div class="Name">' + d.name + ' (' + d.date + ')</div></div></div>');
	});
	longPolling();
}

*1:http://www.cometd.com/

*2:http://rubyforge.org/projects/shooting-star