view release on metacpan or  search on metacpan

t/Oddmuse.t  view on Meta::CPAN

write_text("$oddmuse_dir/config", "\$SurgeProtection = 0;\n");

my $oddmuse_pid = fork();

END {
  # kill server
  if ($oddmuse_pid) {
    kill 'KILL', $oddmuse_pid or warn "Could not kill server $oddmuse_pid";
  }
}

if (!defined $oddmuse_pid) {
  die "Cannot fork Oddmuse: $!";
} elsif ($oddmuse_pid == 0) {
  say "This is the Oddmuse server listening on port $oddmuse_port...";
  $ENV{WikiDataDir} = $oddmuse_dir;
  no warnings "once";
  $OddMuse::RunCGI = 0;
  @ARGV = ("daemon", "-m", "production", "-l", "http://*:$oddmuse_port");
  # oddmuse-wiki.pl is a copy of Oddmuse's wiki.pl
  # oddmuse-server.pl is similar to Oddmuse's server.pl
  for my $file (qw(./t/oddmuse-wiki.pl ./t/oddmuse-server.pl)) {
    unless (my $return = do $file) {
      warn "couldn't parse $file: $@" if $@;
      warn "couldn't do $file: $!"    unless defined $return;
      warn "couldn't run $file"       unless $return;
    }
  }
  say "Oddmuse server done";
  exit;
}

my $ua = Mojo::UserAgent->new;
my $res;
my $total = 0;
my $ok = 0;

# What I'm seeing is that $@ is the empty string and $! is "Connection refused"
# even though I thought $@ would be set. Oh well.
say "This is the client waiting for the Oddmuse server to start on port $oddmuse_port...";
for (qw(1 1 1 1 2 2 3 4 5)) {
  if (not $total or not $res) {
    diag "$!: waiting ${_}s..." if $total > 0;
    $total += $_;
    sleep $_;
    $res = $ua->get("http://localhost:$oddmuse_port/wiki")->result;
  } else {
    $ok = 1;
    last;
  }
}

die "$!: giving up after ${total}s\n" unless $ok;

# Test Oddmuse, and create the Test page in the main namespace (with the text
# "Alex"), in the "Travels" namespace (with the text "Berta"), and in a Mëtal
# namespace (with the text "Chloë"), and the page "Link" that links to it.
$res = $ua->get("http://localhost:$oddmuse_port/wiki?title=Test&text=Fnord")->result;
is($res->code, 302, "Oddmuse save page");
$res = $ua->get("http://localhost:$oddmuse_port/wiki?title=Test&text=Alex")->result;
is($res->code, 302, "Oddmuse updated page");
$res = $ua->get("http://localhost:$oddmuse_port/wiki?title=Link&text=[M%C3%ABtal:Test Mëtal Link]")->result;
is($res->code, 302, "Oddmuse updated page");
$res = $ua->get("http://localhost:$oddmuse_port/wiki?title=Test&text=Check%20out%20[[Bet]].&ns=Travels")->result;
is($res->code, 302, "Oddmuse save page in namespace");
$res = $ua->get("http://localhost:$oddmuse_port/wiki?title=Test&text=Bert&ns=Travels")->result;
is($res->code, 302, "Oddmuse save page in namespace");
$res = $ua->get("http://localhost:$oddmuse_port/wiki?title=Test&text=Berta&ns=Travels")->result;
is($res->code, 302, "Oddmuse updated page in namespace");
$res = $ua->get("http://localhost:$oddmuse_port/wiki?title=Test&text=Chlo%C3%AB&ns=M%C3%ABtal")->result;
is($res->code, 302, "Oddmuse updated page in namespace with umlauts");
$res = $ua->get("http://localhost:$oddmuse_port/wiki/raw/Test")->result;
is($res->code, 200, "Oddmuse read page");
is($res->body, "Alex\n", "Oddmuse page content");
$res = $ua->get("http://localhost:$oddmuse_port/wiki/Travels/raw/Test")->result;
is($res->code, 200, "Oddmuse read page from namespace");
is($res->body, "Berta\n", "Oddmuse page content from namespace");
$res = $ua->get("http://localhost:$oddmuse_port/wiki/M%C3%ABtal/raw/Test")->result;
is($res->code, 200, "Oddmuse read page from umlaut namespace");
is($res->body, encode_utf8("Chloë\n"), "Oddmuse umlaut page content from umlaut namespace");

# Start Phoebe

our @use = qw(Oddmuse);
our @config = (<<"EOT");
package App::Phoebe::Oddmuse;
our \%oddmuse_wikis = ("localhost" => "http://localhost:$oddmuse_port/wiki");
our \%oddmuse_wiki_names = ("localhost" => "Test");
our \%oddmuse_wiki_dirs = ("localhost" => "$oddmuse_dir");
our \$server->{wiki_main_page} = "Welcome";
EOT
our $host = qw(localhost);
our $port;
our $base;
our $dir;

require './t/test.pl';

# Test Phoebe

like(query_gemini("$base/page"), qr(^31 $base/\r\n), "Reserved word");
like(query_gemini("$base/Travels/page"), qr(31 $base/Travels\r\n), "Reserved word (namespace)");

my $page = query_gemini("$base/page/Test");
like($page, qr(Alex), "Page");
like($page, qr(^=> $base/raw/Test Raw text$)m, "Raw link");
like($page, qr(^=> $base/html/Test HTML$)m, "HTML link");
like(query_gemini("$base/raw/Test"), qr(^Alex$)m, "Raw");
like(query_gemini("$base/html/Test"), qr(<p>Alex</p>), "HTML");

$page = query_gemini("$base/do/index");
like($page, qr(All Pages), "Index");
like($page, qr(^=> $base/page/Test Test$)m, "Page link");

$page = query_gemini("$base/do/changes");
like($page, qr(Changes), "Changes");
like($page, qr(^=> $base/page/Test Test \(current\)$)m, "Page link to current revision");
like($page, qr(^=> $base/history/Test History$)m, "History link");
like($page, qr(^=> $base/page/Test/1 Test \(1\)$)m, "Page link to revision 1");
like($page, qr(^=> $base/diff/Test/1 Differences$)m, "Diff link");

$page = query_gemini("$base/history/Test");
like($page, qr(^=> $base/page/Test Test \(current\)$)m, "Page link to current revision");
like($page, qr(^=> $base/page/Test/1 Test \(1\)$)m, "Page link to revision 1");
like($page, qr(^=> $base/diff/Test/1 Differences$)m, "Diff link");

$page = query_gemini("$base/diff/Test/1");
like($page, qr(^# Differences for Test$)m, "Diff");
like($page, qr(^Showing the differences between revision 1 and the current revision\.$)m, "Intro");
like($page, qr(^Changed line 1 from:\n> ï½¢Fnordï½£$)m, "From");
like($page, qr(^to:\n> ï½¢Alexï½£$)m, "To");