@@ -1,6 +1,412 @@
-==============================
-9999-99-99 99:99:99 +0000 HEAD
-==============================
+================================
+2014-07-12 18:24:36 -0400 v1_364
+================================
+
+ commit 7d8713c1fad195f6ad0bf9dc55855e3162cc4838
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sat Jul 12 18:24:36 2014 -0400
+
+ Version bump for release.
+
+ commit e55f062ea7019c907f6503c55f3be39caf05d74a
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sat Jul 12 14:35:28 2014 -0400
+
+ Stop loading Data::Dump. It wasn't even being used.
+
+ Address
+ http://www.cpantesters.org/cpan/report/15547962-09ee-11e4-941a-988245
+ 14c1bc
+
+ commit 95dfad133b07402744a0e9f77987b9c90d3e2177
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sat Jul 12 14:33:04 2014 -0400
+
+ Replace // with || for that CPAN smoke box running Perl 5.8.9.
+
+================================
+2014-07-12 02:41:55 -0400 v1_363
+================================
+
+ commit a4fb23c2afebe1aba411dba2d3623ea25bf64d95
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sat Jul 12 02:41:55 2014 -0400
+
+ Bump version for release.
+
+ commit d68983dbb5ef4ed6de27c7433ee31d09e4f2474c
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sat Jul 12 02:02:30 2014 -0400
+
+ Take about 1sec off a regression test.
+
+ commit d00cd369b9f12df5f2b59bf91807243a72fe189a
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sat Jul 12 01:54:27 2014 -0400
+
+ Add POE::Test::Sequence::create_generic_session().
+
+ A generic session runs all the events it receives through the test
+ sequence. It seems like something that might be common for simple
+ tests.
+
+ t/90_regression/leolo-alarm-adjust.t uses it as a proof of concept, a
+ future documentation example, and to shave about 2sec off the test.
+
+ commit 903492af7d00400a86dab68a574cc0510ec73cea
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sat Jul 12 01:30:49 2014 -0400
+
+ Shave about 3sec off a regression test.
+
+ commit ba28c4e87622035e0a80325d3a9f5026ed3cd333
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sat Jul 12 01:26:27 2014 -0400
+
+ Shave 2.5 seconds off a regression test.
+
+================================
+2014-07-11 23:16:32 -0400 v1_362
+================================
+
+ commit 66e54c7933be4b571d20eb638aaafd4502a06c43
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Fri Jul 11 23:16:32 2014 -0400
+
+ Bump version for release.
+
+ commit ec6842f343367e2b49c5d21ae93df4fab99dd91e
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Fri Jul 11 22:56:04 2014 -0400
+
+ Reduce the time for another FollowTail test from ~5sec to ~0.2sec.
+
+ commit 9e042d00f54896e735f425b90195ec00243d5552
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Fri Jul 11 22:42:28 2014 -0400
+
+ Don't fire undefined FollowTail idle events.
+
+ commit 31396d74dad0c1b552b8f468968f1a9fa976b169
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Fri Jul 11 21:12:00 2014 -0400
+
+ Abstract the regression test sequence helper into
+ POE::Test::Sequence.
+
+ commit 65cf8fc77ce18a7d803a70f6fc9dd7a91f687aec
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Fri Jul 11 19:26:35 2014 -0400
+
+ Speed up a test by adding an idle event to POE::Wheel::FollowTail.
+
+ Rather than wait for several seconds to elapse, tests can set a low
+ PollInterval and use IdleEvent handlers to tell when it's ready to
+ move on.
+
+ As a proof of concept, this commit also removes about 8 seconds from
+ a regression test using the new IdleEvent.
+
+ commit d30f5b361699c00ef539499bac35c3f5cbd5ef66
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Fri Jul 11 13:13:02 2014 -0400
+
+ Avoid uninitialized value warnings when testing in development.
+
+ commit caaa3ad01136522e3f6a470d9e05d6c373fa1a81
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Fri Jul 11 09:41:20 2014 -0400
+
+ Remove a harmless(?) debugging print() from a test.
+
+================================
+2014-07-11 09:31:29 -0400 v1_361
+================================
+
+ commit 4d439d921fd0d8b0b7d40cf423c45e3a78e23fa6
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Fri Jul 11 09:31:29 2014 -0400
+
+ Version bump for release.
+
+ commit 3ab670538cb23ef4a4f6f003a63aae9ac708fd0e
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Fri Jul 11 09:25:45 2014 -0400
+
+ Fix a test hang on Windows.
+
+================================
+2014-07-08 08:20:30 -0400 v1_360
+================================
+
+ commit b14098d84f61e3cfd24acaf77d3ed805eff20992
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Tue Jul 8 08:20:30 2014 -0400
+
+ Version bump to trigger a new release with Chris' regression fix.
+
+ commit 3f672f6fde0a70a560888c4691bb83f03ae38e6e
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Tue Jul 8 00:47:19 2014 -0400
+
+ Update POE::Test::Loops dependency.
+
+================================
+2014-07-08 08:16:28 -0400 v1_359
+================================
+
+ commit 712e3905fbfe1b55ade59366d1c798964f38e6bd
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Mon Jul 7 23:07:28 2014 -0400
+
+ Version bump.
+
+ commit 20b920f6fa6bb225cc91da0ec2c368bdca7aabd7
+ Author: Chris 'BinGOs' Williams <chris@bingosnet.co.uk>
+ Date: Tue Jul 8 12:44:48 2014 +0100
+
+ Fix regression in SocketFactory with getnameinfo()
+
+ commit adaa221878dfa42c854adc498e3734021ab88b92
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Mon Jul 7 22:47:36 2014 -0400
+
+ rt.cpan.org 91374. Clarify a warning when an optional dependency is
+ needed but absent.
+
+ commit 5e21f99ecabaab4b1dfe8ecf53488c30b2655999
+ Merge: 8c98157 f3e987d
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Mon Jul 7 20:38:14 2014 -0400
+
+ Merge remote-tracking branch 'remotes/gh/master'
+
+ commit f3e987d634d98d28f73b38d72b2f1d0dfe268cf6
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Mon Jul 7 16:25:22 2014 -0400
+
+ Windows reports local address 0 as 0.0.0.0, and then the test canot
+ connect to itself.
+
+ commit 8c98157d46d7839181456de2c283604bd20f57e5
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Thu May 22 12:39:25 2014 -0400
+
+ Fixed the doco
+
+ commit 8de5712496e49d07904ca61a16d369b25fd4cc7f
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sun May 4 16:37:24 2014 -0400
+
+ Revert "Convert POE::Resource::SIDs into a proper class."
+
+ This reverts commit 68089ffe81a2dd1e39c07288ba1723d74165523f.
+
+ commit b8bc1e1fe916e31ac663e29af614553eb0aa5956
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sun May 4 16:37:15 2014 -0400
+
+ Revert "Convert POE::Resource::Extrefs into a proper class."
+
+ This reverts commit 3ae646376bd89572e9a61ae1d10d0609d0cdc025.
+
+ commit b1e052e77580d51e9f9879044d15c4c6bc682507
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sun May 4 16:37:04 2014 -0400
+
+ Revert "Convert POE::Resource::Aliases into a proper class."
+
+ This reverts commit f8e8c694d00c3cecf50c2a4d120ee67d7024c42d.
+
+ commit 9bb7c26ad0e11d182e51bc28ed5625c620c16c08
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Thu Apr 10 13:56:32 2014 -0400
+
+ POE::Filter::HTTPD will use Email::MIME::RFC2047::Encoder to convert
+
+ UTF-8 headers into MIME entities Documentation for above Tests for
+ above Added exceptions to 02_pod_coverage.t for POE::Filter::HTTPD
+
+ commit dc5cbb25c5ed91a1f1165062664ac9e3bebbea84
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Wed Apr 9 15:21:22 2014 -0400
+
+ POE::Filter::Block->new complains about unknown params
+ POE::Filter::Grep->new complains about unknown params
+ POE::Filter::Map->new complains about unknown params Added
+ POE::Filter::Map::FIRST_UNUSED Added
+ POE::Filter::Stackable::FIRST_UNUSED
+
+ commit c149a72e0f9c3cd3fa70760056d45209d197b7ba
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Wed Apr 9 15:08:30 2014 -0400
+
+ Added POE::Filter::BlockRecord::FIRST_UNUSED
+ POE::Filter::BlockRecord->new now checks for unknown params
+
+ commit b49ccba376012704149991a7bbad17ee6f2a9567
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Wed Apr 9 14:07:04 2014 -0400
+
+ Added MaxBuffer support Created a constructor that takes named
+ parameters. Above constructor will also accept the old syntax
+ Documentation for above Test cases for above Added
+ POE::Fitler::Reference::FIRST_UNUSED
+
+ commit a9742150086d7a9bba7a0e7f9e96cb7b5588ad99
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Wed Apr 9 14:01:33 2014 -0400
+
+ Added FIRST_UNUSED
+
+ commit 489d8be032999de120dbcbb8379dabc59d90e539
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Wed Apr 9 12:52:45 2014 -0400
+
+ Added MaxBuffer to POE::Filter::HTTPD Document above Tests for above
+ POE::Filter::HTTPD->new now complain about unknown parameters Get
+ MaxContent via POE::Filter->__param_max() Added
+ POE::Filter::HTTPD::FIRST_UNUSED
+
+ commit 3110b479e14d2a5a553a298454cffaee844ae389
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Wed Apr 9 12:20:43 2014 -0400
+
+ Added DEBUG constant Used above to help me figure some crap for
+ POEx::HTTP::Server
+
+ commit 1472d98b7355f0356e293dac4282faec603b75d4
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Wed Apr 9 12:19:50 2014 -0400
+
+ Added MaxLength and MaxBuffer to POE::Filter::Line Tests for above
+ Documented above
+
+ commit 036525b5c8906193d1596d6723ffa07af252301d
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Wed Apr 9 12:11:09 2014 -0400
+
+ Added MaxBuffer and MaxLength parameters to POE::Filter::Block Added
+ POE::Filter->__param_max for above Added unit tests for MaxBuffer and
+ MaxLength Document the above Added POE::Filter::Block::FIRST_UNUSED
+ because there wasn't one
+
+ commit 0fae143ab3d3c76a54ad9dd25eef27c2eccdb950
+ Merge: ff6d5f8 f8e8c69
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Tue Apr 8 17:01:59 2014 -0400
+
+ Merge branch 'master' of ssh://git.code.sf.net/p/poe/poe
+
+ commit ff6d5f8d48860b68647224a9005438a9afd9431e
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Tue Apr 8 16:59:40 2014 -0400
+
+ POE::Filter::HTTPD Streaming mode no longer requires switching
+ filters t/90_regression/leolo-filter-httpd.t tests the above
+
+ commit f8e8c694d00c3cecf50c2a4d120ee67d7024c42d
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Tue Apr 8 12:16:30 2014 -0400
+
+ Convert POE::Resource::Aliases into a proper class.
+
+ commit 6434f8a8a97668d303e834038d0f23f801b90dd1
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Mon Apr 7 16:11:20 2014 -0400
+
+ Added POE::Filter::HTTPD->get_pending Added tests for Streaming
+ requests This time remember to commit the unit test
+
+ commit b1e6ab1ae698acd21573adf81363731c40305df5
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Mon Apr 7 16:03:19 2014 -0400
+
+ Make sure Content-Length is a number Added tests for Content-Length
+ changes
+
+ commit 2f9cb24ab7482b7357afb027f133aaa9bc36c901
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Mon Apr 7 15:37:30 2014 -0400
+
+ Added Streaming and MaxContent to POE::Filter::HTTPD
+
+ commit 3ae646376bd89572e9a61ae1d10d0609d0cdc025
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Mon Apr 7 02:12:51 2014 -0400
+
+ Convert POE::Resource::Extrefs into a proper class.
+
+ commit 68089ffe81a2dd1e39c07288ba1723d74165523f
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sun Apr 6 21:21:52 2014 -0400
+
+ Convert POE::Resource::SIDs into a proper class.
+
+ commit 32ff484caef4bbdea1b36b42b3cf59f9e86d0793
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sun Apr 6 17:32:25 2014 -0400
+
+ Add parens to method invocations. Comment some internal methods.
+
+ commit a71ac22e55e0f4577bb90f3a18cb1e7500e56cc1
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Sun Apr 6 15:47:48 2014 -0400
+
+ Crudely benchmark the machine under test.
+
+ A lot of POE's tests work around slow machines by unconditionally
+ delaying a lot. This makes the tests feel ponderous on fast systems,
+ and it thwarts Continuous Integration.
+
+ Benchmarking machines under test will help me tell how much the
+ work-around is needed. It may eventually hint to other tests how long
+ they need to wait.
+
+ commit 4a97b6befde298936bfa6bedfb5e3f0a1afae0ad
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Fri Apr 4 14:34:03 2014 -0400
+
+ Fixed previous patch for delay_adjust( $id, 0 ), which means the
+ delay happens now.
+
+ commit 5d656bae46101c2fa74775960bbe084b9a597379
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Fri Apr 4 14:13:11 2014 -0400
+
+ Fixed POE::Kernel->delay_adjust() Added
+ POE::Resource::Events->_data_ev_set() for above Tweaked
+ POE::Resource::Events->_data_ev_adjust() in case it is called with
+ $time
+
+ commit b3f89d3386fc685440a4193c46713cb5cbf7aeae
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Fri Apr 4 13:53:53 2014 -0400
+
+ Fixed my regression test
+
+ commit 9c6a69289fea5f4a93f9464a4efea0011fd08804
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Fri Apr 4 13:51:01 2014 -0400
+
+ Added leolo-alarm-adjust.t to test alarm_adjust() and delay_adjust()
+
+ commit e3db9b7c0dff9e46811f200507f5307aee6b1b80
+ Author: Philip Gwyn <gwyn@cpan.org>
+ Date: Thu Mar 27 12:09:54 2014 -0400
+
+ Calculate window pixel size from columns, lines. Doco changes for
+ above. Don't complain about Winsize for pty-pipe conduit.
+
+ commit 1f63f16144151c334b6ade0a12a02d58fa80387a
+ Author: Rocco Caputo <rcaputo@cpan.org>
+ Date: Fri Feb 28 11:33:02 2014 -0500
+
+ Socket.pm supports unpack_sockaddr_in6() now.
+
+================================
+2013-12-08 03:10:49 -0500 v1_358
+================================
commit 189d17148acd03df579dd12d043486d97db0c7cf
Author: Rocco Caputo <rcaputo@cpan.org>
@@ -59,6 +59,7 @@ lib/POE/Resource/Sessions.pm
lib/POE/Resource/Signals.pm
lib/POE/Resources.pm
lib/POE/Session.pm
+lib/POE/Test/Sequence.pm
lib/POE/Wheel.pm
lib/POE/Wheel/Curses.pm
lib/POE/Wheel/FollowTail.pm
@@ -4,7 +4,7 @@
"Rocco Caputo <rcaputo@cpan.org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.132830",
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520",
"license" : [
"perl_5"
],
@@ -23,12 +23,12 @@
"prereqs" : {
"build" : {
"requires" : {
- "POE::Test::Loops" : "1.352"
+ "POE::Test::Loops" : "1.358"
}
},
"configure" : {
"requires" : {
- "POE::Test::Loops" : "1.352"
+ "POE::Test::Loops" : "1.358"
}
},
"runtime" : {
@@ -41,7 +41,7 @@
"IO::Handle" : "1.27",
"IO::Pipely" : "0.005",
"IO::Tty" : "1.08",
- "POE::Test::Loops" : "1.352",
+ "POE::Test::Loops" : "1.358",
"POSIX" : "1.02",
"Socket" : "1.7",
"Storable" : "2.16",
@@ -60,5 +60,5 @@
"url" : "https://github.com/rcaputo/poe"
}
},
- "version" : "1.358"
+ "version" : "1.364"
}
@@ -3,15 +3,15 @@ abstract: 'Portable, event-loop agnostic eventy networking and multitasking.'
author:
- 'Rocco Caputo <rcaputo@cpan.org>'
build_requires:
- POE::Test::Loops: 1.352
+ POE::Test::Loops: '1.358'
configure_requires:
- POE::Test::Loops: 1.352
+ POE::Test::Loops: '1.358'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.132830'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.141520'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: POE
no_index:
directory:
@@ -19,22 +19,22 @@ no_index:
- inc
- mylib
requires:
- Carp: 0
- Errno: 1.09
- Exporter: 0
- File::Spec: 0.87
- IO: 1.24
- IO::Handle: 1.27
- IO::Pipely: 0.005
- IO::Tty: 1.08
- POE::Test::Loops: 1.352
- POSIX: 1.02
- Socket: 1.7
- Storable: 2.16
- Test::Harness: 2.26
- Time::HiRes: 1.59
+ Carp: '0'
+ Errno: '1.09'
+ Exporter: '0'
+ File::Spec: '0.87'
+ IO: '1.24'
+ IO::Handle: '1.27'
+ IO::Pipely: '0.005'
+ IO::Tty: '1.08'
+ POE::Test::Loops: '1.358'
+ POSIX: '1.02'
+ Socket: '1.7'
+ Storable: '2.16'
+ Test::Harness: '2.26'
+ Time::HiRes: '1.59'
resources:
homepage: http://poe.perl.org/
license: http://dev.perl.org/licenses/
repository: https://github.com/rcaputo/poe
-version: 1.358
+version: '1.364'
@@ -1,4 +1,4 @@
-Version 1.358
+Version 1.364
--------------------
Detailed Information
@@ -3,7 +3,7 @@ package POE::Component::Client::TCP;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw(carp croak);
use Errno qw(ETIMEDOUT ECONNRESET);
@@ -3,7 +3,7 @@ package POE::Component::Server::TCP;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw(carp croak);
use Socket qw(INADDR_ANY inet_ntoa inet_aton AF_INET AF_UNIX PF_UNIX);
@@ -5,7 +5,7 @@ package POE::Component;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
1;
@@ -7,7 +7,7 @@ package POE::Driver::SysRW;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Errno qw(EAGAIN EWOULDBLOCK);
use Carp qw(croak);
@@ -3,7 +3,7 @@ package POE::Driver;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw(croak);
@@ -4,7 +4,7 @@ use strict;
use POE::Filter;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Filter);
use Carp qw(croak);
@@ -14,6 +14,12 @@ sub BLOCK_SIZE () { 1 }
sub EXPECTED_SIZE () { 2 }
sub ENCODER () { 3 }
sub DECODER () { 4 }
+sub MAX_LENGTH () { 5 }
+sub MAX_BUFFER () { 6 }
+sub FIRST_UNUSED () { 7 }
+
+use base 'Exporter';
+our @EXPORT_OK = qw( FIRST_UNUSED );
#------------------------------------------------------------------------------
@@ -38,13 +44,17 @@ sub new {
croak "$type must be given an even number of parameters" if @_ & 1;
my %params = @_;
- my ($encoder, $decoder);
+ my $max_buffer = $type->__param_max( MaxBuffer => 512*1024*1024, \%params );
+
+ my ($encoder, $decoder, $max_length);
my $block_size = delete $params{BlockSize};
if (defined $block_size) {
croak "$type doesn't support zero or negative block sizes"
if $block_size < 1;
croak "Can't use both LengthCodec and BlockSize at the same time"
if exists $params{LengthCodec};
+ croak "Can't use both MaxLength and BlockSize at the same time"
+ if exists $params{MaxLength};
}
else {
my $codec = delete $params{LengthCodec};
@@ -63,14 +73,23 @@ sub new {
$encoder = \&_default_encoder;
$decoder = \&_default_decoder;
}
+ $max_length = $type->__param_max( MaxLength => 64*1024*1024, \%params );
+ croak "MaxBuffer is not large enough for MaxLength blocks"
+ unless $max_buffer >= $max_length + length( $max_length ) + 1;
}
+ delete @params{qw(MaxLength MaxBuffer LengthCode BlockSize)};
+ carp("$type ignores unknown parameters: ", join(', ', sort keys %params))
+ if scalar keys %params;
+
my $self = bless [
'', # FRAMING_BUFFER
$block_size, # BLOCK_SIZE
undef, # EXPECTED_SIZE
$encoder, # ENCODER
$decoder, # DECODER
+ $max_length, # MAX_LENGTH
+ $max_buffer # MAX_BUFFER
], $type;
$self;
@@ -88,6 +107,8 @@ sub new {
sub get_one_start {
my ($self, $stream) = @_;
$self->[FRAMING_BUFFER] .= join '', @$stream;
+ die "Framing buffer exceeds the limit"
+ if $self->[MAX_BUFFER] < length( $self->[FRAMING_BUFFER] );
}
sub get_one {
@@ -109,12 +130,13 @@ sub get_one {
# Otherwise we're doing the variable-length block thing. Look for a
# length marker, and then pull off a chunk of that length. Repeat.
- if (
- defined($self->[EXPECTED_SIZE]) ||
- defined(
- $self->[EXPECTED_SIZE] = $self->[DECODER]->(\$self->[FRAMING_BUFFER])
- )
- ) {
+ unless( defined($self->[EXPECTED_SIZE]) ) {
+ $self->[EXPECTED_SIZE] = $self->[DECODER]->(\$self->[FRAMING_BUFFER]);
+ die "Expected size of next block exceeds the limit"
+ if defined($self->[EXPECTED_SIZE]) and
+ $self->[EXPECTED_SIZE] > $self->[MAX_LENGTH];
+ }
+ if ( defined($self->[EXPECTED_SIZE]) ) {
return [ ] if length($self->[FRAMING_BUFFER]) < $self->[EXPECTED_SIZE];
# Four-arg substr() would be better here, but it's not compatible
@@ -249,7 +271,25 @@ can be determined.
return $1;
}
-This filter holds onto incomplete blocks until they are completed.
+This filter holds onto incomplete blocks until they are completed in a
+framing buffer. To control memory usage, a maximum framing buffer size is
+imposed. This maximum size defaults to 512 MB (512*1024*1024 octets). You
+may change this size limit with the C<MaxBuffer> parameter.
+
+ MaxBuffer => 1099511627776 # One terabyte!
+
+The size of each individual block is also limited. By default, each block
+may be no more then 64 MB. You may change this size limit with the
+C<MaxLength> parameter.
+
+ MaxLength => 10 # small blocks
+
+Remember that MaxBuffer needs to be larger then MaxLength. What's more, it
+needs to have room for the length prefix.
+
+If either the C<MaxLength> or C<MaxBuffer> constraint is exceeded,
+C<POE::Filter::Bock> will throw an exception.
+
=head1 PUBLIC FILTER METHODS
@@ -6,7 +6,7 @@ use strict;
use POE::Filter;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Filter);
use Carp qw(croak carp);
@@ -15,6 +15,12 @@ sub BUFFER () { 0 }
sub CODEGET () { 1 }
sub CODEPUT () { 2 }
+sub FIRST_UNUSED () { 3 } # First unused $self offset.
+
+use base 'Exporter';
+our @EXPORT_OK = qw( FIRST_UNUSED );
+
+
#------------------------------------------------------------------------------
sub new {
@@ -32,10 +38,17 @@ sub new {
unless ((defined $params{Get} ? (ref $params{Get} eq 'CODE') : 1)
and (defined $params{Put} ? (ref $params{Put} eq 'CODE') : 1));
+ my $get = $params{Code} || $params{Get};
+ my $put = $params{Code} || $params{Put};
+
+ delete @params{qw(Code Get Put)};
+ carp("$type ignores unknown parameters: ", join(', ', sort keys %params))
+ if scalar keys %params;
+
my $self = bless [
- [ ], # BUFFER
- $params{Code} || $params{Get}, # CODEGET
- $params{Code} || $params{Put}, # CODEPUT
+ [ ], # BUFFER
+ $get, # CODEGET
+ $put, # CODEPUT
], $type;
}
@@ -13,16 +13,22 @@ use strict;
use POE::Filter;
use vars qw($VERSION @ISA);
-$VERSION = '1.358';
+$VERSION = '1.364';
# NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Filter);
+sub DEBUG () { 0 }
+
sub BUFFER () { 0 } # raw data buffer to build requests
sub STATE () { 1 } # built a full request
sub REQUEST () { 2 } # partial request being built
sub CLIENT_PROTO () { 3 } # client protocol version requested
sub CONTENT_LEN () { 4 } # expected content length
sub CONTENT_ADDED () { 5 } # amount of content added to request
+sub CONTENT_MAX () { 6 } # max amount of content
+sub STREAMING () { 7 } # we want to work in streaming mode
+sub MAX_BUFFER () { 8 } # max size of framing buffer
+sub FIRST_UNUSED () { 9 }
sub ST_HEADERS () { 0x01 } # waiting for complete header block
sub ST_CONTENT () { 0x02 } # waiting for complete body
@@ -38,10 +44,67 @@ use URI ();
my $HTTP_1_0 = _http_version("HTTP/1.0");
my $HTTP_1_1 = _http_version("HTTP/1.1");
+use base 'Exporter';
+our @EXPORT_OK = qw( FIRST_UNUSED );
+
+
+
+#------------------------------------------------------------------------------
+# Set up some routines for convert wide chars (which aren't allowed in HTTP headers)
+# into MIME encoded equivalents.
+# See ->headers_as_strings
+BEGIN {
+ eval "use utf8";
+ if( $@ ) {
+ DEBUG and warn "We don't have utf8.";
+ *HAVE_UTF8 = sub { 0 };
+ }
+ else {
+ *HAVE_UTF8 = sub { 1 };
+ my $downgrade = sub {
+ my $ret = $_[0];
+ utf8::downgrade( $ret );
+ return $ret
+ };
+ eval "use Email::MIME::RFC2047::Encoder";
+ if( $@ ) {
+ DEBUG and warn "We don't have Email::MIME::RFC2047::Encoder";
+ *encode_value = sub {
+ Carp::cluck(
+ "Downgrading wide characters in HTTP header. " .
+ "Consier installing Email::MIME::RFC2047::Encoder"
+ );
+ $downgrade->( @_ );
+ };
+ }
+ else {
+ my $encoder = Email::MIME::RFC2047::Encoder->new( encoding => 'iso-8859-1',
+ method => 'Q'
+ );
+ *encode_value = sub { $downgrade->( $encoder->encode_text( @_ ) ) };
+ }
+ }
+}
+
+
#------------------------------------------------------------------------------
sub new {
my $type = shift;
+ croak "$type requires an even number of parameters" if @_ and @_ & 1;
+ my %params = @_;
+
+ my $max_content = $type->__param_max( MaxContent => 1024*1024, \%params );
+ my $max_buffer = $type->__param_max( MaxBuffer => 512*1024*1024, \%params );
+ my $streaming = $params{Streaming} || 0;
+
+ croak "MaxBuffer is not large enough for MaxContent"
+ unless $max_buffer >= $max_content + length( $max_content ) + 1;
+
+ delete @params{qw(MaxContent MaxBuffer Streaming)};
+ carp("$type ignores unknown parameters: ", join(', ', sort keys %params))
+ if scalar keys %params;
+
return bless(
[
'', # BUFFER
@@ -50,6 +113,9 @@ sub new {
undef, # CLIENT_PROTO
0, # CONTENT_LEN
0, # CONTENT_ADDED
+ $max_content, # CONTENT_MAX
+ $streaming, # STREAMING
+ $max_buffer # MAX_BUFFER
],
$type
);
@@ -59,7 +125,11 @@ sub new {
sub get_one_start {
my ($self, $stream) = @_;
+
$self->[BUFFER] .= join( '', @$stream );
+ DEBUG and warn "$$:poe-filter-httpd: Buffered ".length( $self->[BUFFER] )." bytes";
+ die "Framing buffer exceeds the limit"
+ if $self->[MAX_BUFFER] < length( $self->[BUFFER] );
}
sub get_one {
@@ -70,6 +140,7 @@ sub get_one {
# Waiting for a complete suite of headers.
if ($self->[STATE] & ST_HEADERS) {
+ DEBUG and warn "$$:poe-filter-httpd: Looking for headers";
# Strip leading whitespace.
$self->[BUFFER] =~ s/^\s+//;
@@ -125,8 +196,15 @@ sub get_one {
my $cl = $r->content_length();
if( defined $cl ) {
- $cl =~ s/\D.*$//;
- $cl ||= 0;
+ unless( $cl =~ /^\s*(\d+)\s*$/ ) {
+ $r = $self->_build_error(RC_BAD_REQUEST,
+ "Content-Length is not a number.",
+ $r);
+ $self->[BUFFER] = '';
+ $self->_reset();
+ return [ $r ];
+ }
+ $cl = $1 || 0;
}
my $ce = $r->content_encoding();
@@ -182,10 +260,21 @@ sub get_one {
"No content length found.",
$r);
}
+ $self->[BUFFER] = '';
$self->_reset();
return [ $r ];
}
+ # Prevent DOS of a server by malicious clients
+ if( not $self->[STREAMING] and $cl > $self->[CONTENT_MAX] ) {
+ $r = $self->_build_error(RC_REQUEST_ENTITY_TOO_LARGE,
+ "Content of $cl octets not accepted.",
+ $r);
+ $self->[BUFFER] = '';
+ $self->_reset();
+ return [ $r ];
+ }
+
$self->[REQUEST] = $r;
$self->[CONTENT_LEN] = $cl;
$self->[STATE] = ST_CONTENT;
@@ -198,6 +287,33 @@ sub get_one {
my $cl_needed = $self->[CONTENT_LEN] - $self->[CONTENT_ADDED];
die "already got enough content ($cl_needed needed)" if $cl_needed < 1;
+ if( $self->[STREAMING] ) {
+ DEBUG and warn "$$:poe-filter-httpd: Streaming request content";
+ my @ret;
+ # do we have a request?
+ if( $self->[REQUEST] ) {
+ DEBUG and warn "$$:poe-filter-httpd: Sending request";
+ push @ret, $self->[REQUEST]; # send it to the wheel
+ $self->[REQUEST] = undef;
+ }
+ # do we have some content ?
+ if( length( $self->[BUFFER] ) ) { # send it to the wheel
+ my $more = substr($self->[BUFFER], 0, $cl_needed);
+ DEBUG and warn "$$:poe-filter-httpd: Sending content";
+ push @ret, $more;
+ $self->[CONTENT_ADDED] += length($more);
+ substr( $self->[BUFFER], 0, length($more) ) = "";
+ # is that enough content?
+ if( $self->[CONTENT_ADDED] >= $self->[CONTENT_LEN] ) {
+ DEBUG and warn "$$:poe-filter-httpd: All content received ($self->[CONTENT_ADDED] >= $self->[CONTENT_LEN])";
+ # Strip MSIE 5.01's extra CRLFs
+ $self->[BUFFER] =~ s/^\s+//;
+ $self->_reset;
+ }
+ }
+ return \@ret;
+ }
+
# Not enough content to complete the request. Add it to the
# request content, and return an incomplete status.
if (length($self->[BUFFER]) < $cl_needed) {
@@ -270,20 +386,93 @@ sub put {
my @headers;
push @headers, $status_line;
- push @headers, $_->headers_as_string("\x0D\x0A");
- push @raw, join("\x0D\x0A", @headers, "") . $_->content;
+ # Perl can magically promote a string to UTF-8 if it is concatinated
+ # with another UTF-8 string. This behaviour changed between 5.8.8 and
+ # 5.10.1. This is normaly not a problem, but POE::Driver::SysRW uses
+ # syswrite(), which sends POE's internal buffer as-is.
+ # In other words, if the header contains UTF-8, the content will be
+ # promoted to UTF-8 and syswrite() will send those wide bytes, which
+ # will corrupt any images.
+ # For instance, 00 e7 ff 00 00 00 05
+ # will become, 00 c3 a7 c3 bf 00 00 00 05
+ #
+ # The real bug is in HTTP::Message->headers_as_string, which doesn't respect
+ # the following:
+ #
+ # "The TEXT rule is only used for descriptive field contents and values
+ # that are not intended to be interpreted by the message parser. Words
+ # of *TEXT MAY contain characters from character sets other than ISO-
+ # 8859-1 [22] only when encoded according to the rules of RFC 2047
+ # [14]. " -- RFC2616 section 2.2
+ # http://www.ietf.org/rfc/rfc2616.txt
+ # http://www.ietf.org/rfc/rfc2047.txt
+ my $endl = "\x0D\x0A";
+ push @headers, $self->headers_as_strings( $_->headers, $endl );
+ push @raw, join( $endl, @headers, "", "") . $_->content;
}
\@raw;
}
+sub headers_as_strings
+{
+ my( $self, $H, $endl ) = @_;
+ my @ret;
+ # $H is a HTTP::Headers object
+ foreach my $name ( $H->header_field_names ) {
+ # message-header = field-name ":" [ field-value ]
+ # field-name = token
+ # RFC2616 section 4.2
+ #
+ # token = 1*<any CHAR except CTLs or separators>
+ # separators = "(" | ")" | "<" | ">" | "@"
+ # | "," | ";" | ":" | "\" | <">
+ # | "/" | "[" | "]" | "?" | "="
+ # | "{" | "}" | SP | HT
+ # CHAR = <any US-ASCII character (octets 0 - 127)>
+ # CTL = <any US-ASCII control character
+ # (octets 0 - 31) and DEL (127)>
+ # SP = <US-ASCII SP, space (32)>
+ # HT = <US-ASCII HT, horizontal-tab (9)>
+ # RFC2616 section 2.2
+
+ # In other words, plain ascii text. HTTP::Headers doesn't check for
+ # this, of course. So if we complain here, the cluck ends up in
+ # the wrong place. Doing the simplest thing
+ utf8::downgrade( $name ) if HAVE_UTF8;
+
+ # Deal with header values
+ foreach my $value ( $H->header( $name ) ) {
+ if( HAVE_UTF8 and utf8::is_utf8( $value ) ) {
+ DEBUG and warn "$$: Header $name is UTF-8";
+ $value = encode_value( $value );
+ }
+
+ push @ret, join ": ", $name, _process_newline( $value, $endl );
+ }
+ }
+ return @ret;
+}
+
+# This routine is lifted as-is from HTTP::Headers
+sub _process_newline {
+ local $_ = shift;
+ my $endl = shift;
+ # must handle header values with embedded newlines with care
+ s/\s+$//; # trailing newlines and space must go
+ s/\n(\x0d?\n)+/\n/g; # no empty lines
+ s/\n([^\040\t])/\n $1/g; # initial space for continuation
+ s/\n/$endl/g; # substitute with requested line ending
+ $_;
+}
+
#------------------------------------------------------------------------------
sub get_pending {
my $self = shift;
- croak ref($self)." does not support the get_pending() method\n";
- return;
+ return [ $self->[BUFFER] ] if length $self->[BUFFER];
+ return undef;
}
#------------------------------------------------------------------------------
@@ -430,10 +619,41 @@ returns their corresponding streams.
Please see L<HTTP::Request> and L<HTTP::Response> for details about
how to use these objects.
+HTTP headers are not allowed to have UTF-8 characters; they must be
+ISO-8859-1. POE::Filter::HTTPD will convert all UTF-8 into the MIME encoded
+equivalent. It uses L<utf8::is_utf8> for detection-8 and
+L<Email::MIME::RFC2047::Encoder> for convertion. If L<utf8> is not
+installed, no conversion happens. If L<Email::MIME::RFC2047::Encoder> is
+not installed, L<utf8::downgrade> is used instead. In this last case, you will
+see a warning if you try to send UTF-8 headers.
+
+
=head1 PUBLIC FILTER METHODS
POE::Filter::HTTPD implements the basic POE::Filter interface.
+=head2 new
+
+new() accepts a list of named parameters.
+
+C<MaxBuffer> sets the maximum amount of data the filter will hold in memory.
+Defaults to 512 MB (536870912 octets). Because POE::Filter::HTTPD copies
+all data into memory, setting this number to high would allow a malicious
+HTTPD client to fill all server memory and swap.
+
+C<MaxContent> sets the maximum size of the content of an HTTP request.
+Defaults to 1 MB (1038336 octets). Because POE::Filter::HTTPD copies all
+data into memory, setting this number to high would allow a malicious HTTPD
+client to fill all server memory and swap. Ignored if L</Streaming> is set.
+
+C<Streaming> turns on request streaming mode. Defaults to off. In
+streaming mode this filter will return either an HTTP::Request object or a
+block of content. The HTTP::Request object's content will return empty.
+The blocks of content will be parts of the request's body, up to
+Content-Length in size. You distinguish between request objects and content
+blocks using C<Scalar::Util/bless> (See L</Streaming request> below). This
+option superceeds L</MaxContent>.
+
=head1 CAVEATS
Some versions of libwww are known to generate invalid HTTP. For
@@ -464,14 +684,147 @@ Upon handling a request error, it is most expedient and reliable to
respond with the error and shut down the connection. Invalid HTTP
requests may corrupt the request stream. For example, the absence of
a Content-Length header signals that a request has no content.
-Requests with content but not that header will be broken into a
+Requests with content but without that header will be broken into a
content-less request and invalid data. The invalid data may also
appear to be a request! Hilarity will ensue, possibly repeatedly,
until the filter can find the next valid request. By shutting down
the connection on the first sign of error, the client can retry its
request with a clean connection and filter.
-=head1 Streaming Media
+
+=head1 Streaming Request
+
+Normally POE::Filter::HTTPD reads the entire request content into memory
+before returning the HTTP::Request to your code. In streaming mode, it will
+return the content seprately, as unblessed scalars. The content may be
+split up into blocks of varying sizes, depending on OS and transport
+constraints. Your code can distinguish the request object from the content
+blocks using L<Scalar::Util/blessed>.
+
+ use Scalar::Util;
+ use POE::Wheel::ReadWrite;
+ use POE::Filter:HTTPD;
+
+ $heap->{wheel} = POE::Wheel::ReadWrite->new(
+ InputEvent => 'http_input',
+ Filter => POE::Filter::HTTPD->new( Streaming => 1 ),
+ # ....
+ );
+
+ sub http_input_handler
+ {
+ my( $heap, $req_or_data ) = @_[ HEAP, ARG0 ];
+ if( blessed $req_or_data ) {
+ my $request = $req_or_data;
+ if( $request->isa( 'HTTP::Response') ) {
+ # HTTP error
+ $heap->{wheel}->put( $request );
+ }
+ else {
+ # HTTP request
+ # ....
+ }
+ }
+ else {
+ my $data = $req_or_data;
+ # ....
+ }
+ }
+
+You may trivally create a DoS bug if you hold all content in memory but do
+not impose a maximum Content-Length. An attacker could send
+C<Content-Length: 1099511627776> (aka 1 TB) and keep sending data until all
+your system's memory and swap is filled.
+
+Content-Length has been sanitized by POE::Filter::HTTPD so checking it is trivial :
+
+ if( $request->headers( 'Content-Length' ) > 1024*1024 ) {
+ my $resp = HTTP::Response->new( RC_REQUEST_ENTITY_TOO_LARGE ),
+ "So much content!" )
+ $heap->{wheel}->put( $resp );
+ return;
+ }
+
+If you want to handle large amounts of data, you should save the content to a file
+before processing it. You still need to check Content-Length or an attacker might
+fill up the partition.
+
+ use File::Temp qw(tempfile);
+
+ if( blessed $_[ARG0] ) {
+ $heap->{request} = $_[ARG0];
+ if( $heap->{request}->method eq 'GET' ) {
+ handle_get( $heap );
+ delete $heap->{request};
+ return;
+ }
+ my( $fh, $file ) = tempfile( "httpd-XXXXXXXX", TMPDIR=>1 );
+ $heap->{content_file} = $file;
+ $heap->{content_fh} = $fh;
+ $heap->{content_size} = 0;
+ }
+ else {
+ return unless $heap->{request};
+
+ $heap->{content_size} += length( $_[ARG0] );
+ $heap->{content_fh}->print( $_[ARG0] );
+ if( $heap->{content_size} >= $heap->{request}->headers( 'content-length' ) ) {
+ delete $heap->{content_fh};
+ delete $heap->{content_size};
+
+ # Now we can parse $heap->{content_file}
+ if( $heap->{request}->method eq 'POST' ) {
+ handle_post( $heap );
+ }
+ else {
+ # error ...
+ }
+ }
+ }
+
+ sub handle_post
+ {
+ my( $heap ) = @_;
+ # Now we have to load and parse $heap->{content_file}
+
+ # Next 6 lines make the data available to CGI->init
+ local $ENV{REQUEST_METHOD} = 'POST';
+ local $CGI::PERLEX = $CGI::PERLEX = "CGI-PerlEx/Fake";
+ local $ENV{CONTENT_TYPE} = $heap->{req}->header( 'content-type' );
+ local $ENV{CONTENT_LENGTH} = $heap->{req}->header( 'content-length' );
+ my $keep = IO::File->new( "<&STDIN" ) or die "Unable to reopen STDIN: $!";
+ open STDIN, "<$heap->{content_file}" or die "Reopening STDIN failed: $!";
+
+ my $qcgi = CGI->new();
+
+ # cleanup
+ open STDIN, "<&".$keep->fileno or die "Unable to reopen $keep: $!";
+ undef $keep;
+ unlink delete $heap->{content_file};
+
+ # now use $q as you would normaly
+ my $file = $q->upload( 'field_name' );
+
+ # ....
+ }
+
+ sub handle_get
+ {
+ my( $heap ) = @_;
+
+ # 4 lines to get data into CGI->init
+ local $ENV{REQUEST_METHOD} = 'GET';
+ local $CGI::PERLEX = $CGI::PERLEX = "CGI-PerlEx/Fake";
+ local $ENV{CONTENT_TYPE} = $heap->{req}->header( 'content-type' );
+ local $ENV{'QUERY_STRING'} = $heap->{req}->uri->query;
+
+ my $q = CGI->new();
+
+ # now use $q as you would normaly
+ # ....
+ }
+
+=head1 Streaming Response
It is possible to use POE::Filter::HTTPD for streaming content, but an
application can use it to send headers and then switch to
@@ -4,7 +4,7 @@ use strict;
use POE::Filter;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Filter);
use Carp qw(carp croak);
@@ -15,7 +15,9 @@ sub FRAMING_BUFFER () { 0 }
sub INPUT_REGEXP () { 1 }
sub OUTPUT_LITERAL () { 2 }
sub AUTODETECT_STATE () { 3 }
-sub FIRST_UNUSED () { 4 } # First unused $self offset.
+sub MAX_LENGTH () { 4 }
+sub MAX_BUFFER () { 5 }
+sub FIRST_UNUSED () { 6 } # First unused $self offset.
sub AUTO_STATE_DONE () { 0x00 }
sub AUTO_STATE_FIRST () { 0x01 }
@@ -93,7 +95,12 @@ sub new {
}
}
- delete @params{qw(Literal InputLiteral OutputLiteral InputRegexp)};
+ my $max_buffer = $type->__param_max( MaxBuffer => 512*1024*1024, \%params );
+ my $max_length = $type->__param_max( MaxLength => 64*1024*1024, \%params );
+ croak "MaxBuffer is not large enough for MaxLength blocks"
+ unless $max_buffer >= $max_length;
+
+ delete @params{qw(Literal InputLiteral OutputLiteral InputRegexp MaxLength MaxBuffer)};
carp("$type ignores unknown parameters: ", join(', ', sort keys %params))
if scalar keys %params;
@@ -102,6 +109,8 @@ sub new {
$input_regexp, # INPUT_REGEXP
$output_literal, # OUTPUT_LITERAL
$autodetect, # AUTODETECT_STATE
+ $max_length, # MAX_LENGTH
+ $max_buffer # MAX_BUFFER
], $type;
DEBUG and warn join ':', @$self;
@@ -127,6 +136,8 @@ sub get_one_start {
};
$self->[FRAMING_BUFFER] .= join '', @$stream;
+ die "Framing buffer exceeds the limit"
+ if $self->[MAX_BUFFER] < length( $self->[FRAMING_BUFFER] );
}
# TODO There is a lot of code duplicated here. What can be done?
@@ -143,8 +154,11 @@ sub get_one {
last LINE
unless $self->[FRAMING_BUFFER] =~ s/^(.*?)$self->[INPUT_REGEXP]//s;
DEBUG and warn "got line: <<", unpack('H*', $1), ">>\n";
+ my $line = $1;
+ die "Next line exceeds maximum line length"
+ if length( $line ) > $self->[MAX_LENGTH];
- return [ $1 ];
+ return [ $line ];
}
# Waiting for the first line ending. Look for a generic newline.
@@ -173,6 +187,8 @@ sub get_one {
$self->[INPUT_REGEXP] = $2;
$self->[AUTODETECT_STATE] = AUTO_STATE_SECOND;
}
+ die "Next line exceeds maximum line length"
+ if length( $line ) > $self->[MAX_LENGTH];
return [ $line ];
}
@@ -337,6 +353,15 @@ the paragraph separator is "---" on a line by itself.
OutputLiteral => "\n---\n",
);
+C<MaxBuffer> sets the maximum amount of data that the filter will hold onto
+while trying to find a line ending. Defaults to 512 MB.
+
+C<MaxLength> sets the maximum length of a line. Defaults to 64 MB.
+
+If either the C<MaxLength> or C<MaxBuffer> constraint is exceeded,
+C<POE::Filter::Line> will throw an exception.
+
+
=head1 PUBLIC FILTER METHODS
POE::Filter::Line has no additional public methods.
@@ -6,7 +6,7 @@ use strict;
use POE::Filter;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Filter);
use Carp qw(croak carp);
@@ -15,6 +15,12 @@ sub BUFFER () { 0 }
sub CODEGET () { 1 }
sub CODEPUT () { 2 }
+sub FIRST_UNUSED () { 3 } # First unused $self offset.
+
+use base 'Exporter';
+our @EXPORT_OK = qw( FIRST_UNUSED );
+
+
#------------------------------------------------------------------------------
sub new {
@@ -32,10 +38,18 @@ sub new {
unless ((defined $params{Get} ? (ref $params{Get} eq 'CODE') : 1)
and (defined $params{Put} ? (ref $params{Put} eq 'CODE') : 1));
+ my $get = $params{Code} || $params{Get};
+ my $put = $params{Code} || $params{Put};
+
+ delete @params{qw(Code Get Put)};
+ carp("$type ignores unknown parameters: ", join(', ', sort keys %params))
+ if scalar keys %params;
+
+
my $self = bless [
- [ ], # BUFFER
- $params{Code} || $params{Get}, # CODEGET
- $params{Code} || $params{Put}, # CODEPUT
+ [ ], # BUFFER
+ $get, # CODEGET
+ $put, # CODEPUT
], $type;
}
@@ -6,7 +6,7 @@ use strict;
use POE::Filter;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Filter);
use Carp qw(croak);
@@ -15,6 +15,11 @@ sub BLOCKSIZE () { 0 };
sub GETBUFFER () { 1 };
sub PUTBUFFER () { 2 };
sub CHECKPUT () { 3 };
+sub FIRST_UNUSED () { 4 }
+
+use base 'Exporter';
+our @EXPORT_OK = qw( FIRST_UNUSED );
+
#------------------------------------------------------------------------------
@@ -24,15 +29,24 @@ sub new {
croak "$type must be given an even number of parameters" if @_ & 1;
my %params = @_;
+ # Block size
croak "BlockSize must be greater than 0" unless (
defined($params{BlockSize}) && ($params{BlockSize} > 0)
);
+ my $block_size = $params{BlockSize};
+
+ # check put
+ my $check_put = $params{CheckPut};
+
+ delete @params{ qw( BlockSize CheckPut ) };
+ carp("$type ignores unknown parameters: ", join(', ', sort keys %params))
+ if scalar keys %params;
my $self = bless [
- $params{BlockSize}, # BLOCKSIZE
+ $block_size, # BLOCKSIZE
[], # GETBUFFER
[], # PUTBUFFER
- $params{CheckPut}, # CHECKPUT
+ $check_put # CHECKPUT
], $type;
}
@@ -42,7 +56,7 @@ sub clone {
$self->[0], # BLOCKSIZE
[], # GETBUFFER
[], # PUTBUFFER
- $self->[3], # CHECKPUT
+ $self->[3] # CHECKPUT
], ref $self;
$clone;
}
@@ -7,7 +7,7 @@ use strict;
use POE::Filter;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Filter);
use Carp qw(carp croak confess);
@@ -17,6 +17,19 @@ sub FREEZE () { 1 }
sub THAW () { 2 }
sub COMPRESS () { 3 }
sub NO_FATALS () { 4 }
+sub MAX_BUFFER () { 5 }
+sub BAD_BUFFER () { 6 }
+sub FIRST_UNUSED () { 7 }
+
+use base 'Exporter';
+our @EXPORT_OK = qw( FIRST_UNUSED );
+
+my %KNOWN_PARAMS = (
+ Compression => 1,
+ Serializer => 1,
+ NoFatals => 1,
+ MaxBuffer => 1
+);
#------------------------------------------------------------------------------
# Try to require one of the default freeze/thaw packages.
@@ -78,10 +91,42 @@ sub _get_methods {
#------------------------------------------------------------------------------
-sub new {
- my($type, $freezer, $compression, $no_fatals) = @_;
+sub new
+{
+ my $type = shift;
+
+ # Convert from old style to new style
+ # $l == 1
+ # ->new( undef ) => (Serializer => undef)
+ # ->new( $class ) => (Serializer => class)
+ # not defined $_[0]
+ # ->new( undef, 1 ) => (Serializer => undef, Compression => 1)
+ # ->new( undef, undef, 1 ) => (Serializer => undef, Compression => undef, NoFatals =>1)
+ # $l == 3
+ # ->new( $class, 1, 1 ) => (Serializer => undef, Compression => 1, NoFatals =>1)
+ # ($l <= 3 and not $KNOWN_PARAMS{$_[0]})
+ # ->new( $class, 1 )
+ my %params;
+ my $l = scalar @_;
+ if( $l == 1 or $l == 3 or not defined $_[0] or
+ ( $l<=3 and not $KNOWN_PARAMS{$_[0]}) ) {
+ if( 'HASH' eq ref $_[0] ) { # do we
+ %params = %{ $_[0] };
+ }
+ else {
+ %params = ( Serializer => $_[0],
+ Compression => $_[1],
+ NoFatals => $_[2]
+ );
+ }
+ }
+ else {
+ croak "$type requires an even number of parameters" if @_ and @_ & 1;
+ %params = @_;
+ }
my($freeze, $thaw);
+ my $freezer = $params{Serializer};
unless (defined $freezer) {
# Okay, load the default one!
$freezer = $DEF_FREEZER;
@@ -131,8 +176,11 @@ sub new {
# wants?
return unless $freeze and $thaw;
+ # Maximum buffer
+ my $max_buffer = $type->__param_max( MaxBuffer => 512*1024*1024, \%params );
+
# Compression
- $compression ||= 0;
+ my $compression = $params{Compression}||0;
if ($compression) {
my $zlib_status = _include_zlib();
if ($zlib_status ne '') {
@@ -142,12 +190,21 @@ sub new {
}
}
+ # No fatals
+ my $no_fatals = $params{NoFatals}||0;
+
+ delete @params{ keys %KNOWN_PARAMS };
+ carp("$type ignores unknown parameters: ", join(', ', sort keys %params))
+ if scalar keys %params;
+
my $self = bless [
'', # BUFFER
$freeze, # FREEZE
$thaw, # THAW
$compression, # COMPRESS
- $no_fatals || 0, # NO_FATALS
+ $no_fatals, # NO_FATALS
+ $max_buffer, # MAX_BUFFER
+ '' # BAD_BUFFER
], $type;
$self;
}
@@ -176,6 +233,10 @@ sub get {
sub get_one_start {
my ($self, $stream) = @_;
$self->[BUFFER] .= join('', @$stream);
+ if( $self->[MAX_BUFFER] < length( $self->[BUFFER] ) ) {
+ $self->[BAD_BUFFER] = "Framing buffer exceeds the limit";
+ die $self->[BAD_BUFFER] unless $self->[NO_FATALS];
+ }
}
sub get_one {
@@ -184,6 +245,12 @@ sub get_one {
# Need to check lengths in octets, not characters.
BEGIN { eval { require bytes } and bytes->import; }
+ if( $self->[BAD_BUFFER] ) {
+ my $err = $self->[BAD_BUFFER];
+ $self->[BAD_BUFFER] = '';
+ return [ $err ];
+ }
+
if (
$self->[BUFFER] =~ /^(\d+)\0/ and
length($self->[BUFFER]) >= $1 + length($1) + 1
@@ -287,24 +354,55 @@ different serializer may be specified at construction time.
=head1 PUBLIC FILTER METHODS
-POE::Filter::Reference deviates from the standard POE::Filter API in
-the following ways.
-
-=head2 new [SERIALIZER [, COMPRESSION [, NO_FATALS]]]
+=head2 new
new() creates and initializes a POE::Filter::Reference object. It
-will use Storable as its default SERIALIZER if none other is
-specified.
+accepts a list of named parameters.
+
+=head3 Serializer
+
+Any class that supports nfreeze() (or freeze()) and thaw() may be used
+as a Serializer. If a Serializer implements both nfreeze() and
+freeze(), then the "network" (nfreeze) version will be used.
+
+Serializer may be a class name:
+
+ # Use Storable explicitly, specified by package name.
+ my $filter = POE::Filter::Reference->newer( Serializer=>"Storable" );
+
+ # Use YAML instead. Compress its output, as it may be verbose.
+ my $filter = POE::Filter::Reference->new("YAML", 1);
+
+Serializer may also be an object:
-If COMPRESSION is true, Compress::Zlib will be called upon to reduce
+ # Use an object.
+ my $serializer = Data::Serializer::Something->new();
+ my $filter = POE::Filter::Reference->newer( Serializer => $serializer );
+
+If Serializer is omitted or undef, the Reference filter will try to
+use Storable, FreezeThaw, and YAML in that order.
+POE::Filter::Reference will die if it cannot find one of these
+serializers, but this rarely happens now that Storable and YAML are
+bundled with Perl.
+
+=head3 Compression
+
+If Compression is true, Compress::Zlib will be called upon to reduce
the size of serialized data. It will also decompress the incoming
stream data.
-If NO_FATALS is true, messages will be thawed inside a block eval. By
+=head3 MaxBuffer
+
+C<MaxBuffer> sets the maximum amount of data that the filter will hold onto
+while trying to build a new reference. Defaults to 512 MB.
+
+=head3 NoFatals
+
+If NoFatals is true, messages will be thawed inside a block eval. By
default, however, thaw() is allowed to die normally. If an error
-occurs while NO_FATALS is in effect, POE::Filter::Reference will
+occurs while NoFatals is in effect, POE::Filter::Reference will
return a string containing the contents of $@ at the time the eval
-failed. So when using NO_FATALS, it's important to check whether
+failed. So when using NoFatals, it's important to check whether
input is really a reference:
sub got_reference {
@@ -317,40 +415,24 @@ input is really a reference:
}
}
-Any class that supports nfreeze() (or freeze()) and thaw() may be used
-as a SERIALIZER. If a SERIALIZER implements both nfreeze() and
-freeze(), then the "network" version will be used.
-SERIALIZER may be a class name:
+new() will try to load any classes it needs for L</Compression> or L</Serializer>.
- # Use Storable explicitly, specified by package name.
- my $filter = POE::Filter::Reference->new("Storable");
-
- # Use YAML instead. Compress its output, as it may be verbose.
- my $filter = POE::Filter::Reference->new("YAML", 1);
-
-SERIALIZER may also be an object:
- # Use an object.
- my $serializer = Data::Serializer::Something->new();
- my $filter = POE::Filter::Reference->new($serializer);
+=head2 new [SERIALIZER [, COMPRESSION [, NO_FATALS]]]
-If SERIALIZER is omitted or undef, the Reference filter will try to
-use Storable, FreezeThaw, and YAML in that order.
-POE::Filter::Reference will die if it cannot find one of these
-serializers, but this rarely happens now that Storable and YAML are
-bundled with Perl.
+This is the old constructor synatx. It does not conform to the normal
+POE::Filter constructor parameter syntax. Please use the new syntax
+instead.
- # A choose-your-own-serializer adventure!
- # We'll still deal with compressed data, however.
- my $filter = POE::Filter::Reference->new(undef, 1);
+Calling C<new> like this is equivalent to
-POE::Filter::Reference will try to compress frozen strings and
-uncompress them before thawing if COMPRESSION is true. It uses
-Compress::Zlib for this. POE::Filter::Reference doesn't need
-Compress::Zlib if COMPRESSION is false.
+ POE::Filter::Reference->new( Serializer => SERIALIZER,
+ Compression => COMPRESSION,
+ NoFatals => NO_FATALS );
-new() will try to load any classes it needs.
+Please note that if you have a custom serializer class called C<Serializer>
+you will have to update your code to the new syntax.
=head1 SERIALIZER API
@@ -12,13 +12,18 @@ use strict;
use POE::Filter;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Filter);
use Carp qw(croak);
sub FILTERS () { 0 }
+sub FIRST_UNUSED () { 1 } # First unused $self offset.
+
+use base 'Exporter';
+our @EXPORT_OK = qw( FIRST_UNUSED );
+
#------------------------------------------------------------------------------
sub new {
@@ -4,7 +4,7 @@ use strict;
use POE::Filter;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Filter);
#------------------------------------------------------------------------------
@@ -3,7 +3,7 @@ package POE::Filter;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw(croak);
@@ -42,6 +42,23 @@ sub clone {
return $nself;
}
+
+sub __param_max
+
+{
+ my( $type, $name, $default, $params ) = @_;
+ return $default # 512 MB
+ unless defined $params->{$name};
+
+ my $ret = $params->{$name};
+ croak "$name must be a number"
+ unless $ret =~ /^\d+$/;
+ croak "$name must greater then 0"
+ unless $ret > 0;
+ return $ret;
+}
+
+
1;
__END__
@@ -3,7 +3,7 @@ package POE::Kernel;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use POE::Resource::Clock qw( monotime sleep mono2wall wall2mono walltime time );
@@ -2044,7 +2044,7 @@ sub alarm_adjust {
sub delay_set {
# Always always always grab time() ASAP, so that the eventual
- # time we set the alarm for is as close as possible to the time
+ # time we set the delay for is as close as possible to the time
# at which they ASKED for the delay, not when we actually set it.
my $t = walltime();
my $pri = monotime();
@@ -2086,6 +2086,13 @@ sub delay_set {
# this is optimized internally for this sort of activity.
sub delay_adjust {
+ # Always always always grab time() ASAP, so that the eventual
+ # time we set the delay for is as close as possible to the time
+ # at which they ASKED for the delay, not when we actually set it.
+ my $t = walltime();
+ my $pri = monotime();
+
+ # And now continue as normal
my ($self, $alarm_id, $seconds) = ($poe_kernel, @_[1..$#_]);
if (ASSERT_USAGE) {
@@ -2110,10 +2117,10 @@ sub delay_adjust {
};
if (TRACE_EVENTS) {
- _warn("<ev> adjusted event $alarm_id by $seconds seconds");
+ _warn("<ev> adjusted event $alarm_id by $seconds seconds from $t");
}
- return $self->_data_ev_adjust($alarm_id, $my_delay, undef, $seconds );
+ return $self->_data_ev_set($alarm_id, $my_delay, $t, $pri, $seconds );
}
# Remove all alarms for the current session.
@@ -6,7 +6,7 @@
package POE::Loop::IO_Poll;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
# Include common signal handling.
use POE::Loop::PerlSignals;
@@ -8,7 +8,7 @@ package POE::Loop::PerlSignals;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
# Everything plugs into POE::Kernel.
package POE::Kernel;
@@ -9,7 +9,7 @@ use strict;
use POE::Loop::PerlSignals;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
=for poe_tests
@@ -3,7 +3,7 @@ package POE::Loop;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
1;
@@ -3,7 +3,7 @@ package POE::NFA;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw(carp croak);
@@ -8,7 +8,7 @@ use strict;
use base qw( POE::Pipe );
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use IO::Pipely qw(pipely);
@@ -8,7 +8,7 @@ use strict;
use base qw( POE::Pipe );
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use IO::Pipely qw(socketpairly);
@@ -6,7 +6,7 @@ use warnings;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use IO::Pipely;
@@ -5,7 +5,7 @@ package POE::Queue::Array;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
@ISA = qw(POE::Queue);
use Errno qw(ESRCH EPERM);
@@ -1,7 +1,7 @@
package POE::Queue;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw(croak);
@@ -4,7 +4,7 @@
package POE::Resource::Aliases;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
# These methods are folded into POE::Kernel;
package POE::Kernel;
@@ -3,7 +3,7 @@
package POE::Resource::Clock;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use strict;
@@ -23,7 +23,15 @@ sub CLK_SKEW () { 1 }
sub CLK_EN_READ () { "rt-lock-read" }
-#########################################
+
+# Perform a runtime check for a compile-time flag.
+#
+# TODO - Enable compiler optimization of all calls to this function.
+# The customary way to do this is to migrate the environment variable
+# value into a constant at compile time, then for all callers to check
+# the constant directly. This is such a common thing to do that POE
+# should define a utility library for it.
+
sub _do_X
{
my( $X, $default ) = @_;
@@ -35,27 +43,28 @@ sub _do_X
return 1;
}
-#########################################
+
+# Try to get the exact difference between the monotonic clock's epoch
+# and the system clock's epoch. We do this by comparing the 2 for
+# 0.25 second or 10 samples. To compensate for delays between calling
+# time and get_time, we run in both order. Even so, I still see up to
+# 10 mS divergence in my dev VM between invocations.
+#
+# Only called once, at compile time.
+
sub _exact_epoch
{
my( $monoclock ) = @_;
- # Try to get the exact difference between the monotonic clock's
- # epoch and the system clock's epoch. We do this by comparing the
- # 2 for 0.25 second or 10 samples. To compensate for delays
- # between calling time and get_time, we run in both order. Even
- # so, I still see up to 10 mS divergence in my dev VM between
- # invocations.
-
my $N=0;
my $total = 0;
my $end = $monoclock->get_time() + 0.25;
while( $end > $monoclock->get_time() or $N < 20) {
my $hr = Time::HiRes::time();
- my $mono = $monoclock->get_time;
+ my $mono = $monoclock->get_time();
$total += $hr - $mono;
$N++;
- $mono = $monoclock->get_time;
+ $mono = $monoclock->get_time();
$hr = Time::HiRes::time();
$total += $hr - $mono;
$N++;
@@ -64,13 +73,15 @@ sub _exact_epoch
return $total/$N;
}
+
#########################################
sub _get_epoch
{
my( $monoclock, $wallclock ) = @_;
- return $wallclock->get_time - $monoclock->get_time;
+ return $wallclock->get_time() - $monoclock->get_time();
}
+
#########################################
our $FORMAT = 'iF';
our $LENGTH = length pack $FORMAT, 0, 0;
@@ -82,6 +93,7 @@ sub _pipe_write
syswrite( $write, $buffer, $LENGTH );
}
+
#########################################
sub _pipe_read
{
@@ -125,12 +137,13 @@ sub _rt_setup
$kernel->loop_watch_filehandle( $read, POE::Kernel::MODE_RD() );
}
+
our $EPSILON = 0.0001;
sub _rt_resume
{
my( $what, $timer, $kernel, $pri ) = @_;
DEBUG and POE::Kernel::_warn( "<ck> $what pri=$pri" );
- $kernel->loop_pause_time_watcher;
+ $kernel->loop_pause_time_watcher();
if( $pri <= monotime() ) {
$timer->set_timeout( $EPSILON );
}
@@ -139,14 +152,16 @@ sub _rt_resume
}
}
+
sub _rt_pause
{
my( $timer, $kernel ) = @_;
DEBUG and POE::Kernel::_warn( "<ck> Pause" );
$timer->set_timeout( 60 );
- $kernel->loop_pause_time_watcher
+ $kernel->loop_pause_time_watcher();
}
+
#########################################
sub _rt_read_pipe
{
@@ -171,6 +186,7 @@ sub _rt_read_pipe
}
}
+
#########################################
sub _rt_ready
{
@@ -180,6 +196,7 @@ sub _rt_ready
return 1;
}
+
#########################################
my %SIGnames;
sub _sig_number
@@ -198,6 +215,7 @@ sub _sig_number
return $SIGnames{ $name }+$X;
}
+
#########################################
BEGIN {
my $done;
@@ -208,8 +226,8 @@ BEGIN {
require File::Spec->catfile( qw( POSIX RT Timer.pm ) );
my $monoclock = POSIX::RT::Clock->new( 'monotonic' );
my $wallclock = POSIX::RT::Clock->new( 'realtime' );
- *monotime = sub { return $monoclock->get_time; };
- *walltime = sub { return $wallclock->get_time; };
+ *monotime = sub { return $monoclock->get_time(); };
+ *walltime = sub { return $wallclock->get_time(); };
*sleep = sub { $monoclock->sleep_deeply(@_) };
if( _do_X( 'USE_STATIC_EPOCH' ) ) {
# This is where we cheat: without a static epoch the tests fail
@@ -3,7 +3,7 @@
package POE::Resource::Events;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
# These methods are folded into POE::Kernel;
package POE::Kernel;
@@ -131,14 +131,43 @@ sub _data_ev_enqueue {
return $new_id;
}
+sub _data_ev_set
+{
+ my( $self, $alarm_id, $my_alarm, $time, $pri, $delta ) = @_;
+
+ my $event = (
+ grep { $_->[1] == $alarm_id }
+ $kr_queue->peek_items( $my_alarm )
+ )[0];
+
+ return unless $event;
+
+ my $payload = $event->[ITEM_PAYLOAD];
+
+ # XXX - However, if there has been a clock skew, the priority will
+ # have changed and we should recalculate priority from time+delta
+
+ $delta = $payload->[EV_DELTA] || 0 unless defined $delta;
+ $kr_queue->set_priority( $alarm_id, $my_alarm, $pri+$delta );
+ $payload->[EV_WALLTIME] = $time;
+ $payload->[EV_DELTA] = $delta;
+
+ return( ($payload->[EV_WALLTIME] || 0) + ($payload->[EV_DELTA] || 0) );
+}
+
sub _data_ev_adjust
{
my( $self, $alarm_id, $my_alarm, $time, $delta ) = @_;
# XXX - However, if there has been a clock skew, the priority will
# have changed and we should recalculate priority from time+delta
-
- $kr_queue->adjust_priority( $alarm_id, $my_alarm, $delta );
+ if( $time ) {
+ # PG - We are never invoked with $time anyway.
+ $kr_queue->set_priority( $alarm_id, $my_alarm, $time+$delta );
+ }
+ else {
+ $kr_queue->adjust_priority( $alarm_id, $my_alarm, $delta );
+ }
my $event = (
grep { $_->[1] == $alarm_id }
@@ -5,7 +5,7 @@
package POE::Resource::Extrefs;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
# These methods are folded into POE::Kernel;
package POE::Kernel;
@@ -4,7 +4,7 @@
package POE::Resource::FileHandles;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
# These methods are folded into POE::Kernel;
package POE::Kernel;
@@ -4,7 +4,7 @@
package POE::Resource::SIDs;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
# These methods are folded into POE::Kernel;
package POE::Kernel;
@@ -3,7 +3,7 @@
package POE::Resource::Sessions;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
# These methods are folded into POE::Kernel;
package POE::Kernel;
@@ -4,7 +4,7 @@
package POE::Resource::Signals;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
# These methods are folded into POE::Kernel;
package POE::Kernel;
@@ -1,7 +1,7 @@
package POE::Resource;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
1;
@@ -3,7 +3,7 @@ package POE::Resources;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
my @resources = qw(
POE::XS::Resource::Aliases
@@ -3,7 +3,7 @@ package POE::Session;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw(carp croak);
use Errno;
@@ -0,0 +1,145 @@
+package POE::Test::Sequence;
+
+use warnings;
+use strict;
+
+use Carp qw(croak);
+use POE;
+
+sub new {
+ my ($class, %args) = @_;
+
+ my $sequence = delete $args{sequence};
+ croak "sequence required" unless defined $sequence;
+
+ return bless {
+ sequence => $sequence,
+ test_count => scalar( @$sequence ),
+ }, $class;
+}
+
+sub next {
+ my ($self, $event, $parameter) = @_;
+
+ my $expected_result = shift @{ $self->{sequence} };
+ unless (defined $expected_result) {
+ Test::More::fail(
+ "Got an unexpected result ($event, $parameter). Time to bye."
+ );
+ exit;
+ }
+
+ my $next_action = pop @$expected_result;
+
+ Test::More::note "Testing (@$expected_result)";
+
+ Test::More::is_deeply( [ $event, $parameter ], $expected_result );
+
+ return $next_action || sub { undef };
+}
+
+sub test_count {
+ return $_[0]{test_count};
+}
+
+sub create_generic_session {
+ my ($self) = @_;
+
+ POE::Session->create(
+ inline_states => {
+ _start => sub { goto $self->next( $_[STATE], 0 ) },
+ _default => sub { goto $self->next( $_[ARG0], 0 ) },
+ }
+ );
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+POE::Test::Sequence - POE test helper to verify a sequence of events
+
+=head1 SYNOPSIS
+
+ Sorry, there isn't a synopsis at this time.
+
+ However, see t/90_regression/whjackson-followtail.t in POE's test
+ suite for a full example.
+
+=head1 DESCRIPTION
+
+POE::Test::Sequence is a test helper that abstracts a lot of the
+tedious trickery needed to verify the relative ordering of events.
+
+With this module, one can test the sequence of events without
+necessarily relying on specific times elapsing between them.
+
+=head2 create_generic_session
+
+The create_generic_session() method creates a POE::Session that routes
+all vents through the POE::Test::Sequence object. It returns the
+POE::Session object, but the test program does not need to store it
+anywhere. In fact, it's recommended not to do that without
+understanding the implications.
+
+The implications can be found in the documentation for POE::Kernel and
+POE::Session.
+
+An example of create_generic_session() can be found in
+POE's t/90_regression/leolo-alarm-adjust.t test program.
+
+=head2 new
+
+Create a new sequence object. Takes named parameter pairs, currently
+just "sequence", which references an array of steps. Each step is an
+array reference containing the expected event, a required parameter to
+that event, and a code reference for the optional next step to take
+after testing for that event.
+
+ my $sequence = POE::Test::Sequence->new(
+ sequence => [
+ [ got_idle_event => 0, sub { append_to_log("text") } ],
+ ...,
+ ]
+ );
+
+next() uses the first two step elements to verify that steps are
+occurring in the order in which they should. The third element is
+returned by next() and is suitable for use as a goto() target. See
+the next() method for more details.
+
+=head2 next
+
+The next() method requires an event name and a scalar parameter.
+These are compared to the first two elements of the next sequence step
+to make sure events are happening in the order in which they should.
+
+ sub handle_start_event {
+ goto $sequence->next("got_start_event", 0);
+ }
+
+=head2 test_count
+
+test_count() returns the number of test steps in the sequence object.
+It's intended to be used for test planning.
+
+ use Test::More;
+ my $sequence = POE::Test::Sequence->new( ... );
+ plan tests => $sequence->test_count();
+
+=head1 BUGS
+
+create_generic_session() is hard-coded to pass only the event name and
+the numeric value 0 to next(). This is fine for only the most generic
+sequences.
+
+=head1 AUTHORS & LICENSING
+
+Please see L<POE> for more information about authors, contributors,
+and POE's licensing.
+
+=cut
+
+# vim: ts=2 sw=2 filetype=perl expandtab
@@ -5,7 +5,7 @@ package POE::Wheel::Curses;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw(croak);
use Curses qw(
@@ -3,7 +3,7 @@ package POE::Wheel::FollowTail;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw( croak carp );
use Symbol qw( gensym );
@@ -27,6 +27,7 @@ sub SELF_UNIQUE_ID () { 8 }
sub SELF_STATE_READ () { 9 }
sub SELF_LAST_STAT () { 10 }
sub SELF_FOLLOW_MODE () { 11 }
+sub SELF_EVENT_IDLE () { 12 }
sub MODE_TIMER () { 0x01 } # Follow on a timer loop.
sub MODE_SELECT () { 0x02 } # Follow via select().
@@ -109,6 +110,7 @@ sub new {
undef, # SELF_STATE_READ
[ (-1) x 8 ], # SELF_LAST_STAT
undef, # SELF_FOLLOW_MODE
+ delete $params{IdleEvent}, # SELF_EVENT_IDLE
], $type;
if (defined $filename) {
@@ -234,6 +236,7 @@ sub _define_select_states {
my $event_input = \$self->[SELF_EVENT_INPUT];
my $event_error = \$self->[SELF_EVENT_ERROR];
my $event_reset = \$self->[SELF_EVENT_RESET];
+ my $event_idle = \$self->[SELF_EVENT_IDLE];
TRACE_POLL and warn "<poll> defining select state";
@@ -279,6 +282,9 @@ sub _define_select_states {
$$event_error and
$k->call($ses, $$event_error, 'read', ($!+0), $!, $unique_id);
}
+ elsif (defined $$event_idle) {
+ $k->call($ses, $$event_idle, $unique_id);
+ }
$k->select_read($$handle => undef);
eval { IO::Handle::clearerr($$handle) }; # could be a globref
@@ -324,6 +330,7 @@ sub _generate_filehandle_timer {
my $event_input = \$self->[SELF_EVENT_INPUT];
my $event_error = \$self->[SELF_EVENT_ERROR];
my $event_reset = \$self->[SELF_EVENT_RESET];
+ my $event_idle = \$self->[SELF_EVENT_IDLE];
$self->[SELF_STATE_READ] = ref($self) . "($unique_id) -> handle timer read";
my $state_read = \$self->[SELF_STATE_READ];
@@ -437,6 +444,9 @@ sub _generate_filehandle_timer {
sysseek($$handle, 0, SEEK_SET);
}
+ elsif (defined $$event_idle) {
+ $k->call($ses, $$event_idle, $unique_id);
+ }
# The file didn't roll. Try again shortly.
@$last_stat = @new_stat;
@@ -461,6 +471,7 @@ sub _generate_filename_timer {
my $event_input = \$self->[SELF_EVENT_INPUT];
my $event_error = \$self->[SELF_EVENT_ERROR];
my $event_reset = \$self->[SELF_EVENT_RESET];
+ my $event_idle = \$self->[SELF_EVENT_IDLE];
$self->[SELF_STATE_READ] = ref($self) . "($unique_id) -> name timer read";
my $state_read = \$self->[SELF_STATE_READ];
@@ -481,6 +492,7 @@ sub _generate_filename_timer {
# Couldn't open yet.
unless ($$handle) {
+ $k->call($ses, $$event_idle, $unique_id) if defined $$event_idle;
$k->delay($$state_read, $poll_interval) if defined $$state_read;
return;
}
@@ -581,6 +593,9 @@ sub _generate_filename_timer {
$k->delay($$state_read, 0) if defined $$state_read;
return;
}
+ elsif (defined $$event_idle) {
+ $k->call($ses, $$event_idle, $unique_id);
+ }
# The file didn't roll. Try again shortly.
@$last_stat = @new_stat;
@@ -614,6 +629,9 @@ sub event {
elsif ($name eq 'ResetEvent') {
$self->[SELF_EVENT_RESET] = $event;
}
+ elsif ($name eq 'IdleEvent') {
+ $self->[SELF_EVENT_IDLE] = $event;
+ }
else {
carp "ignoring unknown FollowTail parameter '$name'";
}
@@ -825,6 +843,15 @@ required, however.
See the L</SYNOPSIS> for an example.
+=head3 IdleEvent
+
+C<IdleEvent> is an optional event. If specified, it will fire
+whenever POE::Wheel::FollowTail checks for activity but sees nothing.
+It was added in POE 1.362 as a way to advance certain test programs
+without needing to wait conservatively large amounts of time.
+
+C<IdleEvent> is described in L</PUBLIC EVENTS>.
+
=head3 InputEvent
The C<InputEvent> parameter is required, and it specifies the event to
@@ -900,6 +927,14 @@ resume watching the file where tell() left off.
POE::Wheel::FollowTail emits a small number of events.
+=head2 IdleEvent
+
+C<IdleEvent> specifies the name of an event to be fired when
+POE::Wheel::FollowTail doesn't detect activity on the watched file.
+
+C<$_[ARG0]> contains the ID of the POE::Wheel::FollowTail object that
+fired the event.
+
=head2 InputEvent
C<InputEvent> sets the name of the event to emit when new data arrives
@@ -3,7 +3,7 @@ package POE::Wheel::ListenAccept;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw( croak carp );
use Symbol qw( gensym );
@@ -5,7 +5,7 @@ use strict;
BEGIN { eval { require bytes } and bytes->import; }
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw( croak carp );
use Symbol qw(gensym);
@@ -3,7 +3,7 @@ package POE::Wheel::ReadWrite;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw( croak carp );
use POE qw(Wheel Driver::SysRW Filter::Line);
@@ -3,7 +3,7 @@ package POE::Wheel::Run;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw(carp croak);
use POSIX qw(
@@ -176,8 +176,14 @@ sub new {
if ($winsize) {
carp "winsize can only be specified for a Conduit of type pty"
- if $conduit ne 'pty' and $winsize;
+ if $conduit !~ /^pty(-pipe)?$/ and $winsize;
+ if( 'ARRAY' eq ref $winsize and 2==@$winsize ) {
+ # Standard VGA cell in 9x16
+ # http://en.wikipedia.org/wiki/VGA-compatible_text_mode#Fonts
+ $winsize->[2] = $winsize->[1]*9;
+ $winsize->[3] = $winsize->[0]*16;
+ }
carp "winsize must be a 4 element arrayref" unless ref($winsize) eq 'ARRAY'
and scalar @$winsize == 4;
@@ -1600,11 +1606,12 @@ Winsize sets the child process' terminal size. Its value should be an
arrayref with four elements. The first two elements must be the
number of lines and columns for the child's terminal window,
respectively. The second pair of elements describe the terminal's X
-and Y dimensions in pixels:
+and Y dimensions in pixels. If the last pair is missing, they will be calculated
+from the lines and columns using a 9x16 cell size.
$_[HEAP]{child} = POE::Wheel::Run->new(
# ... among other things ...
- Winsize => [ 25, 80, 1024, 768 ],
+ Winsize => [ 25, 80, 720, 400 ],
);
Winsize is only valid for conduits that use pseudo-ttys: "pty" and
@@ -3,7 +3,7 @@ package POE::Wheel::SocketFactory;
use strict;
use vars qw($VERSION @ISA);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw( carp croak );
use Symbol qw( gensym );
@@ -51,20 +51,12 @@ sub MY_SOCKET_SELECTED () { 12 }
# If IPv6 support can't be loaded, then provide dummies so the code at
# least compiles. Suggested in rt.cpan.org 27250.
BEGIN {
- # under perl-5.6.2 the warning "leaks" from the eval, while newer versions don't...
- # it's due to Exporter.pm behaving differently, so we have to shut it up
- no warnings 'redefine';
- local *Carp::carp = sub { die @_ };
- # Socket::GetAddrInfo provides getaddrinfo where earlier Perls' Socket don't.
- eval { Socket->import( qw(getaddrinfo getnameinfo) ) };
+ eval { Socket->import( qw(getaddrinfo getnameinfo unpack_sockaddr_in6) ) };
if ($@) {
- # :newapi is legacy, but we include it to be sure in case the user has an old version of GAI
- eval { require Socket::GetAddrInfo; Socket::GetAddrInfo->import( qw(:newapi getaddrinfo getnameinfo) ) };
- if ($@) {
- *getaddrinfo = sub { Carp::confess("Unable to use IPv6: Neither Socket nor Socket::GetAddrInfo provides getaddrinfo()") };
- *getnameinfo = sub { Carp::confess("Unable to use IPv6: Neither Socket nor Socket::GetAddrInfo provides getnameinfo()") };
- }
+ *getaddrinfo = sub { Carp::confess("Unable to use IPv6: Socket doesn't provide getaddrinfo()") };
+ *getnameinfo = sub { Carp::confess("Unable to use IPv6: Socket doesn't provide getnameinfo()") };
+ *unpack_sockaddr_in6 = sub { Carp::confess("Unable to use IPv6: Socket doesn't provide unpack_sockaddr_in6()") };
}
# Socket6 provides AF_INET6 and PF_INET6 where earlier Perls' Socket don't.
@@ -182,15 +174,15 @@ sub _define_accept_state {
if ($peer) {
my ($peer_addr, $peer_port);
if ( $domain eq DOM_UNIX ) {
- $peer_addr = $peer_port = undef;
+ $peer_port = undef;
+ eval { $peer_addr = unpack_sockaddr_un($peer) };
+ $peer_addr = undef if length $@;
}
elsif ( $domain eq DOM_INET ) {
($peer_port, $peer_addr) = unpack_sockaddr_in($peer);
}
elsif ( $domain eq DOM_INET6 ) {
- $peer = getpeername($new_socket);
- ((my $error), $peer_addr, $peer_port) = getnameinfo($peer);
- warn $error if $error;
+ ($peer_addr, $peer_port) = unpack_sockaddr_in6($peer);
}
else {
die "sanity failure: socket domain == $domain";
@@ -287,10 +279,8 @@ sub _define_connect_state {
# UNIX sockets have some trouble with peer addresses.
if ($domain eq DOM_UNIX) {
if (defined $peer) {
- eval {
- $peer_addr = unpack_sockaddr_un($peer);
- };
- undef $peer_addr if length $@;
+ eval { $peer_addr = unpack_sockaddr_un($peer) };
+ $peer_addr = undef if length $@;
}
}
@@ -1245,8 +1235,10 @@ Note: C<AF_INET6> and C<PF_INET6> are supplied by the L<Socket>
module included in Perl 5.8.0 or later. Perl versions before 5.8.0
should not attempt to use IPv6 until someone contributes a workaround.
-IPv6 support requires a 21st century Socket module and the presence of
-Socket::GetAddrInfo to resolve host names to IPv6 addresses.
+IPv6 support requires a Socket module that implements getaddrinfo()
+and unpack_sockaddr_in6(). There may be other modules that perform
+these functions, but most if not all of them have been deprecated with
+the advent of proper core Socket support for IPv6.
=for comment
TODO - Example.
@@ -3,7 +3,7 @@ package POE::Wheel;
use strict;
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use Carp qw(croak);
@@ -6,7 +6,7 @@ use strict;
use Carp qw( croak );
use vars qw($VERSION);
-$VERSION = '1.358'; # NOTE - Should be #.### (three decimal places)
+$VERSION = '1.364'; # NOTE - Should be #.### (three decimal places)
use POE::Resource::Clock qw( monotime time walltime sleep mono2wall wall2mono );
@@ -25,7 +25,7 @@ push @ISA, qw(Exporter);
sub CONFIG_REQUIREMENTS () {
(
- "POE::Test::Loops" => '1.352',
+ "POE::Test::Loops" => '1.358',
);
}
@@ -12,8 +12,16 @@ $POE::Test::Loops::VERSION = "doesn't seem to be installed" if $@;
# idea from Test::Harness, thanks!
diag(
- "Testing POE $POE::VERSION, ",
- "POE::Test::Loops $POE::Test::Loops::VERSION, ",
+ "Testing POE ", ($POE::VERSION || -1), ", ",
+ "POE::Test::Loops ", ($POE::Test::Loops::VERSION || -1), ", ",
"Perl $], ",
"$^X on $^O"
);
+
+# Benchmark the device under test.
+
+my $done = 0;
+my $x = 0;
+$SIG{ALRM} = sub { diag "pogomips: $x"; $done = 1; };
+alarm(1);
+++$x until $done;
@@ -48,6 +48,10 @@ my %special = (
%$default_opts,
trustme => [ qr/^new$/ ],
},
+ 'POE::Filter::HTTPD' => {
+ %$default_opts,
+ trustme => [ qw( headers_as_string encode_value get_one get_one_start get_pending put ) ]
+ },
);
# Get the list of modules
@@ -9,7 +9,7 @@ use lib qw(./mylib ../mylib);
use lib qw(t/10_units/05_filters);
use TestFilter;
-use Test::More tests => 20 + $COUNT_FILTER_INTERFACE;
+use Test::More tests => 34 + $COUNT_FILTER_INTERFACE;
sub POE::Kernel::ASSERT_DEFAULT () { 1 }
@@ -24,6 +24,7 @@ test_filter_interface("POE::Filter::Block");
# Test block filter in fixed-length mode.
{
my $filter = new POE::Filter::Block( BlockSize => 4 );
+ isa_ok( $filter, 'POE::Filter::Block' );
my $raw = $filter->put( [ "12345678" ] );
my $cooked = $filter->get( $raw );
@@ -36,6 +37,7 @@ test_filter_interface("POE::Filter::Block");
# Test block filter with get_one() functions.
{
my $filter = new POE::Filter::Block( BlockSize => 4 );
+ isa_ok( $filter, 'POE::Filter::Block' );
my $raw = $filter->put( [ "12345678" ] );
$filter->get_one_start( $raw );
@@ -50,6 +52,7 @@ test_filter_interface("POE::Filter::Block");
# Test block filter in variable-length mode, without a custom codec.
{
my $filter = new POE::Filter::Block( );
+ isa_ok( $filter, 'POE::Filter::Block' );
my $raw = $filter->put([ "a", "bc", "def", "ghij" ]);
my $cooked = $filter->get( $raw );
@@ -99,6 +102,7 @@ test_filter_interface("POE::Filter::Block");
my $filter = new POE::Filter::Block(
LengthCodec => [ \&encoder, \&decoder ],
);
+ isa_ok( $filter, 'POE::Filter::Block' );
my $raw = $filter->put([ "a", "bc", "def", "ghij" ]);
@@ -141,4 +145,48 @@ test_filter_interface("POE::Filter::Block");
);
}
+# Test param constraints
+{
+ my $filter = eval {
+ new POE::Filter::Block(
+ MaxLength => 10,
+ MaxBuffer => 5 );
+ };
+ ok( $@, "MaxLength must not exceed MaxBuffer" );
+ ok( !$filter, "No object on error" );
+
+ $filter = eval { new POE::Filter::Block( MaxLength => -1 ) };
+ ok( $@, "MaxLength must be positive" );
+
+ $filter = eval { new POE::Filter::Block( MaxLength => 'something' ) };
+ ok( $@, "MaxLength must be a number" );
+
+ $filter = eval { new POE::Filter::Block( MaxBuffer => 0 ) };
+ ok( $@, "MaxBuffer must be positive" );
+
+ $filter = eval { new POE::Filter::Block( MaxBuffer => 'something' ) };
+ ok( $@, "MaxBuffer must be a number" );
+}
+
+# Test MaxLength
+{
+ my $filter = new POE::Filter::Block( MaxLength => 10 );
+ isa_ok( $filter, 'POE::Filter::Block' );
+
+ my $data = "134\0a bunch of data here"; # partial block
+ my $blocks = eval { $filter->get( [ $data ] ) };
+ like( $@, qr/block exceeds/, "Block is to large" );
+}
+
+# Test MaxBuffer
+{
+ my $filter = new POE::Filter::Block( MaxBuffer => 10,
+ MaxLength => 5 );
+ isa_ok( $filter, 'POE::Filter::Block' );
+
+ my $data = "134\0a bunch of data here"; # partial block
+ my $blocks = eval { $filter->get( [ $data ] ) };
+ like( $@, qr/buffer exceeds/, "buffer grew to large" );
+}
+
exit;
@@ -24,7 +24,7 @@ BEGIN {
}
BEGIN {
- plan tests => 112;
+ plan tests => 137;
}
use_ok('POE::Filter::HTTPD');
@@ -408,6 +408,29 @@ SKIP: { # wishlist for supporting get_pending! {{{
is(ref($chunks), 'ARRAY', 'put: returns arrayref');
} # }}}
+SKIP:
+{ # make sure the headers are encoded {{{
+ eval "use utf8";
+ skip "Don't have utf8", 5 if $@;
+
+ my $utf8 = "En \xE9t\xE9";
+ utf8::upgrade( $utf8 );
+ ok( utf8::is_utf8( $utf8 ), "Make sure this is utf8" );
+
+ my $resp = HTTP::Response->new( "200", "OK" );
+ $resp->header( "X-Subject", $utf8 );
+ $resp->content( "\x00\xC3\xE7\xFF\x00" );
+
+ my $filter = POE::Filter::HTTPD->new;
+
+ my $chunks = $filter->put([$resp]);
+ is(ref($chunks), 'ARRAY', 'put: returns arrayref');
+ is( $#$chunks, 0, "One chunk" );
+ ok( !utf8::is_utf8( $chunks->[0] ), "Header was converted to iso-latin-1" );
+ like( $chunks->[0], qr/\x00\xC3\xE7\xFF\x00/, "Content wasn't corrupted" );
+} # }}}
+
+
{ # really, really garbage requests get rejected, but goofy ones accepted {{{
{
my $filter = POE::Filter::HTTPD->new;
@@ -518,3 +541,95 @@ SKIP: { # wishlist for supporting get_pending! {{{
"HEAD with body"
);
} # }}}
+
+
+{ # bad request: POST with a content-length {{{
+ my $filter = POE::Filter::HTTPD->new; # default 1 mb max
+
+ my $req = HTTP::Request->new("POST", "/");
+ $req->protocol('HTTP/1.1');
+
+ $req->header( 'Content-Length' => 1024*1024*1024 ); # 1 GB
+ $req->header( 'Content-Type' => 'text/plain' );
+ $req->content( "Nothing much" ); # but don't put a real 1 GB into content
+ # (yes, the Content-Length is a lie!)
+ my $data = $filter->get( [ $req->as_string ] );
+ isa_ok( $data->[0], 'HTTP::Response' );
+ ok( !$data->[0]->is_success, "Failed" );
+ is( $data->[0]->code, 413, "Content to big" );
+
+ # now try setting a different max size
+ $filter = POE::Filter::HTTPD->new( MaxContent => 10 );
+
+ # make sure it stuck
+ $req->header( 'Content-Length' => 5 );
+ $req->content( "honk\x0a" );
+ $data = $filter->get( [ $req->as_string ] );
+ isa_ok( $data->[0], 'HTTP::Request' );
+ is( $data->[0]->content, "honk\x0a", "Correct content" );
+
+ # make sure it fails
+ $req->header( 'Content-Length' => 15 ); # doesn't take much to go over
+ $req->content( "honk honk honk\x0a" );
+ $data = $filter->get( [ $req->as_string ] );
+ isa_ok( $data->[0], 'HTTP::Response' );
+ is( $data->[0]->code, 413, "Content to big" );
+
+ # now we play with a bad content-length
+ $req->header( 'Content-Length' => 'fifteen' );
+ $data = $filter->get( [ $req->as_string ] );
+ isa_ok( $data->[0], 'HTTP::Response' );
+ is( $data->[0]->code, 400, "Bad request" );
+} # }}}
+
+
+{ # Streaming content upload {{{
+
+ my $filter = POE::Filter::HTTPD->new( Streaming=>1 ); # default 1 mb max
+
+ my $req = HTTP::Request->new("POST", "/");
+ $req->protocol('HTTP/1.1');
+
+ $req->header( 'Content-Length' => 13 );
+ $req->header( 'Content-Type' => 'text/plain' );
+ $req->content( "Nothing much\n" );
+
+ my $data = $filter->get( [ $req->as_string ] );
+ isa_ok( $data->[0], 'HTTP::Request' );
+ is( $data->[0]->content, "", "No content" );
+ is( $data->[1], "Nothing much\n", "The content comes next" );
+} # }}}
+
+# Test param constraints
+{
+ my $filter = eval {
+ new POE::Filter::HTTPD(
+ MaxLength => 10,
+ MaxBuffer => 5 );
+ };
+ ok( $@, "MaxContent must not exceed MaxBuffer" );
+ ok( !$filter, "No object on error" );
+
+ $filter = eval { new POE::Filter::HTTPD( MaxContent => -1 ) };
+ ok( $@, "MaxContent must be positive" );
+
+ $filter = eval { new POE::Filter::HTTPD( MaxContent => 'something' ) };
+ ok( $@, "MaxContent must be a number" );
+
+ $filter = eval { new POE::Filter::HTTPD( MaxBuffer => 0 ) };
+ ok( $@, "MaxBuffer must be positive" );
+
+ $filter = eval { new POE::Filter::HTTPD( MaxBuffer => 'something' ) };
+ ok( $@, "MaxBuffer must be a number" );
+}
+
+# Test MaxBuffer
+{
+ my $filter = new POE::Filter::HTTPD( MaxBuffer => 10,
+ MaxContent => 5 );
+ isa_ok( $filter, 'POE::Filter::HTTPD' );
+
+ my $data = "This line is going to be to long for our filter\n";
+ my $blocks = eval { $filter->get( [ $data ] ) };
+ like( $@, qr/buffer exceeds/, "buffer grew to large" );
+}
@@ -15,7 +15,7 @@ BEGIN {
}
use TestFilter;
-use Test::More tests => 18 + $COUNT_FILTER_INTERFACE + 2*$COUNT_FILTER_STANDARD;
+use Test::More tests => 28 + $COUNT_FILTER_INTERFACE + 2*$COUNT_FILTER_STANDARD;
use_ok("POE::Filter::Line");
test_filter_interface("POE::Filter::Line");
@@ -195,3 +195,47 @@ SKIP: {
"autodetected Unix newlines parsed and reserialized"
);
}
+
+# Test param constraints
+{
+ my $filter = eval {
+ new POE::Filter::Line(
+ MaxLength => 10,
+ MaxBuffer => 5 );
+ };
+ ok( $@, "MaxLength must not exceed MaxBuffer" );
+ ok( !$filter, "No object on error" );
+
+ $filter = eval { new POE::Filter::Line( MaxLength => -1 ) };
+ ok( $@, "MaxLength must be positive" );
+
+ $filter = eval { new POE::Filter::Line( MaxLength => 'something' ) };
+ ok( $@, "MaxLength must be a number" );
+
+ $filter = eval { new POE::Filter::Line( MaxBuffer => 0 ) };
+ ok( $@, "MaxBuffer must be positive" );
+
+ $filter = eval { new POE::Filter::Line( MaxBuffer => 'something' ) };
+ ok( $@, "MaxBuffer must be a number" );
+}
+
+# Test MaxLength
+{
+ my $filter = new POE::Filter::Line( MaxLength => 10 );
+ isa_ok( $filter, 'POE::Filter::Line' );
+
+ my $data = "This line is going to be to long for our filter\n";
+ my $blocks = eval { $filter->get( [ $data ] ) };
+ like( $@, qr/line exceeds/, "Line is to large" );
+}
+
+# Test MaxBuffer
+{
+ my $filter = new POE::Filter::Line( MaxBuffer => 10,
+ MaxLength => 5 );
+ isa_ok( $filter, 'POE::Filter::Line' );
+
+ my $data = "This line is going to be to long for our filter\n";
+ my $blocks = eval { $filter->get( [ $data ] ) };
+ like( $@, qr/buffer exceeds/, "buffer grew to large" );
+}
@@ -34,7 +34,7 @@ BEGIN {
}
BEGIN {
- plan tests => 11 + $COUNT_FILTER_INTERFACE;
+ plan tests => 26 + $COUNT_FILTER_INTERFACE;
}
test_filter_interface('POE::Filter::Reference');
@@ -73,7 +73,7 @@ sub test_freeze_and_thaw {
eval {
# Hide warnings.
local $SIG{__WARN__} = sub { };
- $filter = POE::Filter::Reference->new( $freezer, $compression );
+ $filter = POE::Filter::Reference->new( Serializer=>$freezer, Compession=>$compression );
die "filter not created with freezer=$freezer" unless $filter;
};
@@ -138,4 +138,53 @@ die if $@;
test_freeze_and_thaw('MyOtherFreezer', undef);
test_freeze_and_thaw('MyOtherFreezer', 9 );
+# Test old constructor syntax
+{
+ my $F1 = POE::Filter::Reference->new( 'Storable' );
+ isa_ok( $F1, "POE::Filter::Reference" );
+ my $F2 = POE::Filter::Reference->new( 'Storable', 1 );
+ isa_ok( $F2, "POE::Filter::Reference" );
+
+ my $d1 = $F1->put( [ ['honk honk honk honk'] ] )->[0];
+ my $d2 = $F2->put( [ ['honk honk honk honk'] ] )->[0];
+ isnt( $d1, $d2, "Different outputs with Compression on" );
+ ok( length( $d1 ) > length( $d2 ), "Compressed is (obviously) shorter" );
+
+ $F1 = POE::Filter::Reference->new( undef );
+ isa_ok( $F1, "POE::Filter::Reference" );
+ $F2 = POE::Filter::Reference->new( undef, undef, undef );
+ isa_ok( $F2, "POE::Filter::Reference" );
+
+ $d1 = $F1->put( [ ['honk honk honk honk'] ] )->[0];
+ $d2 = $F2->put( [ ['honk honk honk honk'] ] )->[0];
+ is( $d1, $d2, "Outputs are the same" );
+
+ $F1 = POE::Filter::Reference->new( undef, undef );
+ isa_ok( $F1, "POE::Filter::Reference" );
+ $F2 = POE::Filter::Reference->new( undef, undef, 1 );
+ isa_ok( $F2, "POE::Filter::Reference" );
+
+ $d1 = $F1->put( [ ['honk honk honk honk'] ] )->[0];
+ $d2 = $F2->put( [ ['honk honk honk honk'] ] )->[0];
+ is( $d1, $d2, "Outputs are the same" );
+}
+
+# Test NoFatal
+{
+ my $F1 = POE::Filter::Reference->new( NoFatals => 1 );
+ isa_ok( $F1, "POE::Filter::Reference" );
+
+ my $raw = "12\x00123456789012";
+ my $d = eval { $F1->get( [ $raw ] )->[0] };
+ ok( !$@, "Obvious error didn't explode" );
+ ok( !ref $d, "Instead it returned an error string" );
+
+
+ $F1 = POE::Filter::Reference->new( NoFatals => 1, MaxBuffer => 10 );
+ $d = eval { $F1->get( [ $raw ] )->[0] };
+ ok( !$@, "Buffer error didn't explode" );
+ like( $d, qr/buffer exceeds/, "Instead it returned an error string" );
+
+}
+
exit;
@@ -269,7 +269,6 @@ sub verify_queue {
# Verify that the queue remains in order, and that the adjusted
# priorities are correct.
-print "!!!!!!!! 1\n";
verify_queue(1000);
# Now set priorities to absolute values. The values are
@@ -42,6 +42,7 @@ POE::Component::Server::TCP->new(
my ( $kernel, $heap, $request ) = @_[ KERNEL, HEAP, ARG0 ];
isa_ok( $request, 'HTTP::Message', $request);
ok( $request->uri() eq '/foo/bar', 'Double striped' );
+ POE::Kernel->yield('shutdown');
},
);
@@ -49,9 +50,10 @@ POE::Component::Client::TCP->new (
Alias => 'c0',
RemoteAddress => '127.0.0.1',
RemotePort => $port,
- ServerInput => sub {
- diag("Server Input: $_[ARG0]");
- }
+ ServerInput => sub { fail("client c0 got input from server: $_[ARG0]"); },
+
+ # Silence errors.
+ ServerError => sub { undef },
);
POE::Component::Client::TCP->new (
@@ -62,21 +64,15 @@ POE::Component::Client::TCP->new (
ok 1, 'client connected';
$_[HEAP]->{server}->put( "GET //foo/bar 1.0\015\012\015\012");
},
- ServerInput => sub {
- ok 1, "client got $_[ARG0]";
- }
-);
+ Disconnected => sub {
+ # Shutdown step 2: Kill the server and all remaining connections
+ note "client c1 disconnected";
+ POE::Kernel->signal( s0 => 'KILL' );
+ },
+ ServerInput => sub { fail("client c1 got input from server: $_[ARG0]"); },
-POE::Session->create(
- inline_states => {
- _start => sub {
- $_[KERNEL]->delay_add( done => 3 );
- },
- done => sub {
- $_[KERNEL]->post( $_ => 'shutdown' )
- for qw/ s0 c0 c1 /;
- }
- }
+ # Silence errors.
+ ServerError => sub { undef },
);
$poe_kernel->run();
@@ -1,6 +1,10 @@
#!/usr/bin/perl -w
# vim: ts=2 sw=2 filetype=perl expandtab
+# Make sure that the default behavior for POE::Wheel::FollowTail is to
+# skip to the end of the file when it first starts.
+
+use warnings;
use strict;
sub POE::Kernel::ASSERT_DEFAULT () { 1 }
@@ -12,13 +16,14 @@ use Test::More tests => 2;
my $filename = 'bingos-followtail';
# Using "!" as a newline to avoid differences in opinion about "\n".
+
open FH, ">$filename" or die "$!\n";
FH->autoflush(1);
print FH "moocow - this line should be skipped!";
POE::Session->create(
package_states => [
- 'main' => [qw(_start _input _error _shutdown)],
+ 'main' => [qw(_start _input _error _shutdown _file_is_idle)],
],
inline_states => {
_stop => sub { undef },
@@ -36,8 +41,12 @@ sub _start {
Filename => $heap->{filename},
InputEvent => '_input',
ErrorEvent => '_error',
+ IdleEvent => '_file_is_idle',
);
+
+ $heap->{running} = 1;
$heap->{counter} = 0;
+
print FH "Cows go moo, yes they do!";
close FH;
return;
@@ -54,14 +63,27 @@ sub _input {
# Make sure we got the right line.
is($input, 'Cows go moo, yes they do', 'Got the right line');
ok( ++$heap->{counter} == 1, 'Cows went moo' );
- $kernel->delay( '_shutdown', 5 ); # Wait five seconds.
+ POE::Kernel->delay( _shutdown => 5 );
return;
}
sub _error {
my ($heap,$operation, $errnum, $errstr, $wheel_id) = @_[HEAP,ARG0..ARG3];
diag("Wheel $wheel_id generated $operation error $errnum: $errstr\n");
- delete $heap->{wheel};
+ POE::Kernel->delay( _shutdown => 0.01 );
return;
}
+sub _file_is_idle {
+ return unless $_[HEAP]{counter};
+
+ # At first I thought just a delay( _shutdown => 1 ) would be nice
+ # here, but there's a slight chance that the POE::Wheel::FollowTail
+ # polling interval could refresh this indefinitely.
+ #
+ # So I took the slightly more awkward course of turning off the
+ # shutdown timer and triggering shutdown immediately.
+
+ POE::Kernel->delay(_shutdown => undef);
+ POE::Kernel->yield("_shutdown");
+}
@@ -16,7 +16,7 @@ BEGIN {
}
}
-use Test::More tests => 2;
+use Test::More tests => 3;
my $port;
@@ -41,10 +41,12 @@ POE::Component::Server::TCP->new(
sockaddr_in($_[HEAP]->{listener}->getsockname())
)[0];
},
-
+ Stopped => sub { note "server s0 stopped"; },
ClientInput => sub {
+ # Shutdown step 1: Close client c1's connection after receiving input.
my ( $kernel, $heap, $request ) = @_[ KERNEL, HEAP, ARG0 ];
- isa_ok( $request, 'HTTP::Message', $request);
+ isa_ok( $request, 'HTTP::Message', "server s0 request $request");
+ POE::Kernel->yield( 'shutdown' );
},
);
@@ -52,34 +54,32 @@ POE::Component::Client::TCP->new (
Alias => 'c0',
RemoteAddress => '127.0.0.1',
RemotePort => $port,
- ServerInput => sub {
- diag("Server Input: $_[ARG0]");
- }
+ ServerInput => sub { fail("client c0 got input from server s0: $_[ARG0]") },
+ Connected => sub { note "client c0 connected"; },
+ Disconnected => sub {
+ ok( 3, "client c0 disconnected" );
+ POE::Kernel->post( c0 => 'shutdown' );
+ },
+ # Silence errors.
+ ServerError => sub { undef },
);
POE::Component::Client::TCP->new (
Alias => 'c1',
RemoteAddress => '127.0.0.1',
RemotePort => $port,
+ ServerInput => sub { fail("client c1 got input from server s0: $_[ARG0]") },
Connected => sub {
- ok 1, 'client connected';
+ ok 1, 'client c1 connected';
$_[HEAP]->{server}->put( "GET / 1.0\015\012\015\012");
},
- ServerInput => sub {
- ok 1, "client got $_[ARG0]";
- }
-);
-
-POE::Session->create(
- inline_states => {
- _start => sub {
- $_[KERNEL]->delay_add( done => 3 );
- },
- done => sub {
- $_[KERNEL]->post( $_ => 'shutdown' )
- for qw/ s0 c0 c1 /;
- }
- }
+ Disconnected => sub {
+ # Shutdown step 2: Kill the server and all remaining connections
+ note "client c1 disconnected";
+ POE::Kernel->signal( s0 => 'KILL' );
+ },
+ # Silence errors.
+ ServerError => sub { undef },
);
$poe_kernel->run();
@@ -46,7 +46,7 @@ sub _start_handler {
print $fh "foo\nbar\n";
close $fh or die "close failed: $!";
- $kernel->delay_add('done', 2);
+ $kernel->delay('done', 3);
return;
}
@@ -55,6 +55,7 @@ sub input_handler {
my ($kernel, $line) = @_[KERNEL, ARG0];
my $next = shift @EXPECTED;
is($line, $next);
+ $kernel->delay('done', 1);
return;
}
@@ -1,11 +1,23 @@
#!/usr/bin/perl
# vim: ts=2 sw=2 filetype=perl expandtab
+# This regression test verifies what happens when the following
+# happens in between two polls of a log file:
+#
+# 1. A log file is rolled by being renamed out of the way.
+# 2. The new log is created by appending to the original file location.
+#
+# The desired result is the first log lines are fetched to completion
+# before the new log is opened. No data is lost in this case.
+
use strict;
use warnings;
+sub POE::Kernel::ASSERT_DEFAULT () { 1 }
+
use Test::More;
use POE qw(Wheel::FollowTail);
+use POE::Test::Sequence;
use constant LOG => 'test_log';
use constant OLD_LOG => 'test_log.1';
@@ -21,95 +33,74 @@ use constant OLD_LOG => 'test_log.1';
}
close $fh;
unlink LOG, OLD_LOG;
- plan tests => 10;
}
-my @expected = (
- [ append_to_log => "a" ],
- [ reset_event => 0 ],
- [ got_log => "a" ],
- [ append_to_log => "b" ],
- [ roll_log => 0 ],
- [ append_to_log => "c" ],
- [ got_log => "b" ],
- [ reset_event => 0 ],
- [ got_log => "c" ],
- [ done => 0 ],
+my $sequence = POE::Test::Sequence->new(
+ sequence => [
+ [ got_start_event => 0, sub {
+ $_[HEAP]{wheel} = POE::Wheel::FollowTail->new(
+ InputEvent => 'input_event',
+ ResetEvent => 'reset_event',
+ IdleEvent => 'idle_event',
+ Filename => LOG,
+ PollInterval => 1,
+ );
+ }
+ ],
+ [ got_idle_event => 0, sub { append_to_log("a") } ],
+ [ did_log_append => "a", undef ],
+ [ got_reset_event => 0, undef ], # Initial open is a reset.
+ [ got_input_event => "a", undef ],
+ [ got_idle_event => 0, sub {
+ append_to_log("b");
+ roll_log();
+ append_to_log("c");
+ }
+ ],
+ [ did_log_append => "b", undef ],
+ [ did_log_roll => 0, undef ],
+ [ did_log_append => "c", undef ],
+ [ got_input_event => "b", undef ],
+ [ got_reset_event => 0, undef ],
+ [ got_input_event => "c", sub { append_to_log("d") } ],
+ [ did_log_append => "d", undef ],
+ [ got_input_event => "d", sub { delete $_[HEAP]{wheel} } ],
+ [ got_stop_event => 0, sub {
+ # Clean up test log files, if we can.
+ unlink LOG or die "unlink failed: $!";
+ unlink OLD_LOG or die "unlink failed: $!";
+ }
+ ],
+ ],
);
+plan tests => $sequence->test_count();
+
POE::Session->create(
inline_states => {
- _start => \&_start_handler,
- append_to_log => \&append_to_log,
- roll_log => \&roll_log,
- done => \&done,
-
- # FollowTail events
- input_event => \&input_handler,
- reset_event => \&reset_handler,
+ _start => sub { goto $sequence->next("got_start_event", 0) },
+ _stop => sub { goto $sequence->next("got_stop_event", 0) },
+ input_event => sub { goto $sequence->next("got_input_event", $_[ARG0]) },
+ reset_event => sub { goto $sequence->next("got_reset_event", 0) },
+ idle_event => sub { goto $sequence->next("got_idle_event", 0) },
}
);
POE::Kernel->run();
exit;
-#
-# subs
-#
-
-sub logger {
- my $log_info = [ @_ ];
- my $next = shift @expected;
- is_deeply( $log_info, $next );
- return;
-}
-
-sub _start_handler {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- $heap->{wheel} = POE::Wheel::FollowTail->new(
- InputEvent => 'input_event',
- ResetEvent => 'reset_event',
- Filename => LOG,
- PollInterval => 4,
- );
-
- #
- # what when arg
- #----------------------------------------------
- # poll log file 1
- $kernel->delay_add('append_to_log', 2, 'a');
- # necessary no-op gap 3
- # poll log file 4
- $kernel->delay_add('append_to_log', 5, 'b');
- $kernel->delay_add('roll_log', 6 );
- $kernel->delay_add('append_to_log', 7, 'c');
- # poll log file 8
- $kernel->delay_add('done', 10 );
-
- return;
-}
-
-sub input_handler {
- my ($kernel, $line) = @_[KERNEL, ARG0];
- logger got_log => $line;
- return;
-}
-
-sub reset_handler {
- logger reset_event => 0;
- return;
-}
+# Helpers.
sub roll_log {
- logger roll_log => 0;
+ $sequence->next("did_log_roll", 0);
rename LOG, OLD_LOG or die "rename failed: $!";
return;
}
sub append_to_log {
- my $line = $_[ARG0];
- logger append_to_log => $line;
+ my ($line) = @_;
+
+ $sequence->next("did_log_append", $line);
open my $fh, '>>', LOG or die "open failed: $!";
print {$fh} "$line\n";
@@ -118,19 +109,4 @@ sub append_to_log {
return;
}
-sub done {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- logger done => 0;
-
- # cleanup the test log files
- unlink LOG or die "unlink failed: $!";
- unlink OLD_LOG or die "unlink failed: $!";
-
- # delete the wheel so the POE session can end
- delete $heap->{wheel};
-
- return;
-}
-
1;