view release on metacpan or  search on metacpan

lib/Test/HTTP/LocalServer.pm  view on Meta::CPAN

=head1 METHODS

=head2 C<Test::HTTP::LocalServer-E<gt>spawn %ARGS>

  my $server = Test::HTTP::LocalServer->spawn;

This spawns a new HTTP server. The server will stay running until

  $server->stop

is called. Ideally, you explicitly call C<< ->stop >> or use

  undef $server

before the main program ends so that the program exit code reflects the
real exit code and not the chlid exit code.

Valid arguments are :

=over 4

=item *

C<< html => >> scalar containing the page to be served

If this is not specified, an informative default page will be used.

=item *

C<< request_pause => >> number of seconds to sleep before accepting the next
request

If your system is slow or needs to wait some time before a socket connection
is ready again, use this parameter to make the server wait a bit before
handling the next connection.

=item *

C<< file => >> filename containing the page to be served

=item *

C<<  debug => 1 >> to make the spawned server output debug information

=item *

C<<  eval => >> string that will get evaluated per request in the server

Try to avoid characters that are special to the shell, especially quotes.
A good idea for a slow server would be

  eval => sleep+10

=back

All served HTML will have the first %s replaced by the current location.

The following entries will be removed from C<%ENV> when making a request:

    HTTP_PROXY
    http_proxy
    HTTP_PROXY_ALL
    http_proxy_all
    HTTPS_PROXY
    https_proxy
    CGI_HTTP_PROXY
    ALL_PROXY
    all_proxy

=cut

sub get {
    my( $url ) = @_;
    local *ENV;
    delete @ENV{qw(
      HTTP_PROXY http_proxy CGI_HTTP_PROXY
      HTTPS_PROXY https_proxy HTTP_PROXY_ALL http_proxy_all
      ALL_PROXY
      all_proxy
    )};
    my $response = HTTP::Tiny->new->get($url);
    $response->{content}
}

sub spawn_child_win32 { my ( $self, @cmd ) = @_;
    local $?;
    system(1, @cmd)
}

sub spawn_child_posix { my ( $self, @cmd ) = @_;
    require POSIX;
    POSIX->import("setsid");

    # daemonize
    defined(my $pid = fork())   || die "can't fork: $!";
    if( $pid ) {    # non-zero now means I am the parent
        return $pid;
    };
    #chdir("/")                  || die "can't chdir to /: $!";

    # We are the child, close about everything, then exec
    (setsid() != -1)            || die "Can't start a new session: $!";
    #open(STDERR, ">&STDOUT")    || die "can't dup stdout: $!";
    #open(STDIN,  "< /dev/null") || die "can't read /dev/null: $!";
    #open(STDOUT, "> /dev/null") || die "can't write to /dev/null: $!";
    exec @cmd or warn $!;
}

sub spawn_child { my ( $self, @cmd ) = @_;
    my ($pid);
    if( $^O =~ /mswin/i ) {
        $pid = $self->spawn_child_win32(@cmd)
    } else {
        $pid = $self->spawn_child_posix(@cmd)
    };

    return $pid
}

sub spawn {
  my ($class,%args) = @_;

  $args{ request_pause } ||= 0;

  my $self = { %args };
  bless $self,$class;

  local $ENV{TEST_HTTP_VERBOSE};
  $ENV{TEST_HTTP_VERBOSE}= 1
    if (delete $args{debug});

  $self->{delete} = [];
  if (my $html = delete $args{html}) {
    # write the html to a temp file
    my ($fh,$tempfile) = File::Temp::tempfile();
    binmode $fh;
    print $fh $html