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;