-
Notifications
You must be signed in to change notification settings - Fork 21
/
app.psgi
99 lines (80 loc) · 2.49 KB
/
app.psgi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
use strict;
use warnings;
use Tatsumaki;
use Tatsumaki::Error;
use Tatsumaki::Application;
use Time::HiRes;
package ChatPollHandler;
use base qw(Tatsumaki::Handler);
__PACKAGE__->asynchronous(1);
use Tatsumaki::MessageQueue;
sub get {
my($self, $channel) = @_;
my $mq = Tatsumaki::MessageQueue->instance($channel);
my $client_id = $self->request->param('client_id')
or Tatsumaki::Error::HTTP->throw(500, "'client_id' needed");
$client_id = rand(1) if $client_id eq 'dummy'; # for benchmarking stuff
$mq->poll_once($client_id, sub { $self->on_new_event(@_) });
}
sub on_new_event {
my($self, @events) = @_;
$self->write(\@events);
$self->finish;
}
package ChatMultipartPollHandler;
use base qw(Tatsumaki::Handler);
__PACKAGE__->asynchronous(1);
sub get {
my($self, $channel) = @_;
my $client_id = $self->request->param('client_id') || rand(1);
$self->multipart_xhr_push(1);
my $mq = Tatsumaki::MessageQueue->instance($channel);
$mq->poll($client_id, sub {
my @events = @_;
for my $event (@events) {
$self->stream_write($event);
}
});
}
package ChatPostHandler;
use base qw(Tatsumaki::Handler);
use HTML::Entities;
use Encode;
sub post {
my($self, $channel) = @_;
my $v = $self->request->params;
my $html = $self->format_message($v->{text});
my $mq = Tatsumaki::MessageQueue->instance($channel);
$mq->publish({
type => "message", html => $html, ident => $v->{ident},
avatar => $v->{avatar}, name => $v->{name},
address => $self->request->address,
time => scalar Time::HiRes::gettimeofday,
});
$self->write({ success => 1 });
}
sub format_message {
my($self, $text) = @_;
$text =~ s{ (https?://\S+) | ([&<>"']+) }
{ $1 ? do { my $url = HTML::Entities::encode($1); qq(<a target="_blank" href="$url">$url</a>) } :
$2 ? HTML::Entities::encode($2) : '' }egx;
$text;
}
package ChatRoomHandler;
use base qw(Tatsumaki::Handler);
sub get {
my($self, $channel) = @_;
$self->render('chat.html');
}
package main;
use File::Basename;
my $chat_re = '[\w\.\-]+';
my $app = Tatsumaki::Application->new([
"/chat/($chat_re)/poll" => 'ChatPollHandler',
"/chat/($chat_re)/mxhrpoll" => 'ChatMultipartPollHandler',
"/chat/($chat_re)/post" => 'ChatPostHandler',
"/chat/($chat_re)" => 'ChatRoomHandler',
]);
$app->template_path(dirname(__FILE__) . "/templates");
$app->static_path(dirname(__FILE__) . "/static");
return $app;