view release on metacpan or  search on metacpan

t/test.pl  view on Meta::CPAN

  }
}

if (!defined $pid) {
  die "Cannot fork: $!";
} elsif ($pid == 0) {
  say "This is the Phoebe server listening on port $port...";
  use Config;
  my $secure_perl_path = $Config{perlpath};
  my @args = ("blib/script/phoebe",
	      # The test files containing hostnames are UTF-8 encoded, thus
	      # $host and @host are unicode strings. Command line parsing
	      # expects them encoded in the current locale, however.
	      (map { "--host=" . encode(locale => $_) } @hosts),
	      "--port=$port",
	      "--log_level=warn", # set to debug if you are bug hunting?
	      "--cert_file=t/cert.pem",
	      "--key_file=t/key.pem",
	      "--wiki_dir=$dir",
	      "--wiki_mime_type=image/jpeg",
	      (map { "--wiki_page=" . encode(locale => $_) } @pages),
	      (map { "--wiki_space=" . encode(locale => $_) } @spaces));
  exec($secure_perl_path, @args) or die "Cannot exec: $!";
}

sub query_gemini {
  my $query = shift;
  my $text = shift;
  my $cert = shift // 1; # suppress use of client certificate in the test
  my ($header, $mimetype, $encoding, $buffer);

  # create client
  Mojo::IOLoop->client(
    {
      address => "localhost",
      port => $port,
      tls => 1,
      tls_cert => ($cert ? "t/cert.pem" : undef),
      tls_key => ($cert ? "t/key.pem" : undef),
      tls_options => { SSL_verify_mode => 0x00 },
    } => sub {
      my ($loop, $err, $stream) = @_;
      die "Client creation failed: $err\n" if $err;
      $stream->timeout(2);
      $stream->on(error => sub {
	my ($stream, $err) = @_;
	die "Stream error: $err\n" if $err });
      $stream->on(close => sub {
	my ($stream) = @_;
	diag "Closing stream\n" if $ENV{TEST_VERBOSE} });
      $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
      $stream->write($query);
      $stream->write("\r\n") unless $query =~ /^POST/; # GET and Gemini requests end in \r\n
      $stream->write($text) if $text });
  # Start event loop if necessary
  Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

  # When we're done
  return "" unless $header;
  return "$header\r\n$buffer";
}

sub query_web {
  my $query = shift;
  $query .= "\r\n" unless $query =~ /^POST/; # add empty line for GET requests
  return query_gemini($query);
}

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 Phoebe client waiting for the server to start on port $port...";
for (qw(1 1 1 1 1)) {
  if (not $total or $!) {
    $total += $_;
    sleep $_;
    eval { query_gemini("gemini://$host:$port/") };
  } else {
    $ok = 1;
    last;
  }
}

plan skip_all => "Giving up after ${total}s\n" unless $ok;

# We cannot test $example up above; we must run this test once we established
# that the plan is not to skil all. If we don't wait, we'll get the following
# error: "Parse errors: Bad plan. You planned 0 tests but ran 1."
like($example, qr/^# tested by $0\n/, "Example found") if $ok and $example;

1;