Cometでブラウザをgkbrさせてみる！

最近久しぶりにCometとかFlashのXML-Socketとかを調べています。

Cometといえばチャットに代表されるように「テキストや画像の配信」が頭に思い浮かびますが、
今回はjsonpで任意のイベントを送り込む例として「サーバにアクセスしている人のブラウザを好き勝手に動かしてみる」という、やや怪しげなサンプルを書いてみました。

仕組みはこんな感じ。

サーバはPOEで動作します。HTTPの受け口とコマンドラインを受け付ける口を持っています。
クライアント側からはjqueryを使ってXHRなlong_pollセッションを張っておきます。
サーバからは任意のタイミング（コマンドラインを受け付けたタイミング）でjsonpを送ってやります。
クライアントは受け取ったjsonpによってあらかじめロードしておいたいくつかの関数のうち、どれかがキックされる

というような構成です。

実際にどうなるかというと、ユーザにブラウザでアクセスさせてから、こっそりとそのサーバのコンソールで「right, left, up, down」とかコマンドを打つと、ユーザのブラウザが右に左に、上に下にと移動します。

ユーザ「なんじゃこりゃー」と驚いているあいだに、さらにコンソールから「shake」と叩くと、ブラウザがガクガクブルブル震えます。そう、まさに名実ともにgkbr！！

まったく無意味なくだらないイタズラcometですが、実際にやってみると結構面白いです。
perl界隈の玄人さんたちはあまりビビラないかもしれないけど、民間人はイチコロです。せいぜいビックリさせてあげましょう！

以下、おソースでがんす。

use strict;
use POE;
use POE::Component::Server::HTTP;
use POE::Wheel::ReadLine;
use YAML;
use Template;
use HTTP::Status;
use Scalar::Util qw(refaddr);

my %receiver;
my $yaml = YAML::Load( join '', <DATA> );

my $server = POE::Component::Server::HTTP->new(
    Port           => 80,
    ContentHandler => {
        "/"          => \&index,
        "/jsonp.js"  => \&jsonp,
        "/long_poll" => \&long_poll,
    }
);

POE::Session->create(
    inline_states => {
        _start    => \&make_wheel,
        got_input => \&got_input_handler,
    }
);

POE::Kernel->run;

sub make_wheel {
    my ( $kernel, $session, $heap ) = @_[ KERNEL, SESSION, HEAP ];
    $heap->{wheel} = POE::Wheel::ReadLine->new(
        InputEvent => "got_input",
        appname    => 'mycli'
    );
    $heap->{wheel}->get("Prompt: ");
}

sub got_input_handler {
    my ( $heap, $input, $arg ) = @_[ HEAP, ARG0, ARG1 ];
    if ( defined $input ) {
        $heap->{wheel}->addhistory($input);
        if ( $input =~ /^shake|left|right|up|down$/ ) { &release($input); }
        $heap->{wheel}->get("Prompt: ");
    }
    else {
        $heap->{wheel}->put("Exception: $arg");
        if ( $arg eq 'interrupt' ) {
            POE::Kernel->stop;
        }
    }
}

sub index {
    my ( $req, $res ) = @_;

    my $tpl = $yaml->{index};
    my $tt  = Template->new;
    $tt->process( \$tpl, "", \my $content );
    $req->headers->header( Connection => 'close' );
    $res->code(RC_OK);
    &standard_response( $res, "text/html" );
    $res->content($content);
    return RC_OK;
}

sub jsonp {
    my ( $req, $res ) = @_;

    my $tpl = $yaml->{js};
    my $tt  = Template->new;
    $tt->process( \$tpl, "", \my $content );
    $req->headers->header( Connection => 'close' );
    $res->code(RC_OK);
    &standard_response( $res, "text/javascript" );
    $res->content($content);
    return RC_OK;

}

sub long_poll {
    my ( $req, $res ) = @_;

    $receiver{ refaddr $res} = $res;
    $req->headers->header( Connectcion => 'close' );
    &standard_response( $res, "application/json" );

    return RC_WAIT;
}

sub release {
    my $str = shift;

    my $jsonp = 'do_jsonp({data : { name : "' . $str . '"} })';
    foreach my $res ( values %receiver ) {
        $res->code(RC_OK);
        $res->headers->header( "Connection" => 'Keep-Alive' )
          ;    # IE6のバグのため必要
        $res->continue();
        $res->content($jsonp);
        delete $receiver{ refaddr $res};
    }
    return RC_OK;
}

sub standard_response {
    my ( $res, $type ) = @_;

    $type ||= "text/html";
    $res->headers->header( "Cache-Control" => 'no-cache' );
    $res->headers->header( Expires         => '-1' );
    $res->headers->header( Pragma          => 'no-cache' );
    $res->content_type( $type . "; charset=UTF-8" );
}

__DATA__
---
index: |
  <html>
  <head>
  <script type="text/javascript" src="http://cachefile.net/scripts/jquery/1.2.6/jquery-1.2.6.js"></script>
  <script type="text/javascript" src="jsonp.js"></script>
  </head>
  <body>
  あぶない実験
  </body>
  </html>


js: |
  function shake(num) {
      if(num == -1){
          itv = 50;
          cnt = 0;
          x = new Array( 12,-20,  8,-16, 20, -4, 16, -8,  4,-12,0);
          y = new Array(-20,  8,-16, 12,-12, 16, -4, 20, -8,  4,0);
          shake(cnt);
      }
      else if(num == 11){
          cnt = 0;
      }
      else{
          if(x[cnt] != 0) moveBy(x[cnt],y[cnt]);
          cnt++;
          if(cnt < x.length) setTimeout("shake(cnt)",itv);
          else cnt = 0;
      }
  }

  function window_move(direction,num){
        switch (direction){
            case "left" : x=-1; y= 0; break;
            case "right": x= 1; y= 0; break;
            case "up"   : x= 0; y=-1; break;
            case "down" : x= 0; y= 1; break;
        }
        for(cnt=0;cnt<num;cnt++){
            moveBy(x,y);
        }
  }

  function do_jsonp(data){
    switch (data.data.name){
        case "left"  : window_move("left", 100); break;
        case "right" : window_move("right",100); break;
        case "up"    : window_move("up",   100); break;
        case "down"  : window_move("down", 100); break;
        case "shake" : shake(-1); break;
    }
    long_poll();
  }

  function long_poll(){
      $.ajax({
          dataType: "jsonp",
          //data: {},
          url: "/long_poll",
          success: "do_jsonp"
      });
  }

  $(function(){setTimeout(long_poll,"1000");});

1点だけ、がんばったところを忘れないようにメモ。

sub releaseのなかで$res->headers->header( "Connection" => 'Keep-Alive' )としていますが、これはIE6のKeepAliveの仕様があまりにも個性的すぎるため、こんな風になっています。
参考）id:malaさんのブログのコメント欄に答えがあった！ → http://la.ma.la/blog/diary_200702101610.htm

余談ですが、ちょっと前にcybozu labsにお邪魔してid:kazuhookuさんとid:ZIGOROuさんとお話してきたんですが、「CometよりもFlashのXML-Socket使ったほうがクロスドメイン問題とかクリアするの楽ですよね」みたいな話になりました。実際にCometが商用サービスで使われてるのLingr以外にあまり知らない。。

2年前くらいのブームが落ち着いてきて、cometって技術は実際にどれくらい使われてるんだろうか？
ちょっと気になる今日この頃。