App-Phoebe
view release on metacpan or search on metacpan
lib/App/Phoebe/Chat.pm view on Meta::CPAN
}
}
push(@extensions, \&handle_chat_say);
sub handle_chat_say {
my $stream = shift;
my $url = shift;
my $hosts = host_regex();
my $spaces = space_regex();
my $port = port($stream);
my ($host, $space, $text);
if (($host, $space, $text) =
$url =~ m!^gemini://($hosts)(?::$port)?(?:/($spaces))?/do/chat/say(?:\?([^#]*))?$!) {
process_chat_say($stream, $host, $port, $space || "", $text);
return 1;
} elsif ($url =~ m!^gemini://(?:$hosts)(?::$port)?(?:/$spaces)?/do/chat$!) {
serve_chat_explanation($stream, $url);
return 1;
}
return 0;
}
sub serve_chat_explanation {
my $stream = shift;
my $url = shift;
success($stream);
$stream->write("# Chat\n");
$stream->write(
encode_utf8
"This server supports a Gemini-based chat. "
. "If you don't have a dedicated client, you can use two windows of a regular Gemini client. "
. "Visit the following two URLs. "
. "The first one allows you âlistenâ to the channel and the second one allows you to âsayâ things. "
. "The connection to the âlistenâ channel needs a streaming client. "
. "Use a client certificate with the same common name for both connections.\n");
$stream->write("=> $url/listen\r\n");
$stream->write("=> $url/say\r\n");
}
sub process_chat_say {
my $stream = shift;
my $host = shift;
my $port = shift;
my $space = shift;
my $text = shift;
my $name = $stream->handle->peer_certificate('cn');
if (not $name) {
result($stream, "60", "You need a client certificate with a common name to talk on this chat");
return;
}
my @found = grep { $host eq $_->{host} and $space eq $_->{space} and $name eq $_->{name} } @chat_members;
if (not @found) {
result($stream, "40", "You need to join the chat before you can say anything");
return;
}
if (not $text) {
result($stream, "10", encode_utf8 "Post to the channel as $name");
return;
}
$text = decode_utf8(uri_unescape($text));
unshift(@chat_lines, { host => $host, space => $space, name => $name, text => $text });
splice(@chat_lines, $chat_line_limit); # trim length of history
# send message
for (@chat_members) {
next unless $host eq $_->{host} and $space eq $_->{space};
$_->{stream}->write(encode_utf8 "$name: $text\n");
}
# and ask to send another one
result($stream, "31", "gemini://$host:$port" . ($space ? "/$space" : "") . "/do/chat/say");
return;
}
# run every minute and print a timestamp every 5 minutes
Mojo::IOLoop->recurring(60 => sub {
my $loop = shift;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
return unless $min % 5 == 0;
$log->debug("Chat ping");
my $ts = sprintf("%02d:%02d UTC\n", $hour, $min);
for (@chat_members) {
$_->{stream}->write($ts);
}});
( run in 1.733 second using v1.01-cache-2.11-cpan-39bf76dae61 )