charset results from the CPAN

App-phoebe
use Modern::Perl;
use URI::Escape;

unshift(@request_handlers, '^POST .* HTTP/1\.[01]$' => \&handle_http_header);

# edit from the web

push(@footer, \&add_edit_link_to_footer);

sub is_editable {
  my ($space) = @_;
  my $editable = { return test => 1, gemini => 1 };
  return $editable->{$space};
}

sub add_edit_link_to_footer {
  my ($stream, $host, $space, $id, $revision, $format) = @_;
  # only add the edit links to the web UI of the test space
  # return if not $space or not is_editable($space);
  return "" if $revision or not $id or $format ne "html";
  $id = uri_escape_utf8($id);
  if ($space) {
    $space = uri_escape_utf8($space);
    return "=> /$space/do/edit/$id Edit";
  } else {
    return "=> /do/edit/$id Edit";
  }
}

push(@extensions, \&process_edit_requests);

sub process_edit_requests {
  my ($stream, $request, $headers, $buffer) = @_;
  my $host_regex = host_regex();
  my $spaces = space_regex();
  my $port = port($stream);
  my ($host, $space, $id, $token, $query);
  if (($space, $id) = $request =~ m!^GET (?:/($spaces))?/do/edit/([^/#?]+) HTTP/1\.[01]$!
      and is_editable($space)
      and ($host) = $headers->{host} =~ m!^($host_regex)(?::$port)$!) {
    serve_edit_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)));
  } elsif (($space, $id) = $request =~ m!^POST (?:/($spaces))?/do/edit/([^/#?]+) HTTP/1\.[01]$!
	   and is_editable($space)
	   and ($host) = $headers->{host} =~ m!^($host_regex)(?::$port)$!) {
    save_edit_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $headers, $buffer);
  } else {
    return 0;
  }
  return 1;
}

sub serve_edit_via_http {
  my ($stream, $host, $space, $id) = @_;
  $log->info("Serve edit page for $id via HTTP");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: text/html\r\n");
  $stream->write("\r\n");
  $stream->write("<!DOCTYPE html>\n");
  $stream->write("<html>\n");
  $stream->write("<head>\n");
  $stream->write("<meta charset=\"utf-8\">\n");
  $stream->write(encode_utf8 "<title>" . quote_html($id) . "</title>\n");
  $stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\n");
  $stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n");
  $stream->write("</head>\n");
  $stream->write("<body>\n");
  $stream->write(encode_utf8 "<h1>" . quote_html($id) . "</h1>\n");
  $stream->write("<form method=\"POST\">\n");
  $stream->write("<p><label for=\"token\">Token:</label>\n");
  $stream->write("<br><input type=\"text\" id=\"token\" name=\"token\" required>\n");
  $stream->write("<p><label for=\"text\">Text:</label>\n");
  my $text = text($stream, $host, $space, $id);
  # textarea can be empty in order to delete a page
  $stream->write(encode_utf8 "<br><textarea style=\"width: 100%; height: 20em;\" id=\"text\" name=\"text\">$text</textarea>\n");
  $stream->write("<p><input type=\"submit\" value=\"Save\">\n");
  $stream->write("</form>\n");
  $stream->write("</body>\n");
  $stream->write("</html>\n");
}

sub save_edit_via_http {
  my ($stream, $host, $space, $id, $headers, $buffer) = @_;
  $log->info("Save edit for $id via HTTP");
  return http_error($stream, "Page name is missing") unless $id;
  return http_error($stream, "Page names must not control characters") if $id =~ /[[:cntrl:]]/;
  return http_error($stream, "Content type not known")
      if not $headers->{"content-type"} or $headers->{"content-type"} ne "application/x-www-form-urlencoded";
  my %params;
  for (split(/&/, $buffer)) {
    my ($key, $value) = map { s/\+/ /g; decode_utf8(uri_unescape($_)) } split(/=/, $_, 2);
    $params{$key} = $value;
  }
  $log->debug("Parameters: " . join(", ", map { "$_ => '$params{$_}'" } keys %params));
  my $token = quotemeta($params{token}||"");
  my @tokens = @{$server->{wiki_token}};
  push(@tokens, @{$server->{wiki_space_token}->{$space}})
      if $space and $server->{wiki_space_token}->{$space};
  if (@tokens) {
    if (not $token) {
      $log->info("Token required (one of @tokens)");
      http_error($stream, "Token required");
      return;
    }
    if (not grep(/^$token$/, @tokens)) {
      $log->info("Wrong token ($token)");
      http_error($stream, "Wrong token");
      return;
    }
  }
  my $text = $params{text}||"";
  $text =~ s/\r\n/\n/g; # fix DOS EOL convention
  with_lock($stream, $host, $space, sub { write_page_for_http($stream, $host, $space, $id, $text) } );
}

sub write_page_for_http {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $text = shift;
  $log->info("Writing page $id");
( run in 0.786 second using v1.01-cache-2.11-cpan-39bf76dae61 )