r10980 - in /trunk/libpoe-component-server-http-perl/debian: ./ changelog compat control copyright docs patches/ patches/00_removing-tests.patch rules watch
ghostbar-guest at users.alioth.debian.org
ghostbar-guest at users.alioth.debian.org
Fri Dec 7 03:36:21 UTC 2007
Author: ghostbar-guest
Date: Fri Dec 7 03:36:21 2007
New Revision: 10980
URL: http://svn.debian.org/wsvn/?sc=1&rev=10980
Log:
[svn-inject] Applying Debian modifications to trunk
Added:
trunk/libpoe-component-server-http-perl/debian/
trunk/libpoe-component-server-http-perl/debian/changelog
trunk/libpoe-component-server-http-perl/debian/compat
trunk/libpoe-component-server-http-perl/debian/control
trunk/libpoe-component-server-http-perl/debian/copyright
trunk/libpoe-component-server-http-perl/debian/docs
trunk/libpoe-component-server-http-perl/debian/patches/
trunk/libpoe-component-server-http-perl/debian/patches/00_removing-tests.patch
trunk/libpoe-component-server-http-perl/debian/rules (with props)
trunk/libpoe-component-server-http-perl/debian/watch
Added: trunk/libpoe-component-server-http-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libpoe-component-server-http-perl/debian/changelog?rev=10980&op=file
==============================================================================
--- trunk/libpoe-component-server-http-perl/debian/changelog (added)
+++ trunk/libpoe-component-server-http-perl/debian/changelog Fri Dec 7 03:36:21 2007
@@ -1,0 +1,6 @@
+libpoe-component-server-http-perl (0.09-1) unstable; urgency=low
+
+ * Initial release (Closes: #434012)
+
+ -- Jose Luis Rivas <ghostbar38 at gmail.com> Sat, 21 Apr 2007 23:47:43 -0400
+
Added: trunk/libpoe-component-server-http-perl/debian/compat
URL: http://svn.debian.org/wsvn/trunk/libpoe-component-server-http-perl/debian/compat?rev=10980&op=file
==============================================================================
--- trunk/libpoe-component-server-http-perl/debian/compat (added)
+++ trunk/libpoe-component-server-http-perl/debian/compat Fri Dec 7 03:36:21 2007
@@ -1,0 +1,1 @@
+5
Added: trunk/libpoe-component-server-http-perl/debian/control
URL: http://svn.debian.org/wsvn/trunk/libpoe-component-server-http-perl/debian/control?rev=10980&op=file
==============================================================================
--- trunk/libpoe-component-server-http-perl/debian/control (added)
+++ trunk/libpoe-component-server-http-perl/debian/control Fri Dec 7 03:36:21 2007
@@ -1,0 +1,21 @@
+Source: libpoe-component-server-http-perl
+Section: perl
+Priority: extra
+Maintainer: Jose Luis Rivas <ghostbar38 at gmail.com>
+Build-Depends: cdbs, debhelper (>= 5), libpoe-perl, libwww-perl
+Standards-Version: 3.7.2
+
+Package: libpoe-component-server-http-perl
+Architecture: all
+Depends: ${perl:Depends}, ${misc:Depends}
+Description: Foundation of a POE HTTP Daemon
+ Is a framework for building custom HTTP servers based on POE. It is
+ loosely modeled on the ideas of apache and the mod_perl/Apache module.
+ .
+ It is built a lot on work done by Gisle Aas on HTTP::* modules and the
+ URI module which are subclassed.
+ .
+ PoCo::HTTPD lets you register different handler, stacked by directory
+ that will be run during the cause of the request.
+ .
+ Homepage: http://search.cpan.org/dist/POE-Component-Server-HTTP
Added: trunk/libpoe-component-server-http-perl/debian/copyright
URL: http://svn.debian.org/wsvn/trunk/libpoe-component-server-http-perl/debian/copyright?rev=10980&op=file
==============================================================================
--- trunk/libpoe-component-server-http-perl/debian/copyright (added)
+++ trunk/libpoe-component-server-http-perl/debian/copyright Fri Dec 7 03:36:21 2007
@@ -1,0 +1,32 @@
+This package was debianized by Jose Luis Rivas <ghostbar38 at gmail.com> on
+Sat, 21 Apr 2007 23:47:43 -0400.
+
+It was downloaded from http://search.cpan.org/dist/POE-Component-Server-HTTP
+
+Upstream Author:
+
+ Arthur Bergman <arthur at contiller.se>
+ Additional hacking by Philip Gwyn <poe at pied.nu>
+
+Copyright:
+
+ Copyright (C) 2002 Arthur Bergman
+ Copyright (C) 2005 Philip Gwyn
+
+License:
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of either:
+
+ a) the GNU General Public License as published by the Free Software
+ Foundation; either version 1, or (at your option) any later
+ version, or
+
+ b) the "Artistic License" which comes with Perl.
+
+On Debian GNU/Linux systems, the complete text of the GNU General
+Public License can be found in `/usr/share/common-licenses/GPL' and
+the Artistic Licence in `/usr/share/common-licenses/Artistic'.
+
+The Debian packaging is (C) 2007, Jose Luis Rivas <ghostbar38 at gmail.com> and
+is licensed under the GPL, see `/usr/share/common-licenses/GPL'.
Added: trunk/libpoe-component-server-http-perl/debian/docs
URL: http://svn.debian.org/wsvn/trunk/libpoe-component-server-http-perl/debian/docs?rev=10980&op=file
==============================================================================
--- trunk/libpoe-component-server-http-perl/debian/docs (added)
+++ trunk/libpoe-component-server-http-perl/debian/docs Fri Dec 7 03:36:21 2007
@@ -1,0 +1,1 @@
+README
Added: trunk/libpoe-component-server-http-perl/debian/patches/00_removing-tests.patch
URL: http://svn.debian.org/wsvn/trunk/libpoe-component-server-http-perl/debian/patches/00_removing-tests.patch?rev=10980&op=file
==============================================================================
--- trunk/libpoe-component-server-http-perl/debian/patches/00_removing-tests.patch (added)
+++ trunk/libpoe-component-server-http-perl/debian/patches/00_removing-tests.patch Fri Dec 7 03:36:21 2007
@@ -1,0 +1,833 @@
+diff -ruN libpoe-component-server-http-perl-0.09/t/10_run.t POE-Component-Server-HTTP-0.09/t/10_run.t
+--- libpoe-component-server-http-perl-0.09/t/10_run.t 2006-05-23 00:00:00.000000000 -0400
++++ POE-Component-Server-HTTP-0.09/t/10_run.t 1969-12-31 20:00:00.000000000 -0400
+@@ -1,128 +0,0 @@
+-#!/usr/bin/perl -w
+-
+-use strict;
+-use Test::More tests => 6 * 2;
+-
+-use LWP::UserAgent;
+-use LWP::ConnCache;
+-use HTTP::Request;
+-use POE::Kernel;
+-use POE::Component::Server::HTTP;
+-use YAML;
+-
+-my $PORT = 2080;
+-
+-my $pid = fork;
+-die "Unable to fork: $!" unless defined $pid;
+-
+-END {
+- if ($pid) {
+- kill 2, $pid or warn "Unable to kill $pid: $!";
+- }
+-}
+-
+-####################################################################
+-if ($pid) { # we are parent
+- # stop kernel from griping
+- ${$poe_kernel->[POE::Kernel::KR_RUN]} |=
+- POE::Kernel::KR_RUN_CALLED;
+-
+- print STDERR "$$: Sleep 2...";
+- sleep 2;
+- print STDERR "continue\n";
+-
+- my $UA = LWP::UserAgent->new;
+- again:
+- my $req=HTTP::Request->new(GET => "http://localhost:$PORT/");
+- my $resp=$UA->request($req);
+-
+- ok($resp->is_success, "got index") or die "resp=", Dump $resp;
+- my $content=$resp->content;
+- ok($content =~ /this is top/, "got top index");
+-
+- $req=HTTP::Request->new(GET => "http://localhost:$PORT/honk/something.html");
+- $resp=$UA->request($req);
+-
+- ok($resp->is_success, "got something");
+- $content=$resp->content;
+- ok($content =~ /this is honk/, "something honked");
+-
+- $req=HTTP::Request->new(GET => "http://localhost:$PORT/bonk/zip.html");
+- $resp=$UA->request($req);
+-
+- ok(($resp->is_success and $resp->content_type eq 'text/html'),
+- "get text/html");
+- $content=$resp->content;
+- ok($content =~ /my friend/, 'my friend');
+-
+- unless ($UA->conn_cache) {
+- diag( "Enabling Keep-Alive and going again" );
+- $UA->conn_cache( LWP::ConnCache->new() );
+- goto again;
+- }
+-}
+-
+-####################################################################
+-else { # we are the child
+- my $aliases = POE::Component::Server::HTTP->new(
+- Port => $PORT,
+- Address=>'localhost',
+- MapOrder=>'bottom-first',
+- ContentHandler => { '/' => \&top,
+- '/honk/' => \&honk,
+- '/bonk/' => \&bonk,
+- '/bonk/zip.html' => \&bonk2,
+-# '/shutdown.html' => \&shutdown
+- },
+-# ErrorHandler => { '/' => \&error },
+- Headers => { Server => 'TestServer' },
+- );
+- $poe_kernel->run;
+-}
+-
+-
+-#######################################
+-sub top
+-{
+- my ($request, $response) = @_;
+- $response->code(RC_OK);
+- $response->content_type('text/plain');
+- $response->content("this is top");
+- return RC_OK;
+-}
+-
+-#######################################
+-sub honk
+-{
+- my ($request, $response) = @_;
+- $response->code(RC_OK);
+- $response->content_type('text/plain');
+- $response->content("this is honk");
+- return RC_OK;
+-}
+-
+-#######################################
+-sub bonk
+-{
+- my ($request, $response) = @_;
+- $response->code(RC_OK);
+- $response->content_type('text/plain');
+- $response->content("this is bonk");
+- return RC_OK;
+-}
+-
+-#######################################
+-sub bonk2
+-{
+- my ($request, $response) = @_;
+- $response->code(RC_OK);
+- $response->content_type('text/html');
+- $response->content(<<' HTML');
+-<html>
+-<head><title>YEAH!</title></head>
+-<body><p>This, my friend, is the page you've been looking for.</p></body>
+-</html>
+- HTML
+- return RC_OK;
+-}
+-
+diff -ruN libpoe-component-server-http-perl-0.09/t/20_stream.t POE-Component-Server-HTTP-0.09/t/20_stream.t
+--- libpoe-component-server-http-perl-0.09/t/20_stream.t 2006-05-23 00:00:00.000000000 -0400
++++ POE-Component-Server-HTTP-0.09/t/20_stream.t 1969-12-31 20:00:00.000000000 -0400
+@@ -1,450 +0,0 @@
+-#!/usr/bin/perl -w
+-
+-use strict;
+-use Test::More tests => 13;
+-
+-use LWP::UserAgent;
+-use HTTP::Request;
+-use POE::Kernel;
+-use POE::Component::Server::HTTP;
+-use YAML;
+-
+-my $PORT = 2081;
+-
+-my $pid = fork;
+-die "Unable to fork: $!" unless defined $pid;
+-
+-END {
+- if ($pid) {
+- kill 2, $pid or warn "Unable to kill $pid: $!";
+- }
+-}
+-
+-$|++;
+-
+-####################################################################
+-if ($pid) { # we are parent
+-
+- # stop kernel from griping
+- ${$poe_kernel->[POE::Kernel::KR_RUN]} |=
+- POE::Kernel::KR_RUN_CALLED;
+-
+- print STDERR "$$: Sleep 2...";
+- sleep 2;
+- print STDERR "continue\n";
+-
+- if(@ARGV) {
+- print STDERR "Please connect to http://localhost:$PORT/ with your browser and make sure everything works\n";
+- local @ARGV=();
+- {} while <>;
+- }
+-
+- my $UA = LWP::UserAgent->new;
+-
+- ##################################### welcome
+- my $req=HTTP::Request->new(GET => "http://localhost:$PORT/");
+- my $resp=$UA->request($req);
+-
+- ok(($resp->is_success and $resp->content_type eq 'text/html'),
+- "got index") or die "resp=", Dump $resp;
+- my $content = $resp->content;
+- ok(($content =~ /multipart.txt/), "proper index")
+- or die "resp=", Dump $content;
+-
+- ##################################### last.txt
+- $req=HTTP::Request->new(GET => "http://localhost:$PORT/last.txt");
+- $resp=$UA->request($req);
+-
+- ok(($resp->is_success and $resp->content_type eq 'text/plain'),
+- "got last.txt") or die "resp=", Dump $resp;
+- $content = $resp->content;
+- ok(($content =~ /everything worked/), "everything worked")
+- or die "resp=", Dump $content;
+-
+- ##################################### multipart.txt
+- $req=HTTP::Request->new(GET => "http://localhost:$PORT/multipart.txt");
+- $resp=$UA->request($req);
+-
+- ok(($resp->is_success and $resp->content_type =~ m(^multipart/mixed)),
+- "got multipart.txt") or die "resp=", Dump $resp;
+- $content = $resp->content;
+- ok(($content =~ /everything worked/), "everything worked")
+- or die "resp=", Dump $content;
+-
+-
+- ##################################### last.gif
+- my $last = File::Basename::dirname($0).'/last.gif';
+- open LAST, $last or die "Unable to open $last: $!";
+- {
+- local $/;
+- $last = <LAST>;
+- }
+- close LAST;
+-
+- ##################################### last.gif
+- $req=HTTP::Request->new(GET => "http://localhost:$PORT/last.gif");
+- $resp=$UA->request($req);
+-
+- ok(($resp->is_success and $resp->content_type eq 'image/gif'),
+- "got last.gif") or die "resp=", Dump $resp;
+- $content = $resp->content;
+- ok(($content eq $last), "everything worked");
+-
+- ##################################### multipart.gif
+- $req=HTTP::Request->new(GET => "http://localhost:$PORT/multipart.gif");
+- $resp=$UA->request($req);
+-
+- ok(($resp->is_success and $resp->content_type =~ m(^multipart/mixed)),
+- "got multipart.txt") or die "resp=", Dump $resp;
+- $content = $resp->content;
+- $last = quotemeta $last;
+- ok(($content =~ /$last/), "everything worked");
+-
+- ##################################### multipart.mixed
+- $req=HTTP::Request->new(GET => "http://localhost:$PORT/multipart.mixed");
+- $resp=$UA->request($req);
+-
+- ok(($resp->is_success and $resp->content_type =~ m(^multipart/mixed)),
+- "got multipart.mixed") or die "resp=", Dump $resp;
+- $content = $resp->content;
+- ok(($content =~ /Please wait/), "first part worked");
+- ok(($content =~ /$last/), "last part worked");
+-}
+-####################################################################
+-else { # we are the child
+-
+- Worker->spawn(port => $PORT);
+- $poe_kernel->run();
+-}
+-
+-###########################################################
+-package Worker;
+-
+-use HTTP::Status;
+-use POE::Kernel;
+-use POE::Component::Server::HTTP;
+-use POE;
+-use File::Basename;
+-
+-sub DEBUG () { 0 }
+-
+-sub spawn
+-{
+- my($package, %parms)=@_;
+- my $self = bless { dir => dirname($0),
+- delay => 2,
+- stream_todo => []}, $package;
+-
+- POE::Component::Server::HTTP->new(
+- Port => $parms{port},
+- ContentHandler => {
+- '/' => sub { $self->welcome(@_) },
+- '/favicon.ico' => sub { $self->favicon(@_) },
+- '/multipart.gif' => sub { $self->multipart(@_) },
+- '/multipart.mixed' => sub { $self->multipart_mixed(@_) },
+- '/last.gif' => sub { $self->last(@_) },
+- '/multipart.txt' => sub { $self->multipart_txt(@_) },
+- '/last.txt' => sub { $self->last_txt(@_) },
+- },
+- StreamHandler => sub { $self->stream_start(@_) }
+- );
+-
+- POE::Session->create(
+- inline_states => {
+- _start => sub { $self->_start() },
+- _stop => sub { DEBUG and warn "_stop\n" },
+- wait_start => sub { $self->wait_start(@_[ARG0..$#_])},
+- wait_done => sub { $self->wait_done(@_[ARG0..$#_])}
+- }
+- );
+-
+- DEBUG and warn "Listening on port $parms{port}\n";
+-}
+-
+-#######################################
+-# POE event
+-sub _start
+-{
+- my($self)=@_;
+- $self->{session} = $poe_kernel->get_active_session->ID;
+-
+- $poe_kernel->alias_set(ref $self);
+- return;
+-}
+-
+-#######################################
+-# Called as ContentHandler
+-sub welcome
+-{
+- my($self, $request, $response)=@_;
+-
+- DEBUG and warn "Welcome\n";
+-
+- $response->code(RC_OK);
+- $response->content_type('text/html; charset=iso-8859-1');
+-
+- $response->content(<<HTML);
+-<html>
+-<head>
+-<title>Hello world</title>
+-</head>
+-<body>
+-<h1>Hello world from POE::Component::Server::HTTP</h1>
+-
+-<ul>
+- <li><a href="/last.txt">Text</a></li>
+- <li><a href="/multipart.txt">Multipart text</a></li>
+- <li><a href="/last.gif">Image</a></li>
+- <li><a href="/multipart.gif">Multipart image</a></li>
+- <li><a href="/multipart.mixed">Text, then image</a></li>
+-</ul>
+-
+-
+-</body>
+-</html>
+-HTML
+- return RC_OK;
+-}
+-
+-#######################################
+-# Called as ContentHandler
+-sub favicon
+-{
+- my($self, $request, $response)=@_;
+-
+- DEBUG and warn "favicon\n";
+-
+- $response->code(RC_NOT_FOUND);
+- $response->content_type('text/html; charset=iso-8859-1');
+-
+- $response->content(<<HTML);
+-<html>
+-<head>
+-<title>Go away</title>
+-</head>
+-<body>
+-<h1>Go away</h1>
+-</body>
+-</html>
+-HTML
+- return RC_NOT_FOUND;
+-}
+-
+-
+-#######################################
+-# Called as ContentHandler
+-sub multipart
+-{
+- my($self, $request, $response)=@_;
+-
+- DEBUG and warn "multipart\n";
+-
+- # Send an HTTP header and turn streaming on
+- $self->multipart_start($request, $response);
+- # After the HTTP header is sent, our StreamHandler will be called
+- # Save the values that stream_start needs to do its work
+- push @{$self->{stream_todo}}, [$request, $response,
+- 'first.gif', 'last.gif'];
+-
+- return RC_OK;
+-}
+-
+-#######################################
+-# Called as ContentHandler
+-sub multipart_mixed
+-{
+- my($self, $request, $response)=@_;
+-
+- DEBUG and warn "multipart\n";
+-
+- $self->multipart_start($request, $response);
+- push @{$self->{stream_todo}}, [$request, $response,
+- 'first.txt', 'last.gif'];
+-
+- return RC_OK;
+-}
+-
+-#######################################
+-# Called as ContentHandler
+-sub last
+-{
+- my($self, $request, $response)=@_;
+-
+- DEBUG and warn "last\n";
+- $response->code(RC_OK);
+- $response->content_type('image/gif');
+- $response->content($self->data('last.gif'));
+- return RC_OK;
+-}
+-
+-#######################################
+-# Called as ContentHandler
+-sub multipart_txt
+-{
+- my($self, $request, $response)=@_;
+-
+- DEBUG and warn "multipart_txt\n";
+-
+- $self->multipart_start($request, $response);
+- push @{$self->{stream_todo}}, [$request, $response,
+- 'first.txt', 'last.txt'];
+-
+- return RC_OK;
+-}
+-
+-#######################################
+-# Called as ContentHandler
+-sub last_txt
+-{
+- my($self, $request, $response)=@_;
+-
+- DEBUG and warn "last_txt\n";
+- $response->code(RC_OK);
+- $response->content_type('text/plain');
+- $response->content($self->data('last.txt'));
+- return RC_OK;
+-}
+-
+-#######################################
+-# Called as StreamHandler
+-sub stream_start
+-{
+- my($self, $request, $response)=@_;
+-
+- DEBUG and warn "stream_start\n";
+-
+- foreach my $todo (@{$self->{stream_todo}}) {
+- my($request, $response, $first, $last)=@$todo;
+-
+- DEBUG and warn("post to wait_start for $first, $last\n");
+- $self->multipart_send($response, $first);
+-
+- # get into our POE session
+- $poe_kernel->post($self->{session} => 'wait_start',
+- $request, $response, $last);
+- }
+-
+-
+-
+- $self->{stream_todo}=[];
+- return;
+-}
+-
+-
+-#######################################
+-# POE event
+-sub wait_start
+-{
+- my($self, $request, $response, $next)=@_;
+- DEBUG and warn "Going to wait for $self->{delay} seconds\n";
+- $poe_kernel->delay_set(wait_done => $self->{delay}, $request, $response, $next);
+- return;
+-}
+-
+-#######################################
+-# POE event
+-sub wait_done
+-{
+- my($self, $request, $response, $next)=@_;
+- DEBUG and warn "Waiting done, sending $next\n";
+-
+- $self->multipart_send($response, $next);
+- $self->multipart_end($request, $response);
+-
+- return;
+-}
+-
+-#######################################
+-# Healper
+-sub data
+-{
+- my($self, $name)=@_;
+- my $file = "$self->{dir}/$name";
+- open FILE, $file or die "Can't open $file: $!";
+- {
+- local $/;
+- $file = <FILE>;
+- }
+- close FILE;
+- return $file;
+-}
+-
+-
+-####################################################################
+-
+-#######################################
+-# This function sends a file over the connection
+-# We create a new HTTP response, with content and content_length
+-# Because HTTP response->as_string sends HTTP status line, we hide it
+-# behind a X-HTTP-Status header, just after the boundary.
+-# This means that this part of the response looks like:
+-#
+-# --BoundaryString
+-# X-HTTP-Status: HTTP/1.0 200 (OK)
+-# Content-Type: text/plain
+-# Content-Length: 13
+-#
+-# Content here
+-#
+-# Setting Content-Length is important for images
+-sub multipart_send
+-{
+- my($self, $response, $file)=@_;
+-
+- DEBUG and warn "multipart_send $file\n";
+-
+- my $ct = 'image/gif';
+- $ct = 'text/plain' if $file =~ /txt$/;
+-
+- my $resp = $self->multipart_response($ct);
+-
+- my $data=$self->data($file);
+- $resp->content($data);
+- $resp->content_length(length($data));
+-
+- $response->send("--$self->{boundary}\cM\cJX-HTTP-Status: ");
+- $response->send($resp->as_string);
+- return;
+-}
+-
+-#######################################
+-# Create a HTTP::Response object to be sent as a part of the response
+-sub multipart_response
+-{
+- my($self, $ct, $resp)=@_;
+- $resp ||= HTTP::Response->new;
+- $resp->content_type($ct||'text/plain');
+- $resp->code(200);
+- return $resp;
+-}
+-
+-#######################################
+-# Send an HTTP header that sets up multipart/mixed response
+-# Also turns on streaming.
+-#
+-# PoCo::Server::HTTP will send the $response object, then run PostHandler
+-# then switch to Streaming mode.
+-sub multipart_start
+-{
+- my($self, $request, $response)=@_;
+-
+- $response->code(RC_OK);
+- $self->{boundary} ||= 'ThisRandomString';
+- $response->content_type("multipart/mixed;boundary=$self->{boundary}");
+-
+- $response->streaming(1);
+-}
+-
+-#######################################
+-# The request is done. Turn off streaming and end the multipart response
+-# Setting the header Connection to 'close' forces PoCo::Server::HTTP to
+-# close the socket. This is needed so that the browsers stop "twirling".
+-sub multipart_end
+-{
+- my($self, $request, $response)=@_;
+- DEBUG and warn "Closing connection\n";
+- $response->close;
+- $request->header(Connection => 'close');
+- $response->send("--$self->{boundary}--\cM\cJ");
+-}
+-
+diff -ruN libpoe-component-server-http-perl-0.09/t/30_error.t POE-Component-Server-HTTP-0.09/t/30_error.t
+--- libpoe-component-server-http-perl-0.09/t/30_error.t 2006-05-23 00:00:00.000000000 -0400
++++ POE-Component-Server-HTTP-0.09/t/30_error.t 1969-12-31 20:00:00.000000000 -0400
+@@ -1,243 +0,0 @@
+-#!/usr/bin/perl -w
+-
+-use strict;
+-use Test::More;
+-
+-#sub POE::Kernel::TRACE_EVENTS {1}
+-sub POE::Kernel::ASSERT_EVENTS {1}
+-
+-use LWP::UserAgent;
+-use HTTP::Request;
+-use POE::Kernel;
+-use POE::Component::Server::HTTP;
+-use IO::Socket::INET;
+-use POE::API::Peek;
+-
+-sub DEBUG { 0 };
+-my $PORT=2080;
+-
+-my $pid=fork;
+-die "Unable to fork: $!" unless defined $pid;
+-
+-END {
+- if($pid) {
+- kill 2, $pid or ($!==3) or warn "Unable to kill $pid: $!";
+- }
+-}
+-
+-####################################################################
+-unless ($pid) { # we are child
+- Test::Builder->new->no_ending(1);
+- # stop kernel from griping
+- ${$poe_kernel->[POE::Kernel::KR_RUN]} |=
+- POE::Kernel::KR_RUN_CALLED;
+-
+- print STDERR "$$: Sleep 2...";
+- sleep 2;
+- print STDERR "continue\n";
+-
+-
+- ############################
+- # 1, 2, 3
+- my $sock=IO::Socket::INET->new(PeerAddr=>'localhost',
+- PeerPort=>$PORT);
+- $sock or die "Unable to connect to localhost:$PORT: $!";
+- $sock->close; # taunt other end
+-
+- ############################
+- # 4, 5, 6
+- $sock=IO::Socket::INET->new(PeerAddr=>'localhost',
+- PeerPort=>$PORT);
+- $sock or die "Unable to connect to localhost:$PORT: $!";
+-
+- my $req=HTTP::Request->new(GET => "http://localhost:$PORT/");
+- $sock->print(join ' ', $req->method, $req->uri->as_string, "0\n");
+- sleep 1;
+- $sock->close; # taunt other end
+-
+- ############################
+- # 7, 8, 9
+- $sock=IO::Socket::INET->new(PeerAddr=>'localhost',
+- PeerPort=>$PORT);
+- $sock or die "Unable to connect to localhost:$PORT: $!";
+- $req=HTTP::Request->new(GET => "http://localhost:$PORT/honk");
+- $sock->print($req->as_string);
+- $sock->close; # taunt other end
+-
+- ############################
+- # 10, 11
+- $req=HTTP::Request->new(GET => "http://localhost:$PORT/honk/shutdown.html");
+- my $UA = LWP::UserAgent->new;
+- my $resp=$UA->request($req);
+-
+- exit 0;
+-}
+-
+-####################################################################
+-# we are the parent
+-
+-plan tests=>11;
+-
+-my $Q=1;
+-my $shutdown=0;
+-my $top=0;
+-my $bonk=0;
+-
+-my $aliases = POE::Component::Server::HTTP->new(
+- Port => $PORT,
+- Address=>'localhost',
+- ContentHandler => { '/' => \&top,
+- '/honk/shutdown.html' => \&shutdown,
+- '/bonk/' => \&bonk
+- },
+- PostHandler => {
+- '/' => \&post_top,
+- '/honk/shutdown.html' => \&post_shutdown,
+- },
+- ErrorHandler => { '/' => \&error },
+- Headers => { Server => 'TestServer' },
+- );
+-
+-POE::Session->create(
+- inline_states => {
+- _start => sub {
+- $poe_kernel->alias_set('HONK');
+- $poe_kernel->sig(USR1=>'usr1');
+- $poe_kernel->sig(USR2=>'usr2');
+- },
+- usr1=>sub {__peek(0)},
+- usr2=>sub {__peek(1)},
+- });
+-
+-
+-$poe_kernel->run;
+-
+-
+-#######################################
+-sub error
+-{
+- my ($request, $response) = @_;
+-
+- DEBUG and __peek(1);
+-
+- die "Why is Q=$Q" unless $Q;
+-
+- ok(($request->is_error and $response->is_error), "this is an error");
+- my $op=$request->header('Operation');
+- my $errstr=$request->header('Error');
+- my $errnum=$request->header('Errnum');
+-
+- DEBUG and
+- warn "$$: ERROR op=$op errnum=$errnum errstr=$errstr\n";
+-
+- if($Q <= 3) {
+- ok(($op eq 'read' and $errnum == 0), "closed connection") or
+- die "Why did i get this error? op=$op errnum=$errnum errstr=$errstr";
+- }
+- else {
+- die "Whoah!";
+- }
+-
+- $Q++;
+- return RC_OK;
+-}
+-
+-#######################################
+-sub top
+-{
+- my ($request, $response) = @_;
+- $response->code(RC_OK);
+- $response->content_type('text/plain');
+- $response->content("this is top");
+- $top=1;
+- return RC_OK;
+-}
+-
+-#######################################
+-sub bonk
+-{
+- my ($request, $response) = @_;
+- $response->code(RC_OK);
+- $response->content_type('text/plain');
+- $response->content("this is bonk");
+- $bonk=1;
+- return RC_OK;
+-}
+-
+-
+-
+-#######################################
+-sub post_top
+-{
+- my($request, $response)=@_;
+- ok(($shutdown or (not $bonk and $request->is_error)),
+- "all but shutdown requests should be errors");
+-}
+-
+-#######################################
+-sub post_shutdown
+-{
+- my($request, $response)=@_;
+- ok($shutdown, "we are after shutdown");
+-}
+-
+-#######################################
+-sub shutdown
+-{
+- my ($request, $response) = @_;
+- DEBUG and warn "SHUTDOWN";
+- $poe_kernel->post($aliases->{httpd} => 'shutdown');
+- $poe_kernel->post($aliases->{tcp} => 'shutdown');
+-
+- $shutdown=1;
+-
+- $response->code(RC_OK);
+- $response->content_type('text/plain');
+- $response->content("going to shutdown");
+- return RC_OK;
+-}
+-
+-sub __peek
+-{
+- my($verbose)=@_;
+- my $api=POE::API::Peek->new();
+- my @queue = $api->event_queue_dump();
+-
+- my $ret = "Event Queue:\n";
+-
+- foreach my $item (@queue) {
+- $ret .= "\t* ID: ". $item->{ID}." - Index: ".$item->{index}."\n";
+- $ret .= "\t\tPriority: ".$item->{priority}."\n";
+- $ret .= "\t\tEvent: ".$item->{event}."\n";
+-
+- if($verbose) {
+- $ret .= "\t\tSource: ".
+- $api->session_id_loggable($item->{source}).
+- "\n";
+- $ret .= "\t\tDestination: ".
+- $api->session_id_loggable($item->{destination}).
+- "\n";
+- $ret .= "\t\tType: ".$item->{type}."\n";
+- $ret .= "\n";
+- }
+- }
+- if($verbose) {
+- $ret.="Sessions: \n" if $api->session_count;
+- foreach my $session ($api->session_list) {
+- $ret.="\tSession ".$api->session_id_loggable($session)." ($session)";
+- $ret.="\n\t\tref count: ".$api->get_session_refcount($session);
+- $ret.="\n";
+- my $q=$api->get_session_extref_count($session);
+- $ret.="\t\textref count: $q\n" if $q;
+- $q=$api->session_handle_count($session);
+- $ret.="\t\thandle count: $q\n" if $q;
+- $q=join ',', $api->session_alias_list($session);
+- $ret.="\t\tAliases: $q\n" if $q;
+- }
+- }
+- $ret.="\n";
+-
+- $poe_kernel->sig_handled;
+- warn "$$: $ret";
+- return;
+-}
Added: trunk/libpoe-component-server-http-perl/debian/rules
URL: http://svn.debian.org/wsvn/trunk/libpoe-component-server-http-perl/debian/rules?rev=10980&op=file
==============================================================================
--- trunk/libpoe-component-server-http-perl/debian/rules (added)
+++ trunk/libpoe-component-server-http-perl/debian/rules Fri Dec 7 03:36:21 2007
@@ -1,0 +1,8 @@
+#!/usr/bin/make -f
+
+include /usr/share/cdbs/1/rules/debhelper.mk
+include /usr/share/cdbs/1/class/perlmodule.mk
+include /usr/share/cdbs/1/rules/simple-patchsys.mk
+
+install/libpoe-component-server-http-perl::
+ rm -rf debian/libpoe-component-server-http-perl/usr/lib
Propchange: trunk/libpoe-component-server-http-perl/debian/rules
------------------------------------------------------------------------------
svn:executable = *
Added: trunk/libpoe-component-server-http-perl/debian/watch
URL: http://svn.debian.org/wsvn/trunk/libpoe-component-server-http-perl/debian/watch?rev=10980&op=file
==============================================================================
--- trunk/libpoe-component-server-http-perl/debian/watch (added)
+++ trunk/libpoe-component-server-http-perl/debian/watch Fri Dec 7 03:36:21 2007
@@ -1,0 +1,2 @@
+version=3
+http://search.cpan.org/CPAN/authors/id/R/RC/RCLAMP/POE-Component-Server-HTTP-(.*)\.tar\.gz
More information about the Pkg-perl-cvs-commits
mailing list