App-Phoebe
view release on metacpan or search on metacpan
lib/App/Phoebe.pm view on Meta::CPAN
use App::Phoebe qw(@extensions @main_menu port host_regex success);
use Modern::Perl;
push(@main_menu, "=> /do/test Test");
push(@extensions, \&serve_test);
sub serve_test {
my $stream = shift;
my $url = shift;
my $hosts = host_regex();
my $port = port($stream);
if ($url =~ m!^gemini://($hosts):$port/do/test$!) {
success($stream, 'text/plain; charset=UTF-8');
$stream->write("Test\n");
return 1;
}
return;
}
EOT
This example also shows how to redefine existing code in your config file
without the warning "Subroutine … redefined".
lib/App/Phoebe.pm view on Meta::CPAN
# using a client that has an "up" command, you'd end up at
# gemini://localhost:1965/page – but what should happen in this case? We should
# redirect these requests to gemini://localhost:1965/, I think.
sub reserved_regex {
return join("|", qw(do page raw file html history diff));
}
sub success {
my $stream = shift;
my $type = shift || 'text/gemini; charset=UTF-8';
my $lang = shift;
if ($lang) {
result($stream, "20", "$type; lang=$lang");
} else {
result($stream, "20", "$type");
}
}
sub result {
my $stream = shift;
lib/App/Phoebe.pm view on Meta::CPAN
$stream->write("</feed>\n");
}
sub serve_raw {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
$log->info("Serving raw $id");
success($stream, 'text/plain; charset=UTF-8');
$stream->write(encode_utf8 text($stream, $host, $space, $id, $revision));
}
sub serve_diff {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
my $style = shift;
lib/App/Phoebe.pm view on Meta::CPAN
sub html_page {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
$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(encode_utf8 to_html(text($stream, $host, $space, $id, $revision)) . "\n");
$stream->write(encode_utf8 to_html(html_footer($stream, $host, $space, $id, $revision)) . "\n");
$stream->write("</body>\n");
$stream->write("</html>\n");
lib/App/Phoebe/Oddmuse.pm view on Meta::CPAN
my $url = "$oddmuse_wikis{$host}";
$url .= "/$space" if $space;
$url .= "/raw/" . uri_escape_utf8($id);
$url .= "?revision=$revision" if $revision;
my $page = oddmuse_get_raw($stream, $url) // return;
if (my ($type, $data) = $page =~ /^#FILE (\S+) ?(?:\S+)?\n(.*)/s) {
oddmuse_serve_file_page($stream, $id, $type, $data);
return;
}
$log->info("Serving raw $id");
success($stream, 'text/plain; charset=UTF-8');
$stream->write(encode_utf8 $page);
}
sub oddmuse_serve_html {
my $stream = shift;
my $host = shift;
my $space = shift;
my $id = shift;
my $revision = shift;
my $url = "$oddmuse_wikis{$host}";
lib/App/Phoebe/Spartan.pm view on Meta::CPAN
}
$log->debug("Done");
};
$log->error("Error: $@") if $@;
alarm(0);
$stream->close_gracefully();
}
sub success {
my $stream = shift;
my $type = shift || 'text/gemini; charset=UTF-8';
$stream->write("2 $type\r\n");
}
sub result {
my $stream = shift;
my $code = substr(shift, 0, 1);
my $meta = shift;
$stream->write("$code $meta\r\n");
}
lib/App/Phoebe/SpeedBump.pm view on Meta::CPAN
$stream->write("=> /do/speed-bump/load load\n");
$stream->write("=> /do/speed-bump/reset reset\n");
return 1;
} elsif ($url =~ m!^gemini://(?:$hosts)(?::$port)?/do/speed-bump/status$!) {
with_speed_bump_fingerprint($stream, sub {
success($stream);
speed_bump_status($stream) });
return 1;
} elsif ($url =~ m!^gemini://(?:$hosts)(?::$port)?/do/speed-bump/debug$!) {
with_speed_bump_fingerprint($stream, sub {
success($stream, 'text/plain; charset=UTF-8');
use Data::Dumper;
$stream->write(Dumper($speed_data)) });
return 1;
} elsif ($url =~ m!^gemini://(?:$hosts)(?::$port)?/do/speed-bump/save$!) {
with_speed_bump_fingerprint($stream, sub {
success($stream);
my $bytes = encode_json $speed_data;
my $dir = $server->{wiki_dir};
write_binary("$dir/speed-bump.json", $bytes);
$stream->write("# Speed Bump Saved\n");
lib/App/Phoebe/Web.pm view on Meta::CPAN
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) {
lib/App/Phoebe/Web.pm view on Meta::CPAN
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) {
lib/App/Phoebe/Web.pm view on Meta::CPAN
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) {
lib/App/Phoebe/Web.pm view on Meta::CPAN
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");
lib/App/Phoebe/Web.pm view on Meta::CPAN
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");
lib/App/Phoebe/Web.pm view on Meta::CPAN
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") }
lib/App/Phoebe/Web.pm view on Meta::CPAN
}
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,
lib/App/Phoebe/Web.pm view on Meta::CPAN
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");
lib/App/Phoebe/WebComments.pm view on Meta::CPAN
sub serve_comment_via_http {
my ($stream, $host, $space, $id) = @_;
$log->info("Serve comments 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>\r\n");
$stream->write("<html>\r\n");
$stream->write("<head>\r\n");
$stream->write("<meta charset=\"utf-8\">\r\n");
$stream->write(encode_utf8 "<title>" . quote_html($id) . "</title>\r\n");
$stream->write("<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>\r\n");
$stream->write("<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\r\n");
$stream->write("</head>\r\n");
$stream->write("<body>\r\n");
$stream->write(encode_utf8 "<h1>" . quote_html($id) . "</h1>\r\n");
$stream->write("<form method=\"POST\">\r\n");
$stream->write("<p><label for=\"token\">Token:</label>\r\n");
$stream->write("<br><input type=\"text\" id=\"token\" name=\"token\" required>\r\n");
$stream->write("<p><label for=\"comment\">Comment:</label>\r\n");
lib/App/Phoebe/WebDAV.pm view on Meta::CPAN
my $stat = $doc->createElement('D:status');
$stat->appendText('HTTP/1.1 404 Not Found');
$propstat->addChild($stat);
$resp->addChild($propstat);
}
}
my $str = $doc->toString(1);
my $len = length($str);
$log->debug("RESPONSE: 207\n" . $doc->toString(1));
$stream->write("HTTP/1.1 207 Multi-Status\r\n");
$stream->write("Content-Type: application/xml; charset=\"utf-8\"\r\n");
$stream->write("Content-Length: $len\r\n");
if ($path =~ m!/(page|raw|file|login)$!) {
$stream->write("Content-Location: $path/\r\n");
}
$stream->write("\r\n");
$stream->write($str);
}
sub to_url {
my $space = shift;
lib/App/Phoebe/WebEdit.pm view on Meta::CPAN
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");
if (@{$server->{wiki_token}} > 0) {
$stream->write("<p><label for=\"token\">Token:</label>\n");
$stream->write("<br><input type=\"text\" id=\"token\" name=\"token\" required>\n");
lib/App/Phoebe/WebStaticFiles.pm view on Meta::CPAN
my ($host, $route, $file);
if ($request =~ m!^GET /do/static/? HTTP/1\.[01]$!
and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
$log->debug("Serving the list of static routes via the web");
$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 Directories</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 Directories</h1>\n");
$stream->write("<ul>\n");
for my $route (sort keys %routes) {
$stream->write("<li><a href=\"/do/static/" . uri_escape_utf8($route) . "\">"
. encode_utf8($route) . "</a>\n");
lib/App/Phoebe/WebStaticFiles.pm view on Meta::CPAN
http_error($stream, "Unknown route: " . encode_utf8($route));
return 1;
}
$log->debug("Serving list of files at $route via the web, reading $dir");
$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>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>Files</h1>\n");
$stream->write("<ul>\n");
for my $file (sort map { decode_utf8($_) } grep !/^\./, read_dir($dir)) {
$stream->write(encode_utf8 "<li><a href=\"/do/static/" . uri_escape_utf8($route) . "/"
. uri_escape_utf8($file) . "\">"
script/gemini view on Meta::CPAN
# 1h timeout (for chat)
$stream->timeout(3600);
my ($header, $mimetype, $encoding);
$stream->on(read => sub {
my ($stream, $bytes) = @_;
if (not $header) {
# decide how to decode the bytes
($header) = $bytes =~ /^(.*?)\r\n/;
$header = decode_utf8 $header;
warn "$header\n";
if ($header =~ /^2\d* (?:text\/\S+)?(?:; *charset=(\S+))?$/g) {
# empty, or text without charset defaults to UTF-8
$encoding = $1 || 'UTF-8';
}
$bytes =~ s/^(.*?)\r\n//;
return unless $bytes;
if (-t STDOUT) {
# connected to a tty
if ($force) {
binmode(STDOUT, ":raw");
print $bytes;
} elsif ($encoding) {
script/phoebe view on Meta::CPAN
writing new private key to 'key.pem'
-----
If it aborts, see the L</Troubleshooting> section below. If it runs, open a
second terminal and test it:
gemini gemini://localhost/
You should see a Gemini page starting with the following:
20 text/gemini; charset=UTF-8
Welcome to Phoebe!
Success!! 😀 🚀🚀
Let's create a new page using the Titan protocol, from the command line:
echo "Welcome to the wiki!" > test.txt
echo "Please be kind." >> test.txt
titan --url=titan://localhost/raw/Welcome --token=hello test.txt
You should get a nice redirect message.
30 gemini://localhost:1965/page/Welcome
You can check the page:
gemini gemini://localhost:1965/page/Welcome
You should get back a page that starts as follows:
20 text/gemini; charset=UTF-8
Welcome to the wiki!
Please be kind.
Yay! ðŸ˜ðŸŽ‰ 🚀🚀
If you have a bunch of Gemtext files in a directory, you can upload them all in
one go:
titan --url=titan://localhost/ --token=hello *.gmi
script/phoebe-ctl view on Meta::CPAN
my $id = decode_utf8 $page;
my $text = read_text "$source_dir/page/$page.gmi"; # fatal if it does not exist
say "Converting $id";
my $filename = "$target_dir/$page";
$filename .= ".html" unless $no_extension;
open(my $fh, ">:utf8", $filename)
or die "Cannot write $filename: $!\n";
say $fh "<!DOCTYPE html>";
say $fh "<html>";
say $fh "<head>";
say $fh "<meta charset=\"utf-8\">";
say $fh "<title>" . quote_html($id) . "</title>";
say $fh "<link type=\"text/css\" rel=\"stylesheet\" href=\"/default.css\"/>";
say $fh "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">";
say $fh "</head>";
say $fh "<body>";
say $fh "<h1>" . quote_html($id) . "</h1>";
say $fh to_html($text);
# skipping footers
say $fh "</body>";
say $fh "</html>";
script/spartan view on Meta::CPAN
my ($header, $mimetype, $encoding);
$stream->on(read => sub {
my ($stream, $bytes) = @_;
if ($header and $encoding) {
print encode(locale => decode($encoding, $bytes));
} elsif ($header) {
print encode(locale => $bytes);
} else {
($header) = $bytes =~ /^(.*?)\r\n/;
warn "$header\n";
if ($header =~ /^2\d* (?:text\/\S+)?(?:; *charset=(\S+))?$/g) {
# empty, or text without charset defaults to UTF-8
$encoding = $1 || 'UTF-8';
}
$bytes =~ s/^(.*?)\r\n//; # remove header
if ($encoding) {
say encode(locale => decode($encoding, $bytes));
} else {
print encode(locale => $bytes);
}
}});
# Write request
t/Iapetus.t view on Meta::CPAN
my $haiku = <<EOT;
Quiet keyboard tapping,
Tests are missing, and it's late,
My partner fast asleep.
EOT
$page = iapetus("iapetus://$host:$port/Haiku 82\r\n", $haiku);
like($page, qr/^30 $base\/page\/Haiku\r$/, "Iapetus Haiku");
$page = query_gemini("$base/page/Haiku");
like($page, qr/^20 text\/gemini; charset=UTF-8\r\n# Haiku\n$haiku/, "Haiku saved");
# plain text
$page = query_gemini("$base\/raw\/Haiku");
like($page, qr/$haiku/m, "Raw text");
done_testing();
t/PageHeadings.t view on Meta::CPAN
# Hurt
When I type, it hurts
When I do not type, it hurts
My fingers, they hurt
EOT
# create a regular page, including updating the page index
like(query_gemini("$titan/raw/2021-07-16;size=80;mime=text/plain;token=hello", $haiku),
qr/^30/, "Page redirect after save");
like(query_gemini("$base/page/2021-07-16"),
qr/^20 text\/gemini; charset=UTF-8\r\n# Hurt\n/, "Page name not used as title");
like(query_gemini("$base/"),
qr/^=> $base\/page\/2021-07-16 Hurt/m, "Date page listed");
done_testing;
t/Spartan.t view on Meta::CPAN
like($page, qr(^yo$)m, "Page Text");
# handling of ```
my $haiku = <<'EOT';
Through open windows
Hear the garbage truck's engine
Rattle in the heat
EOT
query_spartan("/page/2021-06-28", "localhost", "```\n$haiku```\n");
$page = query_spartan("/page/2021-06-28");
like($page, qr(^2 text/gemini; charset=UTF-8\r\n# 2021-06-28\n```\n$haiku```\n), "No empty lines");
$haiku = <<'EOT';
Outside the muted
Endless city noise of cars
And a shy sparrow
EOT
query_spartan("/page/2021-06-28", "localhost", "```\n$haiku```\n");
$page = query_spartan("/page/2021-06-28");
like($page, qr(^2 text/gemini; charset=UTF-8\r\n# 2021-06-28\n```\n$haiku```\n), "Change!");
# history
$page = query_spartan("/history/2021-06-28");
like($page, qr(^# Page history for 2021-06-28$)m, "History title");
like($page, qr(^=> spartan://localhost:$spartan_port/page/2021-06-28 2021-06-28 \(current\)$)m, "Current revision link");
like($page, qr(^=> spartan://localhost:$spartan_port/page/2021-06-28/1 2021-06-28 \(1\)$)m, "First revision link");
like($page, qr(^=> spartan://localhost:$spartan_port/diff/2021-06-28/1 Differences$)m, "Diff link");
$page = query_spartan("/page/2021-06-28/1");
like($page, qr(^Through open windows)m, "First revision text");
my $haiku = <<EOT;
Quiet disk ratling
Keyboard clicking, then it stops.
Rain falls and I think
EOT
$page = query_gemini("$titan/raw/Haiku;size=76;mime=text/plain;token=hello", $haiku);
like($page, qr/^30 $base\/page\/Haiku\r$/, "Titan Haiku");
$page = query_gemini("$base/page/Haiku");
like($page, qr/^20 text\/gemini; charset=UTF-8\r\n# Haiku\n$haiku/, "Haiku saved");
# no MIME type
$haiku = <<EOT;
The warm oven hums
The fresh bread too hot to touch
The smell is heaven
EOT
# plain text
$page = query_gemini("$titan/raw/Bread;size=72;token=hello", $haiku);
like($page, qr/^30 $base\/page\/Bread\r$/, "Bread haiku without MIME type");
$page = query_gemini("$base/page/Bread");
like($page, qr/^20 text\/gemini; charset=UTF-8\r\n# Bread\n$haiku/, "Bread haiku saved");
# upload image
my $data = read_binary("t/alex.jpg");
my $size = length($data);
$page = query_gemini("$titan/raw/Alex;size=$size;token=hello", $data);
like($page, qr/^59 The text is invalid UTF-8/, "Upload image without MIME type");
$page = query_gemini("$titan/raw/Alex;size=$size;mime=image/png;token=hello", $data);
like($page, qr/^59 This wiki does not allow image\/png/, "Upload image with wrong MIME type");
$page = query_gemini("$base/page/Alex");
t/encoding.t view on Meta::CPAN
my $text = <<EOT;
Schröder answered: ｢郵便局｣
EOT
my $encoded_text = encode_utf8($text);
my $length = length($encoded_text);
my $page = query_gemini("$titan/raw/$encoded_name;size=$length;mime=text/plain;token=hello", $encoded_text);
like($page, qr/^30 $base\/page\/$encoded_name\r$/, "Titan Text");
$page = query_gemini("$base/page/$encoded_name");
like($page, qr/^20 text\/gemini; charset=UTF-8\r\n# $name\n$text/, "Text saved");
my $punycode = domain_to_ascii($idn);
$base = encode_utf8 "gemini://$punycode:$port";
$titan = encode_utf8 "titan://$punycode:$port";
SKIP: {
skip "Locale cannot handle test data", 3 unless decode(locale => encode(locale => $name)) eq $name;
$page = query_gemini("$base/page/$encoded_name");
like($page, qr/# 日本語\nThis page does not yet exist/, "International Domain Name");
$page = query_gemini("$titan/raw/$encoded_name;size=$length;mime=text/plain;token=hello", $encoded_text);
like($page, qr/^30 $base\/page\/$encoded_name\r$/, "Titan Text");
$page = query_gemini("$base/page/$encoded_name");
like($page, qr/^20 text\/gemini; charset=UTF-8\r\n# $name\n$text/, "Text saved");
my $data = read_binary("t/alex.jpg");
my $size = length($data);
$page = query_gemini("$titan/raw/Alex%E2%80%99s%20Avatar;size=$size;mime=image/jpeg;token=hello", $data);
like($page, qr/^30 $base\/file\/Alex%E2%80%99s%20Avatar\r/, "Upload image");
$page = query_gemini("$base/do/files");
like($page, qr/=> $base\/file\/Alex%E2%80%99s%20Avatar Alex’s Avatar/, "Image listed");
$page = query_gemini("$base/file/Alex%E2%80%99s%20Avatar");
like($page, qr/^20 image\/jpeg\r\n/, "Image download");
t/oddmuse-wiki.pl view on Meta::CPAN
sub GetHeaderTitle {
my ($id, $title, $oldId) = @_;
return $q->h1($title) if $id eq '';
return $q->h1(GetSearchLink($id, '', '', T('Click to search for references to this page')));
}
sub GetHttpHeader {
return if $HeaderIsPrinted; # When calling ReportError, we don't know whether HTTP headers have
$HeaderIsPrinted = 1; # already been printed. We want them printed just once.
my ($type, $ts, $status, $encoding) = @_;
$q->charset($type =~ m!^(text/|application/xml)! ? 'utf-8' : ''); # text/plain, text/html, application/xml: UTF-8
my %headers = (-cache_control=>($UseCache < 0 ? 'no-cache' : 'max-age=10'));
# Set $ts when serving raw content that cannot be modified by cookie
# parameters; or 'nocache'; or undef. If you provide a $ts, the last-modified
# header generated will by used by HTTP/1.0 clients. If you provide no $ts,
# the etag header generated will be used by HTTP/1.1 clients. In this
# situation, cookie parameters can influence the look of the page and we
# cannot rely on $LastUpdate. HTTP/1.0 clients will ignore etags. See RFC 2616
# section 13.3.4.
if (GetParam('cache', $UseCache) >= 2 and $ts ne 'nocache') {
$headers{'-last-modified'} = TimeToRFC822($ts) if $ts;
t/oddmuse-wiki.pl view on Meta::CPAN
}
sub GetHtmlHeader { # always HTML!
my ($title, $id) = @_;
my $edit_link = $id ? '<link rel="alternate" type="application/wiki" title="'
. T('Edit this page') . '" href="' . ScriptUrl('action=edit;id=' . UrlEncode($id)) . '" />' : '';
my $theme = GetParam('theme', 'default');
return $DocumentHeader
. $q->head($q->title($title) . $edit_link
. GetCss() . GetRobots() . GetFeeds() . $HtmlHeaders
. '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />')
. qq{<body class="$theme" lang="$CurrentLanguage">};
}
sub GetRobots { # NOINDEX for non-browse pages.
if (GetParam('action', 'browse') eq 'browse' and not GetParam('revision', '')) {
return '<meta name="robots" content="INDEX,FOLLOW" />';
} else {
return '<meta name="robots" content="NOINDEX,FOLLOW" />';
}
}
t/oddmuse-wiki.pl view on Meta::CPAN
return $html;
}
return '';
}
sub GetFormStart {
my ($ignore, $method, $class) = @_;
$method ||= 'post';
$class ||= 'form';
return $q->start_multipart_form(-method=>$method, -action=>$FullUrl,
-accept_charset=>'utf-8', -class=>$class);
}
sub GetSearchForm {
my $html = GetFormStart(undef, 'get', 'search') . $q->start_p;
$html .= $q->label({-for=>'search'}, T('Search:')) . ' '
. $q->textfield(-name=>'search', -id=>'search', -size=>15, -accesskey=>T('f')) . ' ';
if (GetParam('search') ne '' and UserIsAdmin()) { # see DoBrowseRequest
$html .= $q->label({-for=>'replace'}, T('Replace:')) . ' '
. $q->textfield(-name=>'replace', -id=>'replace', -size=>20) . ' '
. $q->label({-for=>'delete', -title=>'If you want to replace matches with the empty string'}, T('Delete')) . ' '
my $haiku = <<EOT;
Outside children shout
Everybody is running
Recess is the best
EOT
$page = query_gemini("$titan/alex/raw/Haiku;size=63;mime=text/plain;token=hello", $haiku);
like($page, qr/^30 $base\/alex\/page\/Haiku\r$/, "Titan Haiku");
$page = query_gemini("$base/alex/page/Haiku");
like($page, qr/^20 text\/gemini; charset=UTF-8\r\n# Haiku\n$haiku/, "Haiku saved");
$page = query_gemini("$base/page/Haiku");
like($page, qr/^This page does not yet exist/m, "Haiku page is empty in the main space");
ok(-f "$dir/alex/page/Haiku.gmi", "alex/page/Haiku.gmi exists");
ok(-f "$dir/alex/changes.log", "alex/changes.log exists");
ok(-f "$dir/alex/index", "alex/index exists");
$page = query_gemini("$base/alex/do/match?Haiku");
like($page, qr/^=> $base\/alex\/page\/Haiku Haiku/m, "Haiku found by name match");
$stream->on(read => sub {
my ($stream, $bytes) = @_;
diag "Reading " . length($bytes) . " bytes\n" if $ENV{TEST_VERBOSE};
if ($header and $encoding) {
$buffer .= decode($encoding, $bytes);
} elsif ($header) {
$buffer .= $bytes;
} else {
($header) = $bytes =~ /^(.*?)\r\n/;
$header = decode_utf8 $header;
if ($header =~ /^2\d* (?:text\/\S+)?(?:; *charset=(\S+))?$/g) {
# empty, or text without charset defaults to UTF-8
$encoding = $1 || 'UTF-8';
}
$bytes =~ s/^(.*?)\r\n//;
if ($encoding) {
$buffer .= decode($encoding, $bytes);
} else {
$buffer .= $bytes;
}
}});
# Write request
return "$header\r\n$buffer";
}
sub query_web {
my $query = shift;
my $cert = shift // 1; # suppress use of client certificate in the test
$query .= "\r\n" unless $query =~ /^POST/; # add empty line for GET requests
my $response = query_gemini($query, undef, $cert);
# fixup encoding for two trivial cases of encoding html
my $header_end = index($response, "\r\n\r\n");
if (substr($response, 0, $header_end + 2) =~ /content-type: text\/[a-z]+; charset=(\S+)/i
or substr($response, $header_end + 4) =~ /<meta charset=\"(\S+)\">/i) {
my $encoding = $1;
$response = substr($response, 0, $header_end + 4)
. decode($encoding, substr($response, $header_end + 4));
}
return $response;
}
my $total = 0;
my $ok = 0;
( run in 1.076 second using v1.01-cache-2.11-cpan-fd5d4e115d8 )