view release on metacpan or  search on metacpan

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

  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);
  } elsif (($host, @numbers) = $url =~ m!^gemini://($hosts)(?::$port)?/$oracle_space/question/(\d+)/(\d+)/delete$!) {
    return delete_answer($stream, $host, @numbers);
  } elsif (($host) = $url =~ m!^gemini://($hosts)(?::$port)?/$oracle_space/log$!) {
    return serve_log($stream, $host);
  }
  return;
}

sub oracle_regex {
  return join("|", map { quotemeta domain_to_ascii $_ } @oracle_hosts) || host_regex();
}

sub load_data {
  my $host = shift;
  my $dir = wiki_dir($host, $oracle_space);
  return [] unless -f "$dir/oracle.json";
  return decode_json read_binary("$dir/oracle.json");
}

sub save_data {
  my ($stream, $host, $data) = @_;
  my $dir = wiki_dir($host, $oracle_space);
  my $bytes = encode_json $data;
  # We don't close the stream on a successful call.
  with_lock($stream, $host, $oracle_space, sub {
    write_binary("$dir/oracle.json", $bytes)});
}

sub new_number {
  my $data = shift;
  while (1) {
    my $n = int(rand(10000));
    return $n unless any { $n eq $_->{number} } @$data;
  }
}

sub decode_query {
  my $text = shift;
  return '' unless $text;
  $text =~ s/\+/ /g;
  return decode_utf8(uri_unescape($text));
}

sub serve_main_menu {
  my ($stream, $host) = @_;
  my $data = load_data($host);
  my $fingerprint = $stream->handle->get_fingerprint();
  success($stream);
  $log->info("Serving oracles");
  $stream->write("# Oracle\n");
  if ($fingerprint) {
    $stream->write("You have an identity or a client certificate picked, so you can ask a question or answer questions by others.\n");
  } else {
    $stream->write("You need to use an identity or pick a client certificate if you want to ask a question or give an answer.\n");
  }
  $stream->write("=> /$oracle_space/ask Ask a question\n");
  $stream->write("=> /$oracle_space/log Check the log\n");
  # skipping answered and unpublished questions, unless you asked the question
  my @questions = grep {
    $_->{status} ne 'answered'
	or $fingerprint and $fingerprint eq $_->{fingerprint}
  } @$data;
  for my $question (@questions) {
    $stream->write("\n\n");
    $stream->write("## Question #$question->{number}\n");
    $stream->write("> " . encode_utf8 $question->{text});
    $stream->write("\n");
    if ($fingerprint and $fingerprint eq $question->{fingerprint}) {
      $stream->write("This is your question.");
      $stream->write(" You need to publish or delete it before you can ask another one.")
	  if $question->{status} ne 'published';
      $stream->write("\n");
      $stream->write("=> /$oracle_space/question/$question->{number} Manage\n");
    } elsif ($question->{status} eq 'asked') {
      if ($fingerprint and any { $fingerprint eq $_->{fingerprint} } @{$question->{answers}}) {
	$stream->write("This question is still looking for answers, but you already gave your answer.\n");
	$stream->write("=> /$oracle_space/question/$question->{number} Take a look\n");
      } else {
	$stream->write("This question is still looking for answers.\n");
	$stream->write("=> /$oracle_space/question/$question->{number} Answer\n");
      }
    } else {
      # it's published
      my $n = grep { $_->{text} } @{$question->{answers}};
      if ($n == 1) {
	$stream->write("This question has one answer.\n");
      } else {
	$stream->write("This question has $n answers.\n");
      }
      $stream->write("=> /$oracle_space/question/$question->{number} Show\n");
    }
  }
  return 1;
}

sub serve_log {
  my ($stream, $host) = @_;
  my $data = load_data($host);
  success($stream);
  $log->info("Serving oracle log");
  $stream->write("# Oracle Log\n");