view release on metacpan or  search on metacpan

lib/App/Phoebe/Oracle.pm  view on Meta::CPAN

# -*- mode: perl -*-
# Copyright (C) 2021  Alex Schroeder <alex@gnu.org>

# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU Affero General Public License as published by the Free
# Software Foundation, either version 3 of the License, or (at your option) any
# later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
# details.
#
# You should have received a copy of the GNU Affero General Public License along
# with this program. If not, see <https://www.gnu.org/licenses/>.

=encoding utf8

=head1 NAME

App::Phoebe::Oracle - an anonymous question asking game

=head1 DESCRIPTION

By default, Phoebe creates a wiki editable by all. With this extension, the
C</oracle> space turns into a special site: if you have a client certificate,
you can pose questions and get answers.

When you ask a question, you can delete any answers on it, and the question
itself. Once it has gotten three answers, it is hidden from view and only you
can decide wether to delete it, or whether to publish it. If the question is no
longer waiting for answers, deleting every answer deletes the question, too.

You can only answer questions not your own. You can answer every question just
once (even if you or the question asker deletes your answer, there is no going
back). You can delete your answer. If the question is no longer waiting for
answers, deleting the last answer deletes the question, too.

Simply add it to your F<config> file. If you are virtual hosting, name the host
or hosts for your capsules.

    package App::Phoebe::Oracle;
    use Modern::Perl;
    our @oracle_hosts = qw(transjovian.org);
    use App::Phoebe::Oracle;

If you don't want to use C</oracle> for the game, you can change it:

    our $oracle_space = 'truth';

If you want to change the maximu number of answers that a question may have:

    our $max_answers = 5;

If you want to notify Antenna whenever a new question has been asked:

    use App::Phoebe qw($log);
    use IO::Socket::SSL;
    # a very simple Gemini client
    sub query {
      my $url = shift;
      my($scheme, $authority, $path, $query, $fragment) =
	$url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(\S*))?|;
      my ($host, $port) = split(/:/, $authority);
      my $socket = IO::Socket::SSL->new(
	PeerHost => $host, PeerPort => $port||1965,
	# don't verify the server certificate
	SSL_verify_mode => SSL_VERIFY_NONE, );
      $socket->print($url);
      local $/ = undef; # slurp
      return <$socket>;
    }
    # wrap the save_data sub in our own code
    *old_save_oracle_data = \&App::Phoebe::Oracle::save_data;
    *App::Phoebe::Oracle::save_data = \&new_save_oracle_data;
    # call Antenna after saving
    sub new_save_oracle_data {
      old_save_oracle_data(@_);
      my $gemlog = "gemini://transjovian.org/oracle/log";
      my $res = query("gemini://warmedal.se/~antenna/submit?$gemlog");
      my ($code) = $res =~ /^(\d+)/;
      $log->info("Antenna: $code");
    }

=cut

package App::Phoebe::Oracle;
use App::Phoebe qw($server $log @extensions host_regex port success result print_link wiki_dir with_lock to_url);
use File::Slurper qw(read_binary write_binary);
use Mojo::JSON qw(decode_json encode_json);
use Net::IDN::Encode qw(domain_to_ascii);
use List::Util qw(first any none);
use Encode qw(encode_utf8 decode_utf8);
use POSIX qw(strftime);
use Modern::Perl;
use URI::Escape;
use utf8;

push(@extensions, \&oracle);

our $oracle_space = "oracle";
our @oracle_hosts;
our $max_answers = 3;

sub oracle {
  my $stream = shift;
  my $url = shift;
  my $hosts = oracle_regex();
  my $port = port($stream);
  my ($host, $question, $answer, $number, @numbers);
  if (($host) = $url =~ m!^gemini://($hosts)(?::$port)?/$oracle_space/?$!) {
    return serve_main_menu($stream, $host);
  } elsif (($host) = $url =~ m!^gemini://($hosts)(?::$port)?/$oracle_space/questions$!) {
    return serve_questions($stream, $host);
  } elsif (($host, $question) = $url =~ m!^gemini://($hosts)(?::$port)?/$oracle_space/ask(?:\?([^#]+))?$!) {
    return ask_question($stream, $host, decode_query($question));
  } elsif (($host, $number) = $url =~ m!^gemini://($hosts)(?::$port)?/$oracle_space/question/(\d+)$!) {
    return serve_question($stream, $host, $number);
  } elsif (($host, $number, $answer) =
	   $url =~ m!^gemini://($hosts)(?::$port)?/$oracle_space/question/(\d+)/answer(?:\?([^#]+))?$!) {
    return answer_question($stream, $host, $number, decode_query($answer));
  } elsif (($host, $number) = $url =~ m!^gemini://($hosts)(?::$port)?/$oracle_space/question/(\d+)/publish$!) {
    return publish_question($stream, $host, $number);
  } elsif (($host, $number) = $url =~ m!^gemini://($hosts)(?::$port)?/$oracle_space/question/(\d+)/delete$!) {
    return delete_question($stream, $host, $number);