| Subject: | [PATCH] Support for Perl 5.004 |
I can already hear you shout in a mix of horror and anger "Why are
you still using a version of Perl that should be only talked about
in archeology class?"
And I agree, Perl should be upgraded, but there are cases where you
just can't do that. And I wanted to use HTTP::Server::Simple. So I
patched it and as I expected it was quite short and easy. Hence this
ticket, mostly for the records in case someone else wants to use the
module on an older Perl.
With this patch, HTTP::Server::Simple 0.20 passes all tests on
Perl 5.004_05.
Regards,
--
Close the world, txEn eht nepO.
| Subject: | HTTP-Server-Simple-0.20-perl5.004.diff |
diff -ru HTTP-Server-Simple-0.20-orig/lib/HTTP/Server/Simple/CGI/Environment.pm HTTP-Server-Simple-0.20-perl5.004/lib/HTTP/Server/Simple/CGI/Environment.pm
--- HTTP-Server-Simple-0.20-orig/lib/HTTP/Server/Simple/CGI/Environment.pm 2006-06-07 21:26:29.000000000 +0200
+++ HTTP-Server-Simple-0.20-perl5.004/lib/HTTP/Server/Simple/CGI/Environment.pm 2006-09-26 15:18:17.853103679 +0200
@@ -2,10 +2,11 @@
package HTTP::Server::Simple::CGI::Environment;
use strict;
-use warnings;
+#use warnings;
use HTTP::Server::Simple;
-our $VERSION = $HTTP::Server::Simple::VERSION;
+use vars qw($VERSION %ENV_MAPPING);
+$VERSION = $HTTP::Server::Simple::VERSION;
my %clean_env = %ENV;
@@ -56,7 +57,7 @@
=cut
-our %ENV_MAPPING = (
+%ENV_MAPPING = (
protocol => "SERVER_PROTOCOL",
localport => "SERVER_PORT",
localname => "SERVER_NAME",
@@ -69,7 +70,7 @@
);
sub setup_environment_from_metadata {
- no warnings 'uninitialized';
+ #no warnings 'uninitialized';
my $self = shift;
# XXX TODO: rather than clone functionality from the base class,
diff -ru HTTP-Server-Simple-0.20-orig/lib/HTTP/Server/Simple/CGI.pm HTTP-Server-Simple-0.20-perl5.004/lib/HTTP/Server/Simple/CGI.pm
--- HTTP-Server-Simple-0.20-orig/lib/HTTP/Server/Simple/CGI.pm 2006-06-07 21:26:29.000000000 +0200
+++ HTTP-Server-Simple-0.20-perl5.004/lib/HTTP/Server/Simple/CGI.pm 2006-09-26 14:38:00.091744446 +0200
@@ -3,11 +3,12 @@
use base qw(HTTP::Server::Simple HTTP::Server::Simple::CGI::Environment);
use strict;
-use warnings;
+#use warnings;
use CGI ();
-our $VERSION = $HTTP::Server::Simple::VERSION;
+use vars qw($VERSION $default_doc);
+$VERSION = $HTTP::Server::Simple::VERSION;
=head1 NAME
@@ -69,7 +70,6 @@
=cut
-our $default_doc;
$default_doc = ( join "", <DATA> );
sub handle_request {
diff -ru HTTP-Server-Simple-0.20-orig/lib/HTTP/Server/Simple.pm HTTP-Server-Simple-0.20-perl5.004/lib/HTTP/Server/Simple.pm
--- HTTP-Server-Simple-0.20-orig/lib/HTTP/Server/Simple.pm 2006-06-15 16:05:14.000000000 +0200
+++ HTTP-Server-Simple-0.20-perl5.004/lib/HTTP/Server/Simple.pm 2006-09-26 15:09:51.738877196 +0200
@@ -1,15 +1,16 @@
package HTTP::Server::Simple;
-use 5.006;
use strict;
-use warnings;
+use FileHandle;
use Socket;
use Carp;
-our $VERSION = '0.20';
+use vars qw($VERSION $bad_request_doc);
+$VERSION = '0.20';
+
=head1 NAME
-HTTP::Server::Simple
+HTTP::Server::Simple - Lightweight HTTP server
=head1 SYNOPSIS
@@ -253,7 +254,7 @@
local $SIG{PIPE} = 'IGNORE'; # If we don't ignore SIGPIPE, a
# client closing the connection before we
# finish sending will cause the server to exit
- while ( accept( my $remote, HTTPDaemon ) ) {
+ while ( accept( my $remote = new FileHandle, HTTPDaemon ) ) {
$self->stdio_handle($remote);
$self->lookup_localhost() unless ($self->host);
$self->accept_hook if $self->can("accept_hook");
@@ -604,7 +605,7 @@
=cut
-our $bad_request_doc = join "", <DATA>;
+$bad_request_doc = join "", <DATA>;
sub bad_request {
my $self = shift;
diff -ru HTTP-Server-Simple-0.20-orig/t/01live.t HTTP-Server-Simple-0.20-perl5.004/t/01live.t
--- HTTP-Server-Simple-0.20-orig/t/01live.t 2006-06-07 21:26:29.000000000 +0200
+++ HTTP-Server-Simple-0.20-perl5.004/t/01live.t 2006-09-26 14:49:57.293865190 +0200
@@ -19,12 +19,12 @@
my $pid=$s->background();
- like($pid, qr/^-?\d+$/,'pid is numeric');
+ like($pid, '/^-?\d+$/', 'pid is numeric');
select(undef,undef,undef,0.2); # wait a sec
my $content=fetch("GET / HTTP/1.1", "");
- like($content, qr/Congratulations/, "Returns a page");
+ like($content, '/Congratulations/', "Returns a page");
is(kill(9,$pid),1,'Signaled 1 process successfully');
wait or die "couldn't wait for sub-process completion";
}
@@ -35,22 +35,22 @@
my $pid=$s->background();
diag("started server on $pid");
select(undef,undef,undef,0.2); # wait a sec
- like($pid, qr/^-?\d+$/,'pid is numeric');
+ like($pid, '/^-?\d+$/', 'pid is numeric');
my $content=fetch("GET / HTTP/1.1", "");
- like($content,qr/Congratulations/,"Returns a page");
+ like($content, '/Congratulations/', "Returns a page");
eval {
like(fetch("GET your mum wet"), # anything does!
- qr/bad request/i,
+ '/bad request/i',
"knows what a request isn't");
};
fail("got exception in client: $@") if $@;
- like(fetch("GET / HTTP/1.1", ""), qr/Congratulations/,
+ like(fetch("GET / HTTP/1.1", ""), '/Congratulations/',
"HTTP/1.1 request");
- like(fetch("GET /"), qr/Congratulations/,
+ like(fetch("GET /"), '/Congratulations/',
"HTTP/0.9 request");
is(kill(9,$pid),1,'Signaled 1 process successfully');
diff -ru HTTP-Server-Simple-0.20-orig/t/03podcoverage.t HTTP-Server-Simple-0.20-perl5.004/t/03podcoverage.t
--- HTTP-Server-Simple-0.20-orig/t/03podcoverage.t 2006-06-07 21:26:29.000000000 +0200
+++ HTTP-Server-Simple-0.20-perl5.004/t/03podcoverage.t 2006-09-26 14:38:44.570557947 +0200
@@ -5,5 +5,5 @@
eval "use Test::Pod::Coverage 1.04";
plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
-all_pod_coverage_ok({ also_private => [ qr/^[A-Z_]+$/ ], });
+all_pod_coverage_ok({ also_private => [ '/^[A-Z_]+$/' ], });
diff -ru HTTP-Server-Simple-0.20-orig/t/04cgi.t HTTP-Server-Simple-0.20-perl5.004/t/04cgi.t
--- HTTP-Server-Simple-0.20-orig/t/04cgi.t 2006-06-07 21:26:29.000000000 +0200
+++ HTTP-Server-Simple-0.20-perl5.004/t/04cgi.t 2006-09-26 15:24:24.409878637 +0200
@@ -5,7 +5,7 @@
use constant PORT => 13432;
my $host = gethostbyaddr(inet_aton('localhost'), AF_INET);
-our %methods=(
+my %methods=(
url => "url: http://$host:".PORT,
path_info => 'path_info: /cgitest/path_info',
server_name => "server_name: $host",
@@ -14,7 +14,7 @@
request_method => 'request_method: GET',
);
-our %envvars=(
+my %envvars=(
SERVER_URL => "SERVER_URL: http://$host:".PORT.'/',
SERVER_PORT => 'SERVER_PORT: '.PORT,
REQUEST_METHOD => 'REQUEST_METHOD: GET',
@@ -34,15 +34,15 @@
my $pid=$server->background;
- like($pid,qr/^-?\d+$/,'pid is numeric');
+ like($pid, '/^-?\d+$/', 'pid is numeric');
select(undef,undef,undef,0.2); # wait a sec
- like(fetch("GET / HTTP/1.1",""),qr(NOFILE),'no file');
+ like(fetch("GET / HTTP/1.1",""), '/NOFILE/', 'no file');
foreach my $method (keys(%methods)) {
like(
fetch("GET /cgitest/$method HTTP/1.1",""),
- qr($methods{$method}),
+ "/$methods{$method}/",
"method - $method"
);
select(undef,undef,undef,0.2); # wait a sec
@@ -51,7 +51,7 @@
foreach my $envvar (keys(%envvars)) {
like(
fetch("GET /cgitest/$envvar HTTP/1.1",""),
- qr($envvars{$envvar}),
+ "/$envvars{$envvar}/",
"Environment - $envvar"
);
select(undef,undef,undef,0.2); # wait a sec
@@ -149,7 +149,7 @@
print "Content-Type: text/html\r\nContent-Length: ";
my $response;
if($methods{$file}) {
- $response="$file: ".$cgi->$file;
+ $response = "$file: ".$cgi->$file();
} elsif($envvars{$file}) {
$response="$file: $ENV{$file}";
} else {