Group
Extension

Perl6-Pugs/ext/libwww-perl/t/getprint.t

use v6-alpha;
use Test;

my $tempfile = "temp-pugs-download";

# Change the URLs to something better/different
my @urls = <
    %s/
>;

plan 2+@urls;

use LWP::Simple; pass "(dummy instead of broken use_ok)";

my $expected = "Hello from Pugs";

# Spawn a local proxy server
sub spawn_server (Int $port) {
  my $port = $port || 8086;

  diag "Spawning proxy on port $port";
  my $sock = listen($port);

  my $url = "http://localhost:$port";
  ok(defined($sock), "Listening on $url");

  async {
    #diag "Spawned server";

    while (1) {
      my $hdl = $sock.accept;

      my $request = =$hdl;
      $request ~~ s:P5/\s+$//;
      #diag $request;
      if ($request ~~ rx:P5"^GET /stop-server/") {
        last();
      };

      while (readline($hdl) ~~ rx:P5/\S/) { 1 };
      $hdl.print( "HTTP/1.0 200 OK\r\n"
                ~ "Content-Type: text/plain; charset=UTF-8\r\n"
                ~ "Server: Fake local Pugs HTTPd\r\n"
                ~ "X-Original-Request: $request\r\n"
                ~ "\r\n"
                ~ $expected );
      $hdl.flush();
      $hdl.close;
    };

  };

  $url;
};

my $base_url = spawn_server( 8086 );

diag "Running under $?OS";

my ($pugs,$redir) = ("../../pugs", ">");

if $?OS eq any <MSWin32 mingw cygwin> {
  $pugs = '..\\..\\pugs.exe';
  if -e 'pugs.exe' { $pugs = 'pugs.exe' }
}
else {
  if -e './pugs' { $pugs = './pugs' }
};

sub run_pugs ($c) {
  my $tempfile = "temp-ex-output";
  my $command = "$pugs $c $redir $tempfile";
  diag $command;
  system $command;
  my $res = slurp $tempfile;
  unlink $tempfile;
  return $res;
}

# Now talk back to ourselves via a child process:
# (which doesn't work, as Haskell suspends all (userspace-)
#  threads while running an external command)

for @urls -> $t_url {
  my $url = $t_url;
  $url ~~ s:perl5/%s/$base_url/;
  my $inc = map {qq! "-I$_"!}, @*INC;

  # Will block forever
  # my $output = run_pugs(qq! $inc -MLWP::Simple -e "getprint('$url')" !);
  my $output = run_pugs(qq! -e "print 'Skipping until we get async really working'" !);
  is($output, $expected, "getprint() works", :todo);
};

get("$base_url/stop");


Powered by Groonga
Maintained by Kenichi Ishigaki <ishigaki@cpan.org>. If you find anything, submit it on GitHub.