view release on metacpan or  search on metacpan

t/oddmuse-gopher.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 Encode;
use Encode::Locale;
use Test::More;
use URI::Escape;
use utf8; # tests contain UTF-8 characters and it matters

my $msg;
if (not $ENV{TEST_AUTHOR}) {
  $msg = 'Contributions are 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";

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;