App-phoebe

 view release on metacpan or  search on metacpan

README.md  view on Meta::CPAN

    perl5/bin/phoebe

This starts the server in the foreground. If it aborts, see the
["Troubleshooting"](#troubleshooting) section below. If it runs, open a second terminal and test
it:

    perl5/bin/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
    perl5/bin/titan --url=titan://localhost/raw/Welcome --token=hello test.txt

You should get a nice redirect message, with an appropriate date.

    30 gemini://localhost:1965/page/Welcome

You can check the page, now (replacing the appropriate date):

    perl5/bin/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

README.md  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

    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/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");
  $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");

script/gemini  view on Meta::CPAN

    $stream->on(read => sub {
      my ($stream, $bytes) = @_;
      if ($header and $encoding) {
	print decode($encoding, $bytes);
      } elsif ($header) {
	print $bytes;
      } else {
	($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//;
	if ($encoding) {
	  print decode($encoding, $bytes);
	} else {
	  print $bytes;
	}
      }});
    # Write request

script/phoebe  view on Meta::CPAN

    perl5/bin/phoebe

This starts the server in the foreground. If it aborts, see the
L</Troubleshooting> section below. If it runs, open a second terminal and test
it:

    perl5/bin/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
    perl5/bin/titan --url=titan://localhost/raw/Welcome --token=hello test.txt

You should get a nice redirect message, with an appropriate date.

    30 gemini://localhost:1965/page/Welcome

You can check the page, now (replacing the appropriate date):

    perl5/bin/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");

t/basics.t  view on Meta::CPAN

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");

# plain text

$page = query_gemini("$base\/raw\/Haiku");
like($page, qr/$haiku/m, "Raw text");

# upload image

my $data = read_binary("t/alex.jpg");
my $size = length($data);

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");
}

done_testing();

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')) . ' '

t/spaces.t  view on Meta::CPAN

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");

t/test.pl  view on Meta::CPAN

      $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



( run in 1.392 second using v1.01-cache-2.11-cpan-fd5d4e115d8 )