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

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

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

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

t/test.pl  view on Meta::CPAN

  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 0.428 second using v1.01-cache-2.11-cpan-4d50c553e7e )