The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Test::M3::ServerView::TestServer;

use strict;
use warnings;

use Carp qw(croak);
use File::Spec::Functions qw(canonpath catfile);
use MIME::Base64 qw(decode_base64);

use base qw(Test::HTTP::Server::Simple HTTP::Server::Simple::CGI);

sub new {
    my ($pkg, $authen) = @_;
    my $port = 16000 + int(rand(16000));
    my $self = $pkg->SUPER::new($port);
    $self->{tmst_authen} = $authen;
    return $self;
}

sub handle_request {
    my ($self, $cgi) = @_;

    if ($self->{tmst_authen}) {
        unless (exists $ENV{HTTP_AUTHORIZATION}) {
            print "HTTP/1.0 401 Unauthorized\r\n";
            return;
        }
        
        
        my ($auth) = $ENV{HTTP_AUTHORIZATION} =~ /^Basic (.*)$/;
        if (decode_base64($auth) ne $self->{tmst_authen}) {
            print "HTTP/1.0 401 Unauthorized\r\n";
            return;
        }
    }
    
    my $path = $ENV{PATH_INFO};
    $path = "/home" if $path eq "/";    
    $path .= ".html";
    
    unless ($path =~ m{/\w+\.html$}) {
        croak "Failed to get ${path}";
    }
    
    my $fp = canonpath(catfile("t", "data", $path));
    open(my $in, "<", $fp);
    my $content = do { local $/; <$in>; };
    close($in);
    print "HTTP/1.0 200 OK\r\n";
    print "X-EchoQuery: ", $ENV{QUERY_STRING}, "\r\n";
    print "Content-Type: text/html\r\nContent-length: ", length($content), "\r\n\r\n", $content;
    
    1;
}

1;