view release on metacpan or  search on metacpan

lib/App/Phoebe/Spartan.pm  view on Meta::CPAN

sub serve_spartan {
  my ($stream, $host, $path, $length, $buffer) = @_;
  eval {
    local $SIG{'ALRM'} = sub {
      $log->error("Timeout processing $host $path $length via Spartan");
    };
    alarm(10); # timeout
    my $spaces = space_regex();
    # note that path always starts with a slash!
    $log->info("Looking at $host $path $length via Spartan");
    my ($space, $id, $n);
    no warnings 'redefine';
    # we cannot import these subroutines and modify them, otherwise the
    # App::Phoebe code remains unchanged
    local *gemini_to_url = \&App::Phoebe::to_url;
    local *App::Phoebe::to_url = \&spartan_to_url;
    local *old_gemini_link = \&App::Phoebe::gemini_link;
    local *App::Phoebe::gemini_link = \&spartan_link;
    local *App::Phoebe::success = \&success;
    local *App::Phoebe::result = \&result;
    if (run_extensions($stream, $host, undef, $buffer, $path, $length)) {
      # config file goes first (note that $path and $length come at the end)
    } elsif (($space) = $path =~ m!^(?:/($spaces))?(?:/page)?/?$!) {
      # "up" from page/Alex gives us page or page/ → show main menu
      spartan_main_menu($stream, $host, space($stream, $host, $space));
    } elsif ($path eq "/do/source") {
      seek DATA, 0, 0;
      local $/ = undef; # slurp
      $stream->write(encode_utf8 <DATA>);
    } elsif ($length == 0 and ($space, $id, $n) = $path =~ m!^(?:/($spaces))?/page/([^/]+)(?:/(\d+))?$!) {
      $log->debug("Serving $id bytes via Spartan");
      serve_page($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif ($length > 0 and ($space, $id, $n) = $path =~ m!^(?:/($spaces))?/page/([^/]+)$!) {
      $log->debug("Saving $length bytes via Spartan");
      save_page($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)),
		"text/plain", $buffer, $length);
    } elsif (($space, $id) = $path =~ m!^(?:/($spaces))?/raw/([^/]+)$!) {
      serve_raw($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)));
    } elsif (($space, $id) = $path =~ m!^(?:/($spaces))?/html/([^/]+)$!) {
      serve_html($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)));
    } elsif (($space, $id) = $path =~ m!^(?:/($spaces))?/history/([^/]+)$!) {
      serve_history($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), 10);
    } elsif (($space, $id, $n) = $path =~ m!^(?:/($spaces))?/diff/([^/]+)(?:/(\d+))?$!) {
      serve_diff($stream, $host, space($stream, $host, $space), decode_utf8(uri_unescape($id)), $n);
    } elsif (($space) = $path =~ m!^(?:/($spaces))?/do/index$!) {
      serve_index($stream, $host, space($stream, $host, $space));
    } else {
      $log->info("No handler for $host $path $length via spartan");
      result($stream, "5", "I do not know what to do with $host $path $length");
    }
    $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");
}

sub spartan_to_url {
  my ($stream, $host, $space, $id, $scheme) = @_;
  $scheme ||= "spartan";
  return gemini_to_url($stream, $host, $space, $id, $scheme);
}

sub spartan_link {
  my ($stream, $host, $space, $title, $id, $revision) = @_;
  return "" if $id and $id =~ m!^(?:do/blog|history)!;
  return old_gemini_link($stream, $host, $space, $title, $id, $revision);
}

sub spartan_main_menu {
  my $stream = shift;
  my $host = shift||"";
  my $space = shift||"";
  $log->info("Serving main menu");
  success($stream);
  my $page = $server->{wiki_main_page};
  if ($page) {
    $stream->write(encode_utf8 text($stream, $host, $space, $page) . "\n");
  } else {
    $stream->write("# Welcome to Phoebe!\n");
    $stream->write("\n");
  }
  blog($stream, $host, $space, 10);
  for my $id (@{$server->{wiki_page}}) {
    print_link($stream, $host, $space, $id);
  }
  for my $line (@main_menu) {
    $stream->write(encode_utf8 $line . "\n");
  }
  $stream->write("\n");
  print_link($stream, $host, $space, "Index of all pages", "do/index");
  # a requirement of the GNU Affero General Public License
  print_link($stream, $host, undef, "Source code", "do/source");
  $stream->write("\n");
}

1;