[Rt-commit] r2053 - in HTTP-Server-Simple: . lib/HTTP/Server t
jesse at bestpractical.com
jesse at bestpractical.com
Thu Jan 6 18:55:23 EST 2005
Author: jesse
Date: Thu Jan 6 18:55:23 2005
New Revision: 2053
Added:
HTTP-Server-Simple/t/01live.t
HTTP-Server-Simple/t/02pod.t
HTTP-Server-Simple/t/03podcoverage.t
Modified:
HTTP-Server-Simple/ (props changed)
HTTP-Server-Simple/MANIFEST
HTTP-Server-Simple/SIGNATURE
HTTP-Server-Simple/lib/HTTP/Server/Simple.pm
HTTP-Server-Simple/t/00smoke.t
Log:
r2583 at hualien: jesse | 2005-01-06T23:51:04.173528Z
This be 0.02
Modified: HTTP-Server-Simple/MANIFEST
==============================================================================
--- HTTP-Server-Simple/MANIFEST (original)
+++ HTTP-Server-Simple/MANIFEST Thu Jan 6 18:55:23 2005
@@ -10,8 +10,10 @@
lib/HTTP/Server/Simple.pm
Makefile.PL
MANIFEST This list of files
-SIGNATURE
META.yml
-perltidy.ERR
README
+SIGNATURE
t/00smoke.t
+t/01live.t
+t/02pod.t
+t/03podcoverage.t
Modified: HTTP-Server-Simple/SIGNATURE
==============================================================================
--- HTTP-Server-Simple/SIGNATURE (original)
+++ HTTP-Server-Simple/SIGNATURE Thu Jan 6 18:55:23 2005
@@ -14,26 +14,28 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 3f2b41f04ab4bcf4bf66ae0b7807a9ec227b9650 MANIFEST
-SHA1 f5f9e9464e5ebd54b5d91e3a3debba18f2994d52 META.yml
+SHA1 d04d371c5a4a9639ddfbf6b16ee7984d78c76f6b MANIFEST
+SHA1 7e3a84651b5d78ff8eb12603714749023eb017a6 META.yml
SHA1 490f3fd115e09cb05b725580e5ed5cdd58241049 Makefile.PL
SHA1 ed0c107672daac3bc9e266876666e1059dbe44b7 README
SHA1 61dac0d5f7c81522d856b2d8608538ba34fb1247 ex/sample_server
-SHA1 0de53a33616127f8680e6e4118741e80f354cd3e inc/Module/Install.pm
-SHA1 11d43fa1484b63eb90b0a3a1b62dcb7e71060084 inc/Module/Install/Base.pm
-SHA1 d3122b9f825c49da1184636699531ac0a7844da0 inc/Module/Install/Can.pm
-SHA1 9f146b26e914b78d7f07559d1810bca6d96c2bc7 inc/Module/Install/Fetch.pm
-SHA1 836dc65ebcb2913f5a7da77ddba4b6d46bd98f99 inc/Module/Install/Makefile.pm
-SHA1 2d0fae3f1ecf71666075b39911cb4694b1310edd inc/Module/Install/Metadata.pm
-SHA1 71c0f2e04d98c302c22d92b03ab8852f768b6431 inc/Module/Install/Win32.pm
-SHA1 ea6fe523768b5c7d8a50528fbc18885bb0901d88 inc/Module/Install/WriteAll.pm
-SHA1 7d0456d8888bb90c38c3bbd8d91e12071e65753c lib/HTTP/Server/Simple.pm
-SHA1 bae9d5536239ed37b06ebb2b32ae8602e57c7c14 perltidy.ERR
-SHA1 d1122c872f0f38b04ceebd655257261ef4db692f t/00smoke.t
+SHA1 05d89e1fe6d49cd518b5a3e6694cc313e655fb02 inc/Module/Install.pm
+SHA1 2e300b145ee61eea9dfd71624b17b0bc9218aa4f inc/Module/Install/Base.pm
+SHA1 29ce36027266c1839b496bf660396e0a91ab53cf inc/Module/Install/Can.pm
+SHA1 c0f347c388074beb42aad080661c7e3552110c71 inc/Module/Install/Fetch.pm
+SHA1 e094fe96aef06c68d7a424818c12e52b11f1ccdd inc/Module/Install/Makefile.pm
+SHA1 e448c6dc5351ef425e3f8bdbeb642409120bc3ca inc/Module/Install/Metadata.pm
+SHA1 134de6ff2f762873b6a1af950dd53f8e0a801d73 inc/Module/Install/Win32.pm
+SHA1 1ec06df292af7f652d33db6129e9e4c7cc8b5095 inc/Module/Install/WriteAll.pm
+SHA1 528c71d9e304d9b678b021010fd86bd41fcc6fe9 lib/HTTP/Server/Simple.pm
+SHA1 db064af54cab345a71daec576e32e64b8fb1033d t/00smoke.t
+SHA1 035da25add4957dc42a88de31a5af2ebf85c56d3 t/01live.t
+SHA1 aca95653cfce68912e08c57b3a4566207e2f99b3 t/02pod.t
+SHA1 90f0be3e6b0fab021155953742f5cc5c5e47a5aa t/03podcoverage.t
-----BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.2.4 (Darwin)
+Version: GnuPG v1.2.5 (GNU/Linux)
-iD8DBQFBg/F7Ei9d9xCOQEYRAt8sAJ9m+32vUDPFL+ES26DVLOh4/4L3rQCgx6GW
-V15HZ9WfgjxrbYauPz6bpTM=
-=gKXl
+iD8DBQFB3c7cEi9d9xCOQEYRArKwAKC5XqDRQYnPnEch4tv/3oo4jtLy+wCgvKL+
+LmpuOFGenlgk5Jw7qvmVA8U=
+=dywW
-----END PGP SIGNATURE-----
Modified: HTTP-Server-Simple/lib/HTTP/Server/Simple.pm
==============================================================================
--- HTTP-Server-Simple/lib/HTTP/Server/Simple.pm (original)
+++ HTTP-Server-Simple/lib/HTTP/Server/Simple.pm Thu Jan 6 18:55:23 2005
@@ -1,12 +1,13 @@
package HTTP::Server::Simple;
-
+use 5.006;
use strict;
use warnings;
use Socket;
-use CGI;
+use CGI ();
-our $VERSION = '0.00_01';
+my %clean_env=%ENV;
+our $VERSION = '0.02';
=head1 NAME
@@ -43,11 +44,11 @@
sub new {
- my $proto = shift;
+ my ($proto,$port) = @_;
my $class = ref($proto) || $proto;
my $self = {};
bless( $self, $class );
- $self->port('8080');
+ $self->port( $port || '8080');
return $self;
}
@@ -66,6 +67,24 @@
}
+=head2 background
+
+Run the server in the background. returns pid.
+
+
+=cut
+
+sub background {
+ my $self=shift;
+ my $child =fork ;
+ die "Can't fork: $!" unless defined($child);
+ return $child if $child;
+ use POSIX;
+ POSIX::setsid()
+ or die "Can't start a new session: $!";
+ $self->run();
+}
+
=head2 run
Run the server. If all goes well, this won't ever return, but it will start listening for http requests
@@ -119,7 +138,6 @@
request_uri => $request_uri
);
- print "HTTP/1.0 200 OK\n"; # probably OK by now
my $cgi = CGI->new();
@@ -141,10 +159,12 @@
sub handle_request {
- my $self = shift;
- my $cgi = shift;
+ my ( $self, $cgi ) = @_;
+ print "HTTP/1.0 200 OK\n"; # probably OK by now
print <<EOF;
+ Content-Type: text/html
+ Content-Lenght: 31337
<html><head><title>Hello!</title></head>
<h1>Congratulations!</h1>
@@ -201,12 +221,8 @@
@_
);
- foreach my $var qw(USER_AGENT CONTENT_LENGTH CONTENT_TYPE
- COOKIE SERVER_PORT SERVER_PROTOCOL SERVER_NAME
- PATH_INFO REQUEST_URI REQUEST_METHOD REMOTE_ADDR
- REMOTE_HOST QUERY_STRING SERVER_SOFTWARE) {
- delete $ENV{$var};
- } while (<STDIN>) {
+ %ENV=%clean_env;
+ while (<STDIN>) {
s/[\r\l\n\s]+$//;
if (/^([\w\-]+): (.+)/i) {
my $tag = uc($1);
@@ -214,17 +230,17 @@
my $val = $2;
$tag =~ s/-/_/g;
$tag = "HTTP_" . $tag
- unless ( grep /^$tag$/, qw(CONTENT_LENGTH CONTENT_TYPE COOKIE) );
+ unless ( grep /^$tag$/, qw(CONTENT_LENGTH CONTENT_TYPE) );
if ( $ENV{$tag} ) {
$ENV{$tag} .= "; $val";
- }
- else {
+ } else {
$ENV{$tag} = $val;
}
}
last if (/^$/);
}
+ no warnings 'uninitialized';
$ENV{SERVER_PROTOCOL} = $args{protocol};
$ENV{SERVER_PORT} = $args{port};
$ENV{SERVER_NAME} = $args{'localname'};
@@ -260,10 +276,12 @@
=head1 AUTHOR
-Copyright (c) 2001-2004 Jesse Vincent, jesse at bestpractical.com.
-
+Copyright (c) 2004-2005 Jesse Vincent, jesse at bestpractical.com.
All rights reserved.
+Marcu Ramberg contributed tests, cleanup, etc
+
+
=head1 BUGS
Modified: HTTP-Server-Simple/t/00smoke.t
==============================================================================
--- HTTP-Server-Simple/t/00smoke.t (original)
+++ HTTP-Server-Simple/t/00smoke.t Thu Jan 6 18:55:23 2005
@@ -1,3 +1,11 @@
-use Test::More qw/no_plan/;
+use Test::More tests=>8;
use_ok(HTTP::Server::Simple);
+ok(HTTP::Server::Simple->can('new'), 'can new()');
+my $s= HTTP::Server::Simple->new();
+isa_ok($s,'HTTP::Server::Simple');
+is($s->port(),8080,'Defaults to 8080');
+is($s->port(13432),13432,'Can change port');
+is($s->port(),13432,'Change persists');
+ok($s->can('print_banner'), 'can print_banner()');
+ok($s->can('run'), 'can run()');
Added: HTTP-Server-Simple/t/01live.t
==============================================================================
--- (empty file)
+++ HTTP-Server-Simple/t/01live.t Thu Jan 6 18:55:23 2005
@@ -0,0 +1,18 @@
+use Test::More;
+BEGIN {
+ if (eval { require LWP::Simple }) {
+ plan tests => 4;
+ } else {
+ Test::More->import(skip_all =>"LWP::Simple not installed: $@");
+ }
+}
+
+use HTTP::Server::Simple;
+my $s=HTTP::Server::Simple->new(13432);
+is($s->port(),13432,"Constructor set port correctly");
+my $pid=$s->background();
+like($pid, qr/^\d+$/,'pid is numeric');
+my $content=LWP::Simple::get("http://localhost:13432");
+like($content,qr/Congratulations/,"Returns a page");
+is(kill(9,$pid),1,'Signaled 1 process successfully');
+
Added: HTTP-Server-Simple/t/02pod.t
==============================================================================
--- (empty file)
+++ HTTP-Server-Simple/t/02pod.t Thu Jan 6 18:55:23 2005
@@ -0,0 +1,9 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
+
Added: HTTP-Server-Simple/t/03podcoverage.t
==============================================================================
--- (empty file)
+++ HTTP-Server-Simple/t/03podcoverage.t Thu Jan 6 18:55:23 2005
@@ -0,0 +1,9 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+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_]+$/ ], });
+
More information about the Rt-commit
mailing list