App-phoebe
view release on metacpan or search on metacpan
lib/App/Phoebe/Web.pm view on Meta::CPAN
serve_file_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/history/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_history_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n||10);
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/diff/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_diff_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n||10);
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/raw/([^/]*)(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_raw_via_http($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
} elsif ($request =~ m!^GET /robots.txt(?:[#?].*)? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_raw_via_http($stream, $host, undef, 'robots');
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/changes(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_changes_via_http($stream, $host, space($stream, $host, $space), $n||100);
} elsif (($filter, $n) = $request =~ m!^GET /do/all(?:/(latest))?/changes(?:/(\d+))? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_all_changes_via_http($stream, $host, $n||100, $filter||"");
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/index HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_index_via_http($stream, $host, space($stream, $host, $space));
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/files HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_files_via_http($stream, $host, space($stream, $host, $space));
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/spaces HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_spaces_via_http($stream, $host, $port);
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/rss HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_rss_via_http($stream, $host, space($stream, $host, $space));
} elsif (($space, $id, $n) = $request =~ m!^GET (?:/($spaces))?/do/atom HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_atom_via_http($stream, $host, space($stream, $host, $space));
} elsif (($space, $n) = $request =~ m!^GET /do/all/atom HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
serve_all_atom_via_http($stream, $host);
} else {
$log->debug("No http handler for $request");
http_error($stream, "Don't know how to handle $request");
}
$log->debug("Done");
};
$log->error("Error: $@") if $@;
alarm(0);
$stream->close_gracefully();
}
sub serve_main_menu_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
$log->info("Serving main menu via HTTP");
my $page = $server->{wiki_main_page};
$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");
if ($page) {
$stream->write(encode_utf8 "<title>" . quote_html($page) . "</title>\n");
} else {
$stream->write("<title>Phoebe</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");
if ($page) {
$stream->write(encode_utf8 to_html(text($stream, $host, $space, $page)) . "\n");
} else {
$stream->write("<h1>Welcome to Phoebe!</h1>\n");
}
blog_html($stream, $host, $space);
$stream->write("<p>Important links:\n");
$stream->write("<ul>\n");
my @pages = @{$server->{wiki_page}};
for my $id (@pages) {
$stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id) . "\n");
}
$stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, "Changes", "do/changes") . "\n");
$stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, "Index of all pages", "do/index") . "\n");
$stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, "Index of all files", "do/files") . "\n")
if @{$server->{wiki_mime_type}};
$stream->write(encode_utf8 "<li>" . link_html($stream, $host, undef, "Index of all spaces", "do/spaces") . "\n")
if @{$server->{wiki_space}} or keys %{$server->{host}} > 1;
# a requirement of the GNU Affero General Public License
$stream->write("<li><a href=\"https://metacpan.org/pod/App::phoebe\">Source</a>\n");
$stream->write("</ul>\n");
$stream->write("</body>\n");
$stream->write("</html>\n");
}
sub link_html {
my $stream = shift;
my $host = shift;
my $space = shift;
my $title = shift;
my $id = shift;
if (not $id) {
$id = "page/$title";
}
my $port = port($stream);
# don't encode the slash
return "<a href=\"https://$host:$port/"
. ($space && $space ne $host ? uri_escape_utf8($space) . "/" : "")
. join("/", map { uri_escape_utf8($_) } split (/\//, $id))
. "\">"
. quote_html($title)
. "</a>";
}
sub blog_html {
my $stream = shift;
my $host = shift;
my $space = shift;
my $n = shift || 10;
my @blog = blog_pages($stream, $host, $space, $n);
return unless @blog;
$stream->write("<p>Blog:\n");
$stream->write("<ul>\n");
# we should check for pages marked for deletion!
for my $id (@blog[0 .. min($#blog, $n - 1)]) {
$stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id) . "\n");
}
$stream->write("</ul>\n");
}
sub serve_css_via_http {
my $stream = shift;
$log->info("Serving CSS via HTTP");
$stream->write("HTTP/1.1 200 OK\r\n");
$stream->write("Content-Type: text/css\r\n");
$stream->write("Cache-Control: public, max-age=86400, immutable\r\n"); # 24h
$stream->write("\r\n");
$stream->write("html { max-width: 70ch; padding: 2ch; margin: auto; color: #111; background: #ffe; }\n");
$stream->write(".del { color: rgb(222,56,43); }\n"); # diff: deleted
$stream->write(".ins { color: rgb(57,181,74); }\n"); # diff: inserted
}
sub serve_index_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
$log->info("Serving index of all pages 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("<title>All Pages</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("<h1>All Pages</h1>\n");
my @pages = pages($stream, $host, $space);
if (@pages) {
$stream->write("<ul>\n");
for my $id (@pages) {
$stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id) . "\n");
}
$stream->write("</ul>\n");
} else {
$stream->write("<p>The are no pages.\n");
}
}
sub serve_files_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
$log->info("Serving all files 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("<title>All Files</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("<h1>All Files</h1>\n");
my @files = files($stream, $host, $space);
if (@files) {
$stream->write("<ul>\n");
for my $id (sort @files) {
$stream->write(encode_utf8 "<li>" . link_html($stream, $host, $space, $id, "file/$id") . "\n");
}
$stream->write("</ul>\n");
} else {
$stream->write("<p>The are no files.\n");
}
}
sub serve_spaces_via_http {
my $stream = shift;
my $host = shift;
my $port = shift;
$log->info("Serving all spaces 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("<title>All Spaces</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("<h1>All Spaces</h1>\n");
$stream->write("<ul>\n");
my $spaces = space_links($stream, "https", $host, $port);
for my $url (sort keys %$spaces) {
$stream->write(encode_utf8 "<li><a href=\"$url\">$spaces->{$url}</a>\n");
}
$stream->write("</ul>\n");
}
sub serve_changes_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
my $n = shift;
$log->info("Serving $n changes 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("<title>Changes</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("<h1>Changes</h1>\n");
$stream->write("<ul>\n");
$stream->write("<li>" . link_html($stream, $host, undef, "Changes for all spaces", "do/all/changes") . "\n")
if @{$server->{wiki_space}};
$stream->write("<li>" . link_html($stream, $host, $space, "Atom feed", "do/atom") . "\n");
$stream->write("<li>" . link_html($stream, $host, $space, "RSS feed", "do/rss") . "\n");
$stream->write("</ul>\n");
my $dir = wiki_dir($host, $space);
my $log = "$dir/changes.log";
if (not -e $log) {
$stream->write("<p>No changes.\n");
return;
}
$stream->write("<p>Showing up to $n changes.\n");
my $fh = File::ReadBackwards->new($log);
my $more = changes($stream,
$n,
sub { $stream->write(encode_utf8 "<h2>" . shift . "</h2>\n") },
sub { $stream->write("<p>" . shift . " by " . colourize_html($stream, shift) . "\n") },
sub {
my ($host, $space, $title, $id) = @_;
$stream->write(encode_utf8 "<br> → " . link_html($stream, $host, $space, $title, $id) . "\n");
},
sub { $stream->write(encode_utf8 "<br> → $_[0]\n") },
sub {
return unless $_ = decode_utf8($fh->readline);
chomp;
split(/\x1f/), $host, $space, 0 });
return unless $more;
$stream->write("<p>" . link_html($stream, $host, $space, "More...", "do/changes/" . 10 * $n) . "\n");
}
sub serve_all_changes_via_http {
my $stream = shift;
my $host = shift;
my $n = shift;
my $filter = shift;
$log->info($filter ? "Serving $n all $filter changes via HTTP" : "Serving $n all changes 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("<title>Changes for all spaces</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("<h1>Changes for all spaces</h1>\n");
$stream->write("<ul>\n");
$stream->write("<li>" . link_html($stream, $host, undef, "Atom feed", "do/all/atom") . "\n");
if ($filter) { $stream->write("<li>" . link_html($stream, $host, undef, "All changes", "do/all/changes/$n") . "\n") }
else { $stream->write("<li>" . link_html($stream, $host, undef, "Latest changes", "do/all/latest/changes/$n") . "\n") }
$stream->write("</ul>\n");
my $log = all_logs($stream, $host, $n);
if (not @$log) {
$stream->write("<p>No changes.\n");
return;
}
# taking the head of the @$log to get new log entries
$stream->write("<p>Showing up to $n $filter changes.\n");
my $more = changes($stream,
$n,
sub { $stream->write("<h2>" . shift . "</h2>\n") },
sub { $stream->write("<p>" . shift . " by " . colourize_html($stream, shift) . "\n") },
sub { $stream->write(encode_utf8 "<br> → " . link_html($stream, @_) . "\n") },
sub { $stream->write(encode_utf8 "<br> → $_[0]\n") },
sub { @{shift(@$log) }, 1 if @$log },
undef,
$filter);
return unless $more;
$stream->write("<p>" . link_html($stream, $host, undef, "More...", "do/all/changes/" . 10 * $n) . "\n");
}
# https://en.wikipedia.org/wiki/ANSI_escape_code#3/4_bit
sub colourize_html {
my $stream = shift;
my $code = shift;
my %rgb = (
0 => "0,0,0",
1 => "222,56,43",
2 => "57,181,74",
3 => "255,199,6",
4 => "0,111,184",
5 => "118,38,113",
6 => "44,181,233",
7 => "204,204,204");
$code = join("", map {
"<span style=\"color: rgb($rgb{$_}); background-color: rgb($rgb{$_})\">$_</span>";
} split //, $code);
return $code;
}
sub serve_rss_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
$log->info("Serving RSS via HTTP");
$stream->write("HTTP/1.1 200 OK\r\n");
$stream->write("Content-Type: application/xml\r\n");
$stream->write("\r\n");
rss($stream, $host, $space, 'https');
}
sub serve_atom_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
$log->info("Serving Atom via HTTP");
$stream->write("HTTP/1.1 200 OK\r\n");
$stream->write("Content-Type: application/xml\r\n");
$stream->write("\r\n");
my $dir = wiki_dir($host, $space);
my $log = "$dir/changes.log";
my $fh = File::ReadBackwards->new($log);
atom($stream, sub {
return unless $_ = decode_utf8($fh->readline);
chomp;
split(/\x1f/), $host, $space, 0
}, $host, $space, 'https');
}
sub serve_all_atom_via_http {
my $stream = shift;
my $host = shift;
$log->info("Serving Atom via HTTP");
$stream->write("HTTP/1.1 200 OK\r\n");
$stream->write("Content-Type: application/xml\r\n");
$stream->write("\r\n");
my $log = all_logs($stream, $host, 30);
atom($stream, sub { @{shift(@$log) }, 1 if @$log }, $host, undef, 'https');
}
sub serve_raw_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
$log->info("Serving raw $id via HTTP");
$stream->write("HTTP/1.1 200 OK\r\n");
$stream->write("Content-Type: text/plain; charset=UTF-8\r\n");
$stream->write("\r\n");
$stream->write(encode_utf8 text($stream, $host, $space, $id, $revision));
}
sub serve_diff_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
$log->info("Serving the diff of $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>Differences for " . 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>Differences for " . quote_html($id) . "</h1>\n");
$stream->write("<p>Showing the differences between revision $revision and the current revision.\n");
my $new = text($stream, $host, $space, $id);
my $old = text($stream, $host, $space, $id, $revision);
diff($old, $new,
sub { $stream->write(encode_utf8 "<p>$_\n") for @_ },
sub { $stream->write(encode_utf8 "<p class=\"del\">" . join("<br>", map { $_||"âŽ" } @_) . "\n") },
sub { $stream->write(encode_utf8 "<p class=\"ins\">" . join("<br>", map { $_||"âŽ" } @_) . "\n") },
sub { "<strong>$_</strong>" });
}
sub serve_page_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
$log->info("Serving $id as HTML via HTTP");
$stream->write("HTTP/1.1 200 OK\r\n");
$stream->write("Content-Type: text/html\r\n");
$stream->write("\r\n");
html_page($stream, $host, $space, $id, $revision);
}
sub serve_history_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $n = shift;
$log->info("Serve history 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>Page history for " . 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>Page history for " . quote_html($id) . "</h1>\n");
my $dir = wiki_dir($host, $space);
my $log = "$dir/changes.log";
if (not -e $log) {
$stream->write("<p>No changes.\n");
return;
}
$stream->write("<p>Showing up to $n changes.\n");
my $fh = File::ReadBackwards->new($log);
my $first = 1;
my $more = changes($stream,
$n,
sub { $stream->write(encode_utf8 "<h2>" . shift . "</h2>\n") },
sub { $stream->write(encode_utf8 "<p>" . shift . " by " . colourize_html($stream, shift) . "\n") },
sub {
my ($host, $space, $title, $id) = @_;
$stream->write(encode_utf8 "<br> → " . link_html($stream, $host, $space, $title, $id) . "\n");
},
sub { "<br> → $_[0]" },
sub {
READ:
return unless $_ = decode_utf8($fh->readline);
chomp;
my ($ts, $id_log, $revision, $code) = split(/\x1f/);
goto READ if $id_log ne $id;
$ts, $id_log, $revision, $code, $host, $space, 0 });
return unless $more;
$stream->write("<p>" . link_html($stream, $host, $space, "More...", "history/" . uri_escape_utf8($id) . "/" . 10 * $n) . "\n");
}
sub serve_file_via_http {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
$log->info("Serve file $id");
my $dir = wiki_dir($host, $space);
my $file = "$dir/file/$id";
my $meta = "$dir/meta/$id";
if (not -f $file) {
$stream->write("HTTP/1.1 404 Error\r\n");
$stream->write("Content-Type: text/plain\r\n");
$stream->write("\r\n");
$stream->write("File not found\r\n");
return;
} elsif (not -f $meta) {
$stream->write("HTTP/1.1 500 Error\r\n");
$stream->write("Content-Type: text/plain\r\n");
$stream->write("\r\n");
$stream->write("Metadata not found\r\n");
return;
}
my %meta = (map { split(/: /, $_, 2) } read_lines($meta));
if (not $meta{'content-type'}) {
( run in 2.401 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )