view release on metacpan or  search on metacpan

t/Oddmuse.t  view on Meta::CPAN

# Copyright (C) 2017–2021  Alex Schroeder <alex@gnu.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use Modern::Perl;
use Test::More;
use Mojo::IOLoop;
use Mojo::UserAgent;
use URI::Escape;
use Encode qw(encode_utf8);
use Encode::Locale;
use File::Slurper qw(write_text);
use Test::More;
use utf8; # tests contain UTF-8 characters and it matters

my $msg;
if (not $ENV{TEST_AUTHOR}) {
  $msg = 'This is an author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
} else {
  for my $module (qw(CGI Mojolicious::Plugin::CGI DateTime::Format::ISO8601)) {
    if (not defined eval "require $module") {
      $msg = "You need to install the $module module for this test: $@";
      last;
    }
  }
}
plan skip_all => $msg if $msg;

# Start the Oddmuse server

my $oddmuse_port = Mojo::IOLoop::Server->generate_port;
my $oddmuse_dir = "./" . sprintf("test-%04d", int(rand(10000)));
mkdir $oddmuse_dir; # required so that the server can write the error log
mkdir "$oddmuse_dir/modules";
link "./t/oddmuse-namespaces.pl", "$oddmuse_dir/modules/namespaces.pl";
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