POE::Data::Envelope Integration Patch
"Nicholas Perez" <[email protected]>
| Newsgroups | gmane.comp.lang.perl.poe |
|---|---|
| Message-ID | <[email protected]> |
Hola folks, I was wanting this to go in to the 1.0 release, but since it didn't make it not a big deal. Here is the promised integration patch with the POE distribution. It touches the shipped filters, tests, and ReadWrite to accommodate. I've add documentation to explain wtf is going on and also marked it as experimental. I've svk pulled from the trunk, and also tested the patch against a clean check out to verify that everything is kosher. And as always, if you see something that doesn't look right, please let me know. There very well may be follow up patches as I work on my own implementations based on this work and find something that doesn't work as planned. Comments welcome -- Nicholas R. Perez
PDE_Integration.patch
(text/x-diff, 70 KB)
=== t/10_units/05_filters/50_stackable.t
==================================================================
--- t/10_units/05_filters/50_stackable.t (/mirror/poe/trunk/poe) (revision 2611)
+++ t/10_units/05_filters/50_stackable.t (/local/poe/trunk/poe) (revision 2611)
@@ -69,7 +69,7 @@
my $stream = $filter_stack->put( [ $block, $block ] );
is_deeply(
- $stream,
+ [@$stream],
[
"(((test one (1))))!", "(((test four (100))))!",
"(((test one (1))))!", "(((test four (100))))!",
@@ -92,7 +92,7 @@
foreach my $compare (@test_list) {
my $next = $map->get_one();
is_deeply(
- $next, [ "((($compare)))" ],
+ [@$next], [ "((($compare)))" ],
"map filter get_one() returns ((($compare)))"
);
}
=== t/10_units/05_filters/02_grep.t
==================================================================
--- t/10_units/05_filters/02_grep.t (/mirror/poe/trunk/poe) (revision 2611)
+++ t/10_units/05_filters/02_grep.t (/local/poe/trunk/poe) (revision 2611)
@@ -37,8 +37,8 @@
Get => sub { /\d/ },
Put => sub { /[a-zA-Z]/ }
);
- is_deeply($filter->put([qw/A B C 1 2 3/]), [qw/A B C/], "Test Put");
- is_deeply($filter->get([qw/a b c 1 2 3/]), [qw/1 2 3/], "Test Get");
+ is_deeply(\@{$filter->put([qw/A B C 1 2 3/])}, [qw/A B C/], "Test Put");
+ is_deeply(\@{$filter->get([qw/a b c 1 2 3/])}, [qw/1 2 3/], "Test Get");
test_filter_standard(
$filter,
@@ -50,9 +50,9 @@
{ # Test Code
my $filter = POE::Filter::Grep->new(Code => sub { /(\w)/ });
- is_deeply($filter->put([qw/a b c 1 2 3 ! @ /]), [qw/a b c 1 2 3/],
+ is_deeply(\@{$filter->put([qw/a b c 1 2 3 ! @ /])}, [qw/a b c 1 2 3/],
"Test Put (as Code)");
- is_deeply($filter->get([qw/a b c 1 2 3 ! @ /]), [qw/a b c 1 2 3/],
+ is_deeply(\@{$filter->get([qw/a b c 1 2 3 ! @ /])}, [qw/a b c 1 2 3/],
"Test Get (as Code)");
test_filter_standard(
@@ -80,14 +80,14 @@
}
$filter->modify(Get => sub { /\d/ });
- is_deeply($filter->get([qw/a b c 1 2 3/]), [qw/1 2 3/], "Modify Get");
+ is_deeply(\@{$filter->get([qw/a b c 1 2 3/])}, [qw/1 2 3/], "Modify Get");
$filter->modify(Put => sub { /[a-zA-Z]/ });
- is_deeply($filter->put([qw/A B C 1 2 3/]), [qw/A B C/], "Modify Put");
+ is_deeply(\@{$filter->put([qw/A B C 1 2 3/])}, [qw/A B C/], "Modify Put");
$filter->modify(Code => sub { /(\w)/ });
- is_deeply($filter->put([qw/a b c 1 2 3 ! @ /]), [qw/a b c 1 2 3/], "Modify Put (as Code)");
- is_deeply($filter->get([qw/a b c 1 2 3 ! @ /]), [qw/a b c 1 2 3/], "Modify Get (as Code)");
+ is_deeply(\@{$filter->put([qw/a b c 1 2 3 ! @ /])}, [qw/a b c 1 2 3/], "Modify Put (as Code)");
+ is_deeply(\@{$filter->get([qw/a b c 1 2 3 ! @ /])}, [qw/a b c 1 2 3/], "Modify Get (as Code)");
}
# Grep (from stackable's tests) -- testing get_pending
@@ -102,7 +102,8 @@
foreach my $compare (@test_list) {
next unless $compare & 1;
my $next = $grep->get_one();
- is_deeply($next, [ $compare ], "grep filter get_one() returns [$compare]");
+ is_deeply([@$next], [ $compare ],
+ "grep filter get_one() returns [$compare]");
}
my $grep_next = $grep->get_one();
=== t/10_units/05_filters/06_recordblock.t
==================================================================
--- t/10_units/05_filters/06_recordblock.t (/mirror/poe/trunk/poe) (revision 2611)
+++ t/10_units/05_filters/06_recordblock.t (/local/poe/trunk/poe) (revision 2611)
@@ -50,29 +50,29 @@
my $filter = POE::Filter::RecordBlock->new( BlockSize => 3, CheckPut => 1 );
is_deeply(
- $filter->put( [[qw/1 2/], [qw/3 A/]] ),
+ \@{$filter->put( [[qw/1 2/], [qw/3 A/]] )},
[qw/1 2 3/],
"check put on: short blocks"
);
is_deeply(
- $filter->put_pending(),
+ \@{$filter->put_pending()},
[qw/A/],
" put_pending"
);
is_deeply(
- $filter->put( [[qw/2 3 1 2 3/], [qw/1 2 3 B/]] ),
+ \@{$filter->put( [[qw/2 3 1 2 3/], [qw/1 2 3 B/]] )},
[qw/A 2 3 1 2 3 1 2 3/],
"check put on: long blocks"
);
is_deeply(
- $filter->put_pending(),
+ \@{$filter->put_pending()},
[qw/B/],
" put_pending"
);
is_deeply(
- $filter->put( [[qw/2 3 1 2/], [qw/3 1/], [qw/2 3 1/], [qw/2 3/]] ),
+ \@{$filter->put( [[qw/2 3 1 2/], [qw/3 1/], [qw/2 3 1/], [qw/2 3/]] )},
[qw/B 2 3 1 2 3 1 2 3 1 2 3/],
"check put on: mixed blocks"
);
@@ -89,7 +89,7 @@
ok(!$filter->checkput(), "checkput() returns CheckPut flag");
is_deeply(
- $filter->put( [[qw/1 2/], [qw/1 2/]] ),
+ \@{$filter->put( [[qw/1 2/], [qw/1 2/]] )},
[qw/1 2 1 2/],
"check put off: short blocks"
);
@@ -97,13 +97,13 @@
ok(!defined($filter->put_pending()), " put_pending is empty");
is_deeply(
- $filter->put( [[qw/1 2 3 4 5/], [qw/1 2 3 4/]] ),
+ \@{$filter->put( [[qw/1 2 3 4 5/], [qw/1 2 3 4/]] )},
[qw/1 2 3 4 5 1 2 3 4/],
"check put off: long blocks"
);
is_deeply(
- $filter->put( [[qw/1 2 3 4/], [qw/1 2/], [qw/1 2 3/], [qw/1 2/]] ),
+ \@{$filter->put( [[qw/1 2 3 4/], [qw/1 2/], [qw/1 2 3/], [qw/1 2/]] )},
[qw/1 2 3 4 1 2 1 2 3 1 2/],
"check put off: mixed blocks"
);
=== t/10_units/05_filters/TestFilter.pm
==================================================================
--- t/10_units/05_filters/TestFilter.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ t/10_units/05_filters/TestFilter.pm (/local/poe/trunk/poe) (revision 2611)
@@ -65,7 +65,7 @@
my @records;
my $ret_arrayref = 1;
GET_ONE: while (my $r = $filter->get_one()) {
- unless (ref($r) eq 'ARRAY') {
+ unless (ref($r) eq 'ARRAY' or ref($r) eq 'POE::Data::Envelope') {
$ret_arrayref = 0;
last GET_ONE;
}
@@ -80,7 +80,7 @@
{ # third using put()
my $chunks = $filter->put($out);
- is_deeply($chunks, $put, "put [standard test]");
+ is_deeply([@$chunks], $put, "put [standard test]");
}
}
=== t/10_units/05_filters/03_http.t
==================================================================
--- t/10_units/05_filters/03_http.t (/mirror/poe/trunk/poe) (revision 2611)
+++ t/10_units/05_filters/03_http.t (/local/poe/trunk/poe) (revision 2611)
@@ -44,7 +44,7 @@
my ($data, $code, $label) = @_;
ok(
- (ref($data) eq 'ARRAY') &&
+ (ref([@$data]) eq 'ARRAY') &&
(scalar(@$data) == 1) &&
($$data[0]->code == $code),
$label
@@ -59,7 +59,7 @@
HTTP::Request->new('GET', 'http://localhost/pie.mhtml');
my $records = $filter->get([ $get_request->as_string ]);
- is(ref($records), 'ARRAY', 'simple get: get() returns list of requests');
+ is(ref([@$records]), 'ARRAY', 'simple get: get() returns list of requests');
is(scalar(@$records), 1, 'simple get: get() returned single request');
my ($req) = @$records;
@@ -84,7 +84,7 @@
|;
my $data = $filter->get([ $get_data ]);
- is(ref $data, 'ARRAY', 'HTTP 1.0 get: get() returns list of requests');
+ is(ref [@$data], 'ARRAY', 'HTTP 1.0 get: get() returns list of requests');
is(scalar @$data, 1, 'HTTP 1.0 get: get() returned single request');
my ($req) = @$data;
@@ -115,7 +115,7 @@
my $filter = POE::Filter::HTTPD->new();
my $data = $filter->get([ $post_request->as_string ]);
- is(ref $data, 'ARRAY', 'simple post: get() returns list of requests');
+ is(ref [@$data], 'ARRAY', 'simple post: get() returns list of requests');
is(scalar @$data, 1, 'simple post: get() returned single request');
my ($req) = @$data;
@@ -160,7 +160,7 @@
my $filter = POE::Filter::HTTPD->new();
my $data = $filter->get([ $head_request->as_string ]);
- is(ref $data, 'ARRAY', 'simple head: get() returns list of requests');
+ is(ref [@$data], 'ARRAY', 'simple head: get() returns list of requests');
is(scalar @$data, 1, 'simple head: get() returned single request');
my ($req) = @$data;
@@ -182,7 +182,7 @@
my $filter = POE::Filter::HTTPD->new();
my $data = $filter->get([ $put_request->as_string ]);
- is(ref $data, 'ARRAY', 'simple put: get() returns list of requests');
+ is(ref [@$data], 'ARRAY', 'simple put: get() returns list of requests');
is(scalar @$data, 1, 'simple put: get() returned single request');
my ($req) = @$data;
@@ -206,7 +206,7 @@
my $filter = POE::Filter::HTTPD->new();
my $data = $filter->get([ $request->as_string ]);
- is(ref $data, 'ARRAY', 'multipart form data: get() returns list of requests');
+ is(ref [@$data], 'ARRAY', 'multipart form data: get() returns list of requests');
is(scalar @$data, 1, 'multipart form data: get() returned single request');
my ($req) = @$data;
@@ -244,7 +244,7 @@
my $filter = POE::Filter::HTTPD->new();
my $data = $filter->get([ $request->as_string ]);
- is(ref $data, 'ARRAY', 'options: get() returns list of requests');
+ is(ref [@$data], 'ARRAY', 'options: get() returns list of requests');
is(scalar @$data, 1, 'options: get() returned single request');
my ($req) = @$data;
@@ -318,7 +318,7 @@
{
my $filter = POE::Filter::HTTPD->new;
my $data = $filter->get([ $req->as_string . "\r\n \r\n\n" ]);
- is(ref($data), 'ARRAY', 'trailing: whitespace in block: ref');
+ is(ref([@$data]), 'ARRAY', 'trailing: whitespace in block: ref');
is(scalar(@$data), 1, 'trailing: whitespace in block: one req');
isa_ok($$data[0], 'HTTP::Request',
'trailing: whitespace in block: HTTP::Request');
@@ -332,7 +332,7 @@
{
my $filter = POE::Filter::HTTPD->new;
my $data = $filter->get([ $req->as_string . "GARBAGE!" ]);
- is(ref($data), 'ARRAY', 'trailing: garbage in block: ref');
+ is(ref([@$data]), 'ARRAY', 'trailing: garbage in block: ref');
is(scalar(@$data), 1, 'trailing: garbage in block: one req');
isa_ok($$data[0], 'HTTP::Request',
'trailing: garbage in block: HTTP::Request');
@@ -346,7 +346,7 @@
{
my $filter = POE::Filter::HTTPD->new;
my $data = $filter->get([ $req->as_string, "\r\n \r\n\n" ]);
- is(ref($data), 'ARRAY', 'trailing: extra whitespace packet: ref');
+ is(ref([@$data]), 'ARRAY', 'trailing: extra whitespace packet: ref');
is(scalar(@$data), 1, 'trailing: extra whitespace packet: one req');
isa_ok($$data[0], 'HTTP::Request',
'trailing: extra whitespace packet: HTTP::Request');
@@ -361,7 +361,7 @@
my $filter = POE::Filter::HTTPD->new;
$filter->get([ $req->as_string ]); # assume this one is fine
my $data = $filter->get([ "\r\n \r\n\n" ]);
- is(ref($data), 'ARRAY', 'trailing: extra whitespace get: ref');
+ is(ref([@$data]), 'ARRAY', 'trailing: extra whitespace get: ref');
is(scalar(@$data), 1, 'trailing: extra whitespace get: no req');
}
@@ -390,7 +390,7 @@
use Carp;
$SIG{__DIE__} = \&Carp::croak;
my $chunks = $filter->put([$res]);
- is(ref($chunks), 'ARRAY', 'put: returns arrayref');
+ is(ref([@$chunks]), 'ARRAY', 'put: returns arrayref');
} # }}}
{ # really, really garbage requests get rejected, but goofy ones accepted {{{
=== t/10_units/05_filters/05_map.t
==================================================================
--- t/10_units/05_filters/05_map.t (/mirror/poe/trunk/poe) (revision 2611)
+++ t/10_units/05_filters/05_map.t (/local/poe/trunk/poe) (revision 2611)
@@ -32,12 +32,12 @@
my $filter;
# Test actual mapping of Get, Put, and Code
$filter = POE::Filter::Map->new( Get => sub { uc }, Put => sub { lc } );
-is_deeply($filter->put([qw/A B C/]), [qw/a b c/], "Test Put");
-is_deeply($filter->get([qw/a b c/]), [qw/A B C/], "Test Get");
+is_deeply(\@{$filter->put([qw/A B C/])}, [qw/a b c/], "Test Put");
+is_deeply(\@{$filter->get([qw/a b c/])}, [qw/A B C/], "Test Get");
$filter = POE::Filter::Map->new(Code => sub { uc });
-is_deeply($filter->put([qw/a b c/]), [qw/A B C/], "Test Put (as Code)");
-is_deeply($filter->get([qw/a b c/]), [qw/A B C/], "Test Get (as Code)");
+is_deeply(\@{$filter->put([qw/a b c/])}, [qw/A B C/], "Test Put (as Code)");
+is_deeply(\@{$filter->get([qw/a b c/])}, [qw/A B C/], "Test Get (as Code)");
$filter = POE::Filter::Map->new( Get => sub { 'GET' }, Put => sub { 'PUT' } );
@@ -58,11 +58,11 @@
}
$filter->modify(Get => sub { 'NGet' });
-is_deeply($filter->get(['a']), ['NGet'], "Modify Get");
+is_deeply(\@{$filter->get(['a'])}, ['NGet'], "Modify Get");
$filter->modify(Put => sub { 'NPut' });
-is_deeply($filter->put(['a']), ['NPut'], "Modify Put");
+is_deeply(\@{$filter->put(['a'])}, ['NPut'], "Modify Put");
$filter->modify(Code => sub { 'NCode' });
-is_deeply($filter->put(['a']), ['NCode'], "Modify Code ");
-is_deeply($filter->get(['a']), ['NCode'], "Modify Code ");
+is_deeply(\@{$filter->put(['a'])}, ['NCode'], "Modify Code ");
+is_deeply(\@{$filter->get(['a'])}, ['NCode'], "Modify Code ");
=== t/10_units/05_filters/08_stream.t
==================================================================
--- t/10_units/05_filters/08_stream.t (/mirror/poe/trunk/poe) (revision 2611)
+++ t/10_units/05_filters/08_stream.t (/local/poe/trunk/poe) (revision 2611)
@@ -32,14 +32,14 @@
# Specific tests for stream filter
{ my $received = $filter->get( \@test_fodder );
ok(
- eq_array($received, [ 'abcdefghijklmno' ]),
+ eq_array([@$received], [ 'abcdefghijklmno' ]),
"received combined test items"
);
}
{ my $sent = $filter->put( \@test_fodder );
ok(
- eq_array($sent, \@test_fodder),
+ eq_array([@$sent], \@test_fodder),
"sent each item discretely"
);
}
@@ -50,21 +50,21 @@
{ my $pending = $filter->get_pending();
ok(
- eq_array($pending, [ 'abcdefghijklmno' ]),
+ eq_array([@$pending], [ 'abcdefghijklmno' ]),
"pending data is correct"
);
}
{ my $received = $filter->get_one();
ok(
- eq_array($received, [ 'abcdefghijklmno' ]),
+ eq_array([@$received], [ 'abcdefghijklmno' ]),
"get_one() got the right one, baby, uh-huh"
);
}
{ my $received = $filter->get_one();
ok(
- eq_array($received, [ ]),
+ eq_array([@$received], [ ]),
"get_one() returned an empty array on empty buffer"
);
}
=== t/10_units/05_filters/07_reference.t
==================================================================
--- t/10_units/05_filters/07_reference.t (/mirror/poe/trunk/poe) (revision 2611)
+++ t/10_units/05_filters/07_reference.t (/local/poe/trunk/poe) (revision 2611)
@@ -86,7 +86,7 @@
$freezer = "undefined" unless defined $freezer;
is_deeply(
- $got,
+ [@$got],
[ $scalar_ref, $object_ref ],
"$freezer successfully froze and thawed"
);
@@ -114,7 +114,7 @@
my $pending_thing = $pending_filter->get($pending_filter->get_pending());
is_deeply(
- $pending_thing, [ [ 2, 4, 6 ], [ 2, 4, 6 ] ],
+ [@$pending_thing], [ [ 2, 4, 6 ], [ 2, 4, 6 ] ],
"filter reports proper pending data"
);
=== t/10_units/05_filters/01_block.t
==================================================================
--- t/10_units/05_filters/01_block.t (/mirror/poe/trunk/poe) (revision 2611)
+++ t/10_units/05_filters/01_block.t (/local/poe/trunk/poe) (revision 2611)
@@ -28,7 +28,7 @@
is_deeply($cooked, [ "1234", "5678" ], "get() parses blocks");
my $reraw = $filter->put( $cooked );
- is_deeply($reraw, [ "12345678" ], "put() serializes blocks");
+ is_deeply([@$reraw], [ "12345678" ], "put() serializes blocks");
}
# Test block filter with get_one() functions.
@@ -39,10 +39,10 @@
$filter->get_one_start( $raw );
my $cooked = $filter->get_one();
- is_deeply($cooked, [ "1234" ], "get_one() parsed one block");
+ is_deeply([@$cooked], [ "1234" ], "get_one() parsed one block");
my $reraw = $filter->put( $cooked );
- is_deeply($reraw, [ "1234" ], "put() serialized one block");
+ is_deeply([@$reraw], [ "1234" ], "put() serialized one block");
}
# Test block filter in variable-length mode, without a custom codec.
@@ -52,7 +52,7 @@
my $cooked = $filter->get( $raw );
is_deeply(
- $cooked, [ "a", "bc", "def", "ghij" ],
+ [@$cooked], [ "a", "bc", "def", "ghij" ],
"get() parsed variable blocks"
);
@@ -69,11 +69,11 @@
ok(!@$cooked, "get() doesn't return for partial input payload");
$cooked = $filter->get( [ "pqrst" ] );
- is_deeply($cooked, [ "klmnopqrst" ], "get() returns payload");
+ is_deeply([@$cooked], [ "klmnopqrst" ], "get() returns payload");
my $raw_two = $filter->put( [ qw(a bc def ghij) ] );
is_deeply(
- $raw_two, [ "1\0a", "2\0bc", "3\0def", "4\0ghij" ],
+ [@$raw_two], [ "1\0a", "2\0bc", "3\0def", "4\0ghij" ],
"variable length put() serializes multiple blocks"
);
}
@@ -102,8 +102,8 @@
my $cooked = $filter->get( $raw );
is_deeply(
- $cooked, [ "a", "bc", "def", "ghij" ],
- "customi serializer parsed its own serialized data"
+ [@$cooked], [ "a", "bc", "def", "ghij" ],
+ "custom serializer parsed its own serialized data"
);
$cooked = $filter->get( [ "\x00" ] );
@@ -123,13 +123,13 @@
$cooked = $filter->get( [ "pqrst" ] );
is_deeply(
- $cooked, [ "klmnopqrst" ],
+ [@$cooked], [ "klmnopqrst" ],
"custom serializer parsed full payload"
);
my $raw_two = $filter->put( [ qw(a bc def ghij) ] );
is_deeply(
- $raw_two, [
+ [@$raw_two], [
"\x00\x00\x00\x01a",
"\x00\x00\x00\x02bc",
"\x00\x00\x00\x03def",
=== t/10_units/05_filters/04_line.t
==================================================================
--- t/10_units/05_filters/04_line.t (/mirror/poe/trunk/poe) (revision 2611)
+++ t/10_units/05_filters/04_line.t (/local/poe/trunk/poe) (revision 2611)
@@ -67,13 +67,13 @@
my $received = $filter->get( [ "axa", "bxb", "cxc", "dxd" ] );
is_deeply(
- $received, [ "a", "ab", "bc", "cd" ],
+ [@$received], [ "a", "ab", "bc", "cd" ],
"different literals parsed input",
);
my $sent = $filter->put( $received );
is_deeply(
- $sent, [ "ay", "aby", "bcy", "cdy" ],
+ [@$sent], [ "ay", "aby", "bcy", "cdy" ],
"different literals serialized output"
);
}
@@ -89,13 +89,13 @@
my $received = $filter->get( [ "axa", "byb", "cxc", "dyd" ] );
is_deeply(
- $received, [ "a", "ab", "bc", "cd" ],
+ [@$received], [ "a", "ab", "bc", "cd" ],
"regexp parser parsed input"
);
my $sent = $filter->put( $received );
is_deeply(
- $sent, [ "a!", "ab!", "bc!", "cd!" ],
+ [@$sent], [ "a!", "ab!", "bc!", "cd!" ],
"regexp parser serialized output"
);
}
@@ -114,13 +114,13 @@
my $received = $filter->get( [ "axa", "byb", "cxc", "dyd" ] );
is_deeply(
- $received, [ "a", "ab", "bc", "cd" ],
+ [@$received], [ "a", "ab", "bc", "cd" ],
"compiled regexp parser parsed input"
);
my $sent = $filter->put( $received );
is_deeply(
- $sent, [ "a!", "ab!", "bc!", "cd!" ],
+ [@$sent], [ "a!", "ab!", "bc!", "cd!" ],
"compiled regexp parser serialized output"
);
}
@@ -142,7 +142,7 @@
my $sent = $filter->put( \@received );
is_deeply(
- $sent,
+ [@$sent],
[ "a!", "b!", "c\x0A!" ],
"autodetected MacOS newlines parsed and reserialized",
);
@@ -165,7 +165,7 @@
my $sent = $filter->put( \@received );
is_deeply(
- $sent,
+ [@$sent],
[ "a!", "\x0Db!", "c\x0D!" ],
"autodetected network newline parsed and reserialized"
);
@@ -188,7 +188,7 @@
my $sent = $filter->put( \@received );
is_deeply(
- $sent,
+ [@$sent],
[ "a!", "b\x0D!", "c\x0D!" ],
"autodetected Unix newlines parsed and reserialized"
);
=== lib/POE/Filter/Line.pm
==================================================================
--- lib/POE/Filter/Line.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Filter/Line.pm (/local/poe/trunk/poe) (revision 2611)
@@ -4,6 +4,7 @@
use strict;
use POE::Filter;
+use POE::Data::Envelope;
use vars qw($VERSION @ISA);
$VERSION = do {my($r)=(q$Revision$=~/(\d+)/);sprintf"1.%04d",$r};
@@ -17,6 +18,7 @@
sub INPUT_REGEXP () { 1 }
sub OUTPUT_LITERAL () { 2 }
sub AUTODETECT_STATE () { 3 }
+sub CURRENT_ENV () { 4 }
sub AUTO_STATE_DONE () { 0x00 }
sub AUTO_STATE_FIRST () { 0x01 }
@@ -96,10 +98,11 @@
if scalar keys %params;
my $self = bless [
- '', # FRAMING_BUFFER
- $input_regexp, # INPUT_REGEXP
- $output_literal, # OUTPUT_LITERAL
- $autodetect, # AUTODETECT_STATE
+ '', # FRAMING_BUFFER
+ $input_regexp, # INPUT_REGEXP
+ $output_literal, # OUTPUT_LITERAL
+ $autodetect, # AUTODETECT_STATE
+ POE::Data::Envelope->new(), # CURRENT_ENV
], $type;
DEBUG and warn join ':', @$self;
@@ -117,7 +120,15 @@
sub get_one_start {
my ($self, $stream) = @_;
+
+ if(UNIVERSAL::isa($stream, 'POE::Data::Envelope')) {
+ $self->[CURRENT_ENV] = $stream;
+ }
+ else {
+ $self->[CURRENT_ENV] = POE::Data::Envelope->new();
+ }
+
DEBUG and do {
my $temp = join '', @$stream;
$temp = unpack 'H*', $temp;
@@ -141,8 +152,12 @@
last LINE
unless $self->[FRAMING_BUFFER] =~ s/^(.*?)$self->[INPUT_REGEXP]//s;
DEBUG and warn "got line: <<", unpack('H*', $1), ">>\n";
-
- return [ $1 ];
+
+ my $envelope = $self->[CURRENT_ENV]->clone();
+ $envelope->data( [ $1 ] );
+ push( @{ $envelope->oob() }, length( $self->[FRAMING_BUFFER] ) );
+ $envelope->error( 0 );
+ return $envelope;
}
# Waiting for the first line ending. Look for a generic newline.
@@ -171,15 +186,28 @@
$self->[INPUT_REGEXP] = $2;
$self->[AUTODETECT_STATE] = AUTO_STATE_SECOND;
}
+
+ my $envelope = $self->[CURRENT_ENV]->clone();
+ $envelope->data( [ $line ] );
+ push( @{ $envelope->oob() }, length( $self->[FRAMING_BUFFER] ) );
+ $envelope->error( 0 );
- return [ $line ];
+ return $envelope;
}
# Waiting for the second line beginning. Bail out if we don't
# have anything in the framing buffer.
if ($self->[AUTODETECT_STATE] & AUTO_STATE_SECOND) {
- return [ ] unless length $self->[FRAMING_BUFFER];
+ if (! length( $self->[FRAMING_BUFFER] )) {
+
+ my $envelope = $self->[CURRENT_ENV]->clone();
+ push( @{ $envelope->oob() }, 0 );
+ $envelope->error( 0 );
+
+ return $envelope;
+ }
+
# Test the first character to see if it completes the previous
# potentially partial newline.
if (
@@ -205,11 +233,18 @@
$self->[AUTODETECT_STATE] = AUTO_STATE_DONE;
next LINE;
}
-
- die "consistency error: AUTODETECT_STATE = $self->[AUTODETECT_STATE]";
+
+ my $envelope = $self->[CURRENT_ENV]->clone();
+ $envelope->error('consistency error: AUTODETECT_STATE = ' .
+ $self->[AUTODETECT_STATE]);
+
+ return $envelope;
}
-
- return [ ];
+
+ my $envelope = $self->[CURRENT_ENV]->clone();;
+ push( @{ $envelope->oob() }, length( $self->[FRAMING_BUFFER] ) );
+ $envelope->error( 0 );
+ return $envelope;
}
#------------------------------------------------------------------------------
@@ -226,8 +261,25 @@
foreach (@$lines) {
push @raw, $_ . $self->[OUTPUT_LITERAL];
}
+
+ my $processed;
- \@raw;
+ # If we have an Envelope object, push the processed lines into it
+ # and also pop off the last oob since it should be ours
+ if(UNIVERSAL::isa($lines, 'POE::Data::Envelope')) {
+ $processed = $lines;
+ }
+
+ # Otherwise we need to wrap the processed lines in the stored envelope
+ # so previous OOB messages get back to their owners
+ else {
+ $processed = $self->[CURRENT_ENV]->clone();
+ }
+
+ $processed->data(\@raw);
+ pop( @{ $processed->oob() } ) if @{ $processed->oob() };
+
+ return $processed;
}
#------------------------------------------------------------------------------
@@ -250,10 +302,10 @@
=head1 SYNOPSIS
$filter = POE::Filter::Line->new();
- $arrayref_of_lines =
+ $poe_data_envelope_of_lines =
$filter->get($arrayref_of_raw_chunks_from_driver);
- $arrayref_of_streamable_chunks_for_driver =
- $filter->put($arrayref_of_lines);
+ $poe_data_envelope_of_streamable_chunks_for_driver =
+ $filter->put($roe_data_envelope_of_lines);
$arrayref_of_leftovers =
$filter->get_pending();
@@ -299,6 +351,13 @@
Outgoing lines have traditional network newlines (CRLF) appended to
them by default.
+The POE::Data::Evenlope objects returned have the following properties:
+
+ oob(): the top of the OOB stack will contain the number of lines in the
+ framing buffer.
+
+ error(): if an inconsistent state occured, this will contain a message
+
=head1 PUBLIC FILTER METHODS
Please see POE::Filter.
=== lib/POE/Filter/RecordBlock.pm
==================================================================
--- lib/POE/Filter/RecordBlock.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Filter/RecordBlock.pm (/local/poe/trunk/poe) (revision 2611)
@@ -4,6 +4,7 @@
use strict;
use POE::Filter;
+use POE::Data::Envelope;
use vars qw($VERSION @ISA);
$VERSION = do {my($r)=(q$Revision$=~/(\d+)/);sprintf"1.%04d",$r};
@@ -11,10 +12,11 @@
use Carp qw(croak);
-sub BLOCKSIZE () { 0 };
-sub GETBUFFER () { 1 };
-sub PUTBUFFER () { 2 };
-sub CHECKPUT () { 3 };
+sub BLOCKSIZE () { 0 };
+sub GETBUFFER () { 1 };
+sub PUTBUFFER () { 2 };
+sub CHECKPUT () { 3 };
+sub CURRENT_ENV () { 4 };
#------------------------------------------------------------------------------
@@ -29,20 +31,22 @@
);
my $self = bless [
- $params{BlockSize}, # BLOCKSIZE
- [], # GETBUFFER
- [], # PUTBUFFER
- $params{CheckPut}, # CHECKPUT
+ $params{BlockSize}, # BLOCKSIZE
+ [], # GETBUFFER
+ [], # PUTBUFFER
+ $params{CheckPut}, # CHECKPUT
+ POE::Data::Envelope->new(), # CURRENT_ENV
], $type;
}
sub clone {
my $self = shift;
my $clone = bless [
- $self->[0], # BLOCKSIZE
- [], # GETBUFFER
- [], # PUTBUFFER
- $self->[3], # CHECKPUT
+ $self->[0], # BLOCKSIZE
+ [], # GETBUFFER
+ [], # PUTBUFFER
+ $self->[3], # CHECKPUT
+ POE::Data::Envelope->new(), # CURRENT_ENV
], ref $self;
$clone;
}
@@ -55,15 +59,31 @@
# changing and make input flow control possible.
sub get_one_start {
- my ($self, $data) = @_;
- push @{$self->[GETBUFFER]}, @$data;
+ my ($self, $stream) = @_;
+
+ if(UNIVERSAL::isa($stream, 'POE::Data::Envelope')) {
+ $self->[CURRENT_ENV] = $stream;
+ }
+
+ else {
+ $self->[CURRENT_ENV] = POE::Data::Envelope->new();
+ }
+
+ push( @{$self->[GETBUFFER]}, @$stream ) if defined $stream;
}
sub get_one {
my $self = shift;
+
+ my $env = $self->[CURRENT_ENV]->clone();
+
+ if(@{$self->[GETBUFFER]} >= $self->[BLOCKSIZE]) {
+ $env->data([ [ splice @{$self->[GETBUFFER]}, 0, $self->[BLOCKSIZE] ] ]);
+ }
- return [ ] unless @{$self->[GETBUFFER]} >= $self->[BLOCKSIZE];
- return [ [ splice @{$self->[GETBUFFER]}, 0, $self->[BLOCKSIZE] ] ];
+ push( @{ $env->oob() }, scalar( @{ $self->[GETBUFFER] } ) );
+
+ return $env;
}
#------------------------------------------------------------------------------
@@ -86,7 +106,21 @@
push @result, @$_;
}
}
- \@result;
+
+ my $processed;
+
+ if(UNIVERSAL::isa($data, 'POE::Data::Envelope')) {
+ $processed = $data;
+ }
+
+ else {
+ $processed = $self->[CURRENT_ENV]->clone();
+ }
+
+ $processed->data( \@result );
+ pop( @{ $processed->oob() } ) if @{ $processed->oob() };
+
+ return $processed;
}
#------------------------------------------------------------------------------
=== lib/POE/Filter/Stackable.pm
==================================================================
--- lib/POE/Filter/Stackable.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Filter/Stackable.pm (/local/poe/trunk/poe) (revision 2611)
@@ -18,6 +18,7 @@
use Carp qw(croak);
sub FILTERS () { 0 }
+sub STARTING_DATA () { 1 }
#------------------------------------------------------------------------------
@@ -56,6 +57,7 @@
sub get_one_start {
my ($self, $data) = @_;
$self->[FILTERS]->[0]->get_one_start($data);
+ $self->[STARTING_DATA] = $data;
}
# RCC 2005-06-28: get_one() needs to strobe through all the filters
@@ -74,17 +76,44 @@
while (!@$return) {
my $exchanged = 0;
+ my $filtercount = 0;
foreach my $filter (@{$self->[FILTERS]}) {
-
+ my $filter_input = [];
# If we have something to input to the next filter, do that.
if (@$return) {
+ $filter_input = [@$return];
$filter->get_one_start($return);
$exchanged++;
}
# Get what we can from the current filter.
$return = $filter->get_one();
+
+ # Check if the return is an Envelope object
+ if(UNIVERSAL::isa($return, 'POE::Data::Envelope')) {
+ # And check if it reports an error
+ if($return->error())
+ {
+ my $status = {};
+ $status->{'FILTER_COUNT'} = $filtercount;
+ $status->{'FILTER_REF'} = \$filter;
+ $status->{'INITIAL_DATA'} = $self->[STARTING_DATA];
+ $status->{'FILTER_INPUT'} = '';
+
+ if($exchanged){
+ $status->{'FILTER_INPUT'} = $filter_input;
+ }
+
+ # Package up the current state of Stackable
+ push @{ $return->oob() }, $status;
+
+ # And immediately let the application know
+ return $return;
+ }
+ }
+
+ $filtercount++;
}
last unless $exchanged;
=== lib/POE/Filter/Block.pm
==================================================================
--- lib/POE/Filter/Block.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Filter/Block.pm (/local/poe/trunk/poe) (revision 2611)
@@ -4,6 +4,7 @@
use strict;
use POE::Filter;
+use POE::Data::Envelope;
use vars qw($VERSION @ISA);
$VERSION = do {my($r)=(q$Revision$=~/(\d+)/);sprintf"1.%04d",$r};
@@ -16,6 +17,7 @@
sub EXPECTED_SIZE () { 2 }
sub ENCODER () { 3 }
sub DECODER () { 4 }
+sub CURRENT_ENV () { 5 }
#------------------------------------------------------------------------------
@@ -68,11 +70,12 @@
}
my $self = bless [
- '', # FRAMING_BUFFER
- $block_size, # BLOCK_SIZE
- undef, # EXPECTED_SIZE
- $encoder, # ENCODER
- $decoder, # DECODER
+ '', # FRAMING_BUFFER
+ $block_size, # BLOCK_SIZE
+ undef, # EXPECTED_SIZE
+ $encoder, # ENCODER
+ $decoder, # DECODER
+ POE::Data::Envelope->new(), # CURRENT_ENV
], $type;
$self;
@@ -89,6 +92,15 @@
sub get_one_start {
my ($self, $stream) = @_;
+
+ if(UNIVERSAL::isa($stream, 'POE::Data::Envelope')) {
+ $self->[CURRENT_ENV] = $stream;
+ }
+
+ else {
+ $self->[CURRENT_ENV] = POE::Data::Envelope->new();
+ }
+
$self->[FRAMING_BUFFER] .= join '', @$stream;
}
@@ -102,33 +114,55 @@
# bytes.
if (defined $self->[BLOCK_SIZE]) {
- return [ ] unless length($self->[FRAMING_BUFFER]) >= $self->[BLOCK_SIZE];
- my $block = substr($self->[FRAMING_BUFFER], 0, $self->[BLOCK_SIZE]);
- substr($self->[FRAMING_BUFFER], 0, $self->[BLOCK_SIZE]) = '';
- return [ $block ];
+ my $env = $self->[CURRENT_ENV]->clone();
+
+ if(length($self->[FRAMING_BUFFER]) < $self->[BLOCK_SIZE]) {
+ push( @{ $env->oob() }, length($self->[FRAMING_BUFFER]) );
+ $env->error( 0 );
+ }
+
+ else {
+ my $block = substr($self->[FRAMING_BUFFER], 0, $self->[BLOCK_SIZE]);
+ substr($self->[FRAMING_BUFFER], 0, $self->[BLOCK_SIZE]) = '';
+ $env->data( [ $block ] );
+ push( @{ $env->oob() }, length($self->[FRAMING_BUFFER]) );
+ }
+
+ return $env;
}
# 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])
)
) {
- return [ ] if length($self->[FRAMING_BUFFER]) < $self->[EXPECTED_SIZE];
+ if(length($self->[FRAMING_BUFFER]) < $self->[EXPECTED_SIZE]) {
+ my $env = $self->[CURRENT_ENV]->clone();
+ push( @{ $env->oob() }, length($self->[FRAMING_BUFFER]) );
+ return $env;
+ }
+
# Four-arg substr() would be better here, but it's not compatible
# with Perl as far back as we support.
my $block = substr($self->[FRAMING_BUFFER], 0, $self->[EXPECTED_SIZE]);
substr($self->[FRAMING_BUFFER], 0, $self->[EXPECTED_SIZE]) = '';
$self->[EXPECTED_SIZE] = undef;
+ my $env = $self->[CURRENT_ENV]->clone();
+ $env->data( [ $block ] );
+ push( @{ $env->oob() }, length($self->[FRAMING_BUFFER]) );
- return [ $block ];
+ return $env;
}
-
- return [ ];
+
+ my $env = $self->[CURRENT_ENV]->clone();
+ push( @{ $env->oob() }, length($self->[FRAMING_BUFFER]) );
+ $env->error('Inconsistent state detected in Block.pm');
+ return $env;
}
#------------------------------------------------------------------------------
@@ -158,8 +192,20 @@
$self->[ENCODER]->(\$_);
}
}
+
+ my $processed;
- \@raw;
+ if(UNIVERSAL::isa($blocks, 'POE::Data::Envelope')) {
+ $processed = $blocks;
+ }
+
+ else {
+ $processed = $self->[CURRENT_ENV]->clone();
+ }
+
+ $processed->data(\@raw);
+ pop( @{ $processed->oob() } ) if @{ $processed->oob() };
+ return $processed;
}
#------------------------------------------------------------------------------
@@ -185,10 +231,10 @@
$filter = POE::Filter::Block->new(
LengthCodec => [ \&encoder, \&decoder ]
);
- $arrayref_of_blocks =
+ $poe_data_envelope_of_blocks =
$filter->get($arrayref_of_raw_chunks_from_driver);
- $arrayref_of_streamable_chunks_for_driver =
- $filter->put($arrayref_of_blocks);
+ $poe_data_envelope_of_streamable_chunks_for_driver =
+ $filter->put($poe_data_envelope_of_blocks);
$arrayref_of_leftovers =
$filter->get_pending();
@@ -237,6 +283,14 @@
This filter holds onto incomplete blocks until they are completed.
+The POE::Data::Envelopes returned from this filter have the following
+properties:
+
+ oob(): The top of the OOB stack will contain the amount of data left in
+ the buffer.
+ error(): will contain an error string if an inconsistent state was
+ encountered.
+
=head1 PUBLIC FILTER METHODS
Please see POE::Filter.
=== lib/POE/Filter/Stream.pm
==================================================================
--- lib/POE/Filter/Stream.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Filter/Stream.pm (/local/poe/trunk/poe) (revision 2611)
@@ -9,19 +9,27 @@
$VERSION = do {my($r)=(q$Revision$=~/(\d+)/);sprintf"1.%04d",$r};
@ISA = qw(POE::Filter);
+sub BUFFER () { 0 }
+sub CURRENT_ENV () { 1 }
+
#------------------------------------------------------------------------------
sub new {
my $type = shift;
- my $buffer = '';
- my $self = bless \$buffer, $type;
- $self;
+
+ my $self = bless [
+ '', # BUFFER
+ POE::Data::Envelope->new(), # CURRENT_ENV
+ ], $type;
}
sub clone {
my $self = shift;
- my $buffer = '';
- my $clone = bless \$buffer, ref $self;
+
+ my $clone = bless [
+ '', # BUFFER
+ POE::Data::Envelope->new(), # CURRENT_ENV
+ ], ref $self;
}
#------------------------------------------------------------------------------
@@ -35,29 +43,58 @@
sub get_one_start {
my ($self, $stream) = @_;
- $$self .= join '', @$stream;
+
+ if(UNIVERSAL::isa($stream, 'POE::Data::Envelope')) {
+ $self->[CURRENT_ENV] = $stream;
+ }
+
+ else {
+ $self->[CURRENT_ENV] = POE::Data::Envelope->new();
+ }
+
+ $self->[BUFFER] = join('', @$stream);
}
sub get_one {
my $self = shift;
- return [ ] unless length $$self;
- my $chunk = $$self;
- $$self = '';
- return [ $chunk ];
+
+ my $env = $self->[CURRENT_ENV]->clone();
+
+ if(length($self->[BUFFER])) {
+ $env->data( [ $self->[BUFFER] ] );
+ $self->[BUFFER] = '';
+ }
+
+ push( @{ $env->oob() }, length( $self->[BUFFER] ) );
+
+ return $env;
}
#------------------------------------------------------------------------------
sub put {
- my ($self, $chunks) = @_;
- [ @$chunks ];
+ my ($self, $data) = @_;
+ my $processed;
+
+ if(UNIVERSAL::isa($data, 'POE::Data::Envelope')) {
+ $processed = $data;
+ }
+
+ else {
+ $processed = $self->[CURRENT_ENV]->clone();
+ }
+
+ $processed->data( [ @$data ] );
+ pop( @{ $processed->oob() } ) if @{ $processed->oob() };
+
+ return $processed;
}
#------------------------------------------------------------------------------
sub get_pending {
my $self = shift;
- return [ $$self ] if length $$self;
+ return [ $self->[BUFFER] ] if length $self->[BUFFER];
return undef;
}
=== lib/POE/Filter/Grep.pm
==================================================================
--- lib/POE/Filter/Grep.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Filter/Grep.pm (/local/poe/trunk/poe) (revision 2611)
@@ -4,6 +4,7 @@
use strict;
use POE::Filter;
+use POE::Data::Envelope;
use vars qw($VERSION @ISA);
$VERSION = do {my($r)=(q$Revision$=~/(\d+)/);sprintf"1.%04d",$r};
@@ -11,9 +12,10 @@
use Carp qw(croak carp);
-sub BUFFER () { 0 }
-sub CODEGET () { 1 }
-sub CODEPUT () { 2 }
+sub BUFFER () { 0 }
+sub CODEGET () { 1 }
+sub CODEPUT () { 2 }
+sub CURRENT_ENV () { 3 }
#------------------------------------------------------------------------------
@@ -36,6 +38,7 @@
[ ], # BUFFER
$params{Code} || $params{Get}, # CODEGET
$params{Code} || $params{Put}, # CODEPUT
+ POE::Data::Envelope->new(), # CURRENT_ENV
], $type;
}
@@ -49,29 +52,55 @@
sub get_one_start {
my ($self, $stream) = @_;
+
+ if(UNIVERSAL::isa($stream, 'POE::Data::Envelope')) {
+ $self->[CURRENT_ENV] = $stream;
+ }
+
+ else {
+ $self->[CURRENT_ENV] = POE::Data::Envelope->new();
+ }
+
push( @{$self->[BUFFER]}, @$stream ) if defined $stream;
}
sub get_one {
my $self = shift;
-
+
+ my $env = $self->[CURRENT_ENV]->clone();
# Must be a loop so that the buffer will be altered as items are
# tested.
while (@{$self->[BUFFER]}) {
my $next_record = shift @{$self->[BUFFER]};
- return [ $next_record ] if (
- grep { $self->[CODEGET]->($_) } $next_record
- );
+ if( grep { $self->[CODEGET]->($_) } $next_record ) {
+ $env->data( [$next_record] );
+ push( @{ $env->oob() }, scalar( @{ $self->[BUFFER] } ) );
+ return $env;
+ }
}
-
- return [ ];
+
+ push( @{ $env->oob() }, scalar( @{ $self->[BUFFER] } ) );
+ return $env;
}
#------------------------------------------------------------------------------
sub put {
my ($self, $data) = @_;
- [ grep { $self->[CODEPUT]->($_) } @$data ];
+ my $processed;
+
+ if(UNIVERSAL::isa($data, 'POE::Data::Envelope')) {
+ $processed = $data;
+ }
+
+ else {
+ $processed = $self->[CURRENT_ENV]->clone();
+ }
+
+ $processed->data( [ grep { $self->[CODEPUT]->($_) } @$data ] );
+ pop( @{ $processed->oob() } ) if @{ $processed->oob() };
+
+ return $processed;
}
#------------------------------------------------------------------------------
=== lib/POE/Filter/Map.pm
==================================================================
--- lib/POE/Filter/Map.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Filter/Map.pm (/local/poe/trunk/poe) (revision 2611)
@@ -4,6 +4,7 @@
use strict;
use POE::Filter;
+use POE::Data::Envelope;
use vars qw($VERSION @ISA);
$VERSION = do {my($r)=(q$Revision$=~/(\d+)/);sprintf"1.%04d",$r};
@@ -11,9 +12,10 @@
use Carp qw(croak carp);
-sub BUFFER () { 0 }
-sub CODEGET () { 1 }
-sub CODEPUT () { 2 }
+sub BUFFER () { 0 }
+sub CODEGET () { 1 }
+sub CODEPUT () { 2 }
+sub CURRENT_ENV () { 3 }
#------------------------------------------------------------------------------
@@ -33,9 +35,10 @@
and (defined $params{Put} ? (ref $params{Put} eq 'CODE') : 1));
my $self = bless [
- [ ], # BUFFER
+ [ ], # BUFFER
$params{Code} || $params{Get}, # CODEGET
$params{Code} || $params{Put}, # CODEPUT
+ POE::Data::Envelope->new(), # CURRENT_ENV
], $type;
}
@@ -47,7 +50,20 @@
sub put {
my ($self, $data) = @_;
- [ map { $self->[CODEPUT]->($_) } @$data ];
+ my $processed;
+
+ if(UNIVERSAL::isa($data, 'POE::Data::Envelope')) {
+ $processed = $data;
+ }
+
+ else {
+ $processed = $self->[CURRENT_ENV]->clone();
+ }
+
+ $processed->data( [ map { $self->[CODEPUT]->($_) } @$data ] );
+ pop( @{ $processed->oob() } ) if @{ $processed->oob() };
+
+ return $processed;
}
#------------------------------------------------------------------------------
@@ -58,15 +74,30 @@
sub get_one_start {
my ($self, $stream) = @_;
- push(@{$self->[BUFFER]}, @$stream) if defined $stream;
+
+ if(UNIVERSAL::isa($stream, 'POE::Data::Envelope')) {
+ $self->[CURRENT_ENV] = $stream;
+ }
+
+ else {
+ $self->[CURRENT_ENV] = POE::Data::Envelope->new();
+ }
+
+ push( @{$self->[BUFFER]}, @$stream ) if defined $stream;
}
sub get_one {
my $self = shift;
- return [ ] unless @{$self->[BUFFER]};
- my $next_record = shift @{$self->[BUFFER]};
- return [ map { $self->[CODEGET]->($_) } $next_record ];
+ my $env = $self->[CURRENT_ENV]->clone();
+
+ if(@{$self->[BUFFER]}) {
+ my $next_record = shift @{$self->[BUFFER]};
+ $env->data( [ map { $self->[CODEGET]->($_) } $next_record ] );
+ }
+
+ push( @{ $env->oob() }, scalar( @{ $self->[BUFFER] } ) );
+ return $env;
}
#------------------------------------------------------------------------------
=== lib/POE/Filter/Reference.pm
==================================================================
--- lib/POE/Filter/Reference.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Filter/Reference.pm (/local/poe/trunk/poe) (revision 2611)
@@ -7,6 +7,7 @@
use strict;
use POE::Filter;
+use POE::Data::Envelope;
use vars qw($VERSION @ISA);
$VERSION = do {my($r)=(q$Revision$=~/(\d+)/);sprintf"1.%04d",$r};
@@ -14,10 +15,11 @@
use Carp qw(carp croak);
-sub BUFFER () { 0 }
-sub FREEZE () { 1 }
-sub THAW () { 2 }
-sub COMPRESS () { 3 }
+sub BUFFER () { 0 }
+sub FREEZE () { 1 }
+sub THAW () { 2 }
+sub COMPRESS () { 3 }
+sub CURRENT_ENV () { 4 }
#------------------------------------------------------------------------------
# Try to require one of the default freeze/thaw packages.
@@ -144,38 +146,32 @@
}
my $self = bless [
- '', # BUFFER
- $freeze, # FREEZE
- $thaw, # THAW
- $compression, # COMPRESS
+ '', # BUFFER
+ $freeze, # FREEZE
+ $thaw, # THAW
+ $compression, # COMPRESS
+ POE::Data::Envelope->new(), # CURRENT_ENV
], $type;
$self;
}
#------------------------------------------------------------------------------
-
-sub get {
- my ($self, $stream) = @_;
- my @return;
-
- $self->get_one_start($stream);
- while (1) {
- my $next = $self->get_one();
- last unless @$next;
- push @return, @$next;
- }
-
- return \@return;
-}
-
-#------------------------------------------------------------------------------
# 2001-07-27 RCC: The get_one() variant of get() allows Wheel::Xyz to
# retrieve one filtered block at a time. This is necessary for filter
# changing and proper input flow control.
sub get_one_start {
my ($self, $stream) = @_;
- $self->[BUFFER] .= join('', @$stream);
+
+ if(UNIVERSAL::isa($stream, 'POE::Data::Envelope')) {
+ $self->[CURRENT_ENV] = $stream;
+ }
+
+ else {
+ $self->[CURRENT_ENV] = POE::Data::Envelope->new();
+ }
+
+ $self->[BUFFER] .= join '', @$stream;
}
sub get_one {
@@ -183,6 +179,8 @@
# Need to check lengths in octets, not characters.
BEGIN { eval { require bytes } and bytes->import; }
+
+ my $env = $self->[CURRENT_ENV]->clone();
if (
$self->[BUFFER] =~ /^(\d+)\0/ and
@@ -192,10 +190,11 @@
my $return = substr($self->[BUFFER], 0, $1);
substr($self->[BUFFER], 0, $1) = "";
$return = uncompress($return) if $self->[COMPRESS];
- return [ $self->[THAW]->($return) ];
+ $env->data( [ $self->[THAW]->($return) ] );
}
-
- return [ ];
+ push( @{ $env->oob() }, length($self->[BUFFER]) );
+
+ return $env;
}
#------------------------------------------------------------------------------
@@ -212,7 +211,20 @@
$frozen = compress($frozen) if $self->[COMPRESS];
length($frozen) . "\0" . $frozen;
} @$references;
- \@raw;
+
+ my $processed;
+
+ if(UNIVERSAL::isa($references, 'POE::Data::Envelope')) {
+ $processed = $references;
+ }
+
+ else {
+ $processed = $self->[CURRENT_ENV]->clone();
+ }
+
+ $processed->data(\@raw);
+ pop( @{ $processed->oob() } ) if @{ $processed->oob() };
+ return $processed;
}
#------------------------------------------------------------------------------
=== lib/POE/Filter/HTTPD.pm
==================================================================
--- lib/POE/Filter/HTTPD.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Filter/HTTPD.pm (/local/poe/trunk/poe) (revision 2611)
@@ -15,6 +15,7 @@
use strict;
use POE::Filter;
+use POE::Data::Envelope;
use vars qw($VERSION @ISA);
$VERSION = do {my($r)=(q$Revision$=~/(\d+)/);sprintf"1.%04d",$r};
@@ -25,6 +26,7 @@
sub FINISH () { 2 }
sub HEADER () { 3 }
sub CLIENT_PROTO () { 4 }
+sub CURRENT_ENV () { 5 }
use Carp qw(croak);
use HTTP::Status qw( status_message RC_BAD_REQUEST RC_OK RC_LENGTH_REQUIRED );
@@ -41,11 +43,12 @@
sub new {
my $type = shift;
my $self = [
- '', # BUFFER
- 0, # TYPE
- 0, # FINISH
- undef, # HEADER
- undef, # CLIENT_PROTO
+ '', # BUFFER
+ 0, # TYPE
+ 0, # FINISH
+ undef, # HEADER
+ undef, # CLIENT_PROTO
+ POE::Data::Envelope->new(), # CURRENT_ENV
];
bless $self, $type;
$self;
@@ -54,15 +57,34 @@
#------------------------------------------------------------------------------
sub get_one_start {
- my ($self, $stream) = @_;
- return if ( $self->[FINISH] );
- $stream = [ $stream ] unless ( ref( $stream ) );
- $self->[BUFFER] .= join( '', @$stream );
+ my ($self, $stream) = @_;
+ return if ( $self->[FINISH] );
+
+ if(UNIVERSAL::isa($stream, 'POE::Data::Envelope')) {
+ $self->[CURRENT_ENV] = $stream;
+ }
+
+ else {
+ $self->[CURRENT_ENV] = POE::Data::Envelope->new();
+ }
+
+ $stream = [ $stream ] unless ( ref( $stream ) );
+ $self->[BUFFER] .= join( '', @$stream );
}
sub get_one {
- my ($self) = @_;
- return ( $self->[FINISH] ) ? [] : $self->get( [] );
+ my ($self) = @_;
+
+ my $env = $self->[CURRENT_ENV]->clone();
+
+ if($self->[FINISH]) {
+ push( @{ $env->oob() } , length ( $self->[BUFFER] ) );
+ return $env;
+ }
+
+ else {
+ return $self->get( [] );
+ }
}
sub get {
@@ -78,6 +100,8 @@
# arrived. Subsequent get() calls on the same request should not
# happen.
# TODO Maybe this should return [] instead of dying?
+
+ my $env = $self->[CURRENT_ENV]->clone();
if ($self->[FINISH]) {
@@ -101,14 +125,18 @@
push @dump, sprintf( "%04x %-47.47s - %s\n", $offset, $hexdump, $line );
$offset += 16;
}
-
- return [
+
+ $env->data([
$self->_build_error(
- RC_BAD_REQUEST,
- "Did not want any more data. Got this:" .
- "<p><pre>" . join("", @dump) . "</pre></p>"
+ RC_BAD_REQUEST,
+ "Did not want any more data. Got this:" .
+ "<p><pre>" . join("", @dump) . "</pre></p>"
)
- ];
+ ]);
+
+ $env->error(1);
+
+ return $env;
}
# Accumulate data in a framing buffer.
@@ -145,19 +173,24 @@
# We are sending this back, so won't need it anymore.
$self->[HEADER] = undef;
$self->[FINISH]++;
- return [$r];
+ $env->data([$r]);
+ push( @{ $env->oob() } , length ( $self->[BUFFER] ) );
+ return $env;
}
#print "$cl wanted, got " . length($buf) . "\n";
- return [];
+ push( @{ $env->oob() } , length ( $self->[BUFFER] ) );
+ return $env;
}
# Headers aren't already received. Short-circuit header parsing:
# don't return anything until we've received a blank line.
+
- return [] unless(
- $self->[BUFFER] =~ /(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)/s
- );
+ if ($self->[BUFFER] !~ /(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)/s) {
+ push( @{ $env->oob() } , length ( $self->[BUFFER] ) );
+ return $env;
+ }
# Copy the buffer for header parsing, and remove the header block
# from the content buffer.
@@ -167,9 +200,12 @@
# Parse the request line.
if ($buf !~ s/^(\w+)[ \t]+(\S+)(?:[ \t]+(HTTP\/\d+\.\d+))?[^\012]*\012//) {
- return [
+ push( @{ $env->oob() } , length ( $self->[BUFFER] ) );
+ $env->data([
$self->_build_error(RC_BAD_REQUEST, "Request line parse failure.")
- ];
+ ]);
+ $env->error(1);
+ return $env;
}
my $proto = $3 || "HTTP/0.9";
@@ -214,7 +250,9 @@
$self->[FINISH]++;
# We are sending this back, so won't need it anymore.
$self->[HEADER] = undef;
- return [$r];
+ push( @{ $env->oob() } , length ( $self->[BUFFER] ) );
+ $env->data([$r]);
+ return $env;
}
# However, if it's any other type of request, check whether the
@@ -228,36 +266,48 @@
my $cl = $r->content_length();
unless(defined $cl) {
if($self->[CLIENT_PROTO] == 9) {
- return [
+ push( @{ $env->oob() } , length ( $self->[BUFFER] ) );
+
+ $env->data([
$self->_build_error(
RC_BAD_REQUEST,
"POST request detected in an HTTP 0.9 transaction. " .
"POST is not a valid HTTP 0.9 transaction type. " .
"Please verify your HTTP version and transaction content."
)
- ];
+ ]);
+
+ $env->error(1);
+ return $env;
}
elsif ($method eq 'OPTIONS') {
$self->[FINISH]++;
# OPTIONS requests can have an optional content length
# See http://www.faqs.org/rfcs/rfc2616.html, section 9.2
$self->[HEADER] = undef;
- return [$r];
+ push( @{ $env->oob() } , length ( $self->[BUFFER] ) );
+ $env->data([$r]);
+ return $env;
}
else {
- return [
+ $env->data([
$self->_build_error(RC_LENGTH_REQUIRED, "No content length found.")
- ];
+ ]);
+ $env->error(1);
+ return $env;
}
}
- unless ($cl =~ /^\d+$/) {
- return [
+ if ($cl !~ /^\d+$/) {
+ $env->data([
$self->_build_error(
RC_BAD_REQUEST,
"Content length contains non-digits."
)
- ];
+ ]);
+
+ $env->error(1);
+ return $env;
}
if (length($buf) >= $cl) {
@@ -267,10 +317,13 @@
$self->[FINISH]++;
# We are sending this back, so won't need it anymore.
$self->[HEADER] = undef;
- return [$r];
+ push( @{ $env->oob() } , length ( $self->[BUFFER] ) );
+ $env->data([$r]);
+ return $env;
}
- return [];
+ push( @{ $env->oob() } , length ( $self->[BUFFER] ) );
+ return $env;
}
#------------------------------------------------------------------------------
@@ -308,7 +361,25 @@
# Allow next request after we're done sending the response.
$self->[FINISH]--;
- \@raw;
+ my $processed;
+
+ # If we have an Envelope object, push the processed responses into it
+ # and also pop off the last oob since it should be ours
+ if(UNIVERSAL::isa($responses, 'POE::Data::Envelope')) {
+ $processed = $responses;
+ }
+
+ # Otherwise we need to wrap the processed responses in the stored envelope
+ # so previous OOB messages get back to their owners
+ else {
+ $processed = $self->[CURRENT_ENV]->clone();
+ }
+
+ $processed->data(\@raw);
+ pop( @{ $processed->oob() } ) if @{ $processed->oob() };
+
+
+ return $processed;
}
#------------------------------------------------------------------------------
@@ -378,7 +449,6 @@
###############################################################################
1;
-
__END__
=head1 NAME
@@ -388,9 +458,9 @@
=head1 SYNOPSIS
$httpd = POE::Filter::HTTPD->new();
- $arrayref_with_http_response_as_string =
- $httpd->put($full_http_response_object);
- $arrayref_with_http_request_object =
+ $poe_data_envelope_with_response_as_string =
+ $httpd->put($return_evenlope_with_http_response);
+ $poe_data_envelope_containing_http_request =
$line->get($arrayref_of_raw_data_chunks_from_driver);
=head1 DESCRIPTION
@@ -423,6 +493,16 @@
Please see the documentation for HTTP::Request and HTTP::Response.
+In the case that the experiemental POE::Data::Envelope feature is enabled in
+the corresponding wheel, this filter will return POE::Data::Envelope objects
+with the following properties:
+
+ oob(): the top of the OOB stack will contain the number of bytes left in
+ the buffer
+
+ error(): will contain a true value. The data contained will be an
+ appropriate HTTP::Response object.
+
=head1 PUBLIC FILTER METHODS
Please see POE::Filter.
=== lib/POE/Filter.pm
==================================================================
--- lib/POE/Filter.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Filter.pm (/local/poe/trunk/poe) (revision 2611)
@@ -1,6 +1,7 @@
# $Id$
package POE::Filter;
+use POE::Data::Envelope;
use strict;
@@ -87,11 +88,22 @@
get() translates raw data into records. What sort of records is
defined by the specific filter. The method accepts a reference to an
-array of raw data chunks, and it returns a reference to an array of
-complete records. The returned ARRAYREF will be empty if there wasn't
-enough information to create a complete record. Partial records may
-be buffered until subsequent get() calls complete them.
+array of raw data chunks, and it returns a POE::Data::Envelope containing
+complete records. The returned Envelope's data() property will be empty if
+there wasn't enough information to create a complete record. Partial records
+may be buffered until subsequent get() calls complete them. If there was an
+error in processing the raw chunks, the error() property will be boolean true
+and may contain a reference to a data structure that further explains the
+error state. Also, some protocols require some sort of Out-of-Band data
+transmission. This is data is accessed via the oob() property. The contents of
+both the error() and oob() properties are filter specific. For legacy filters
+and applications developed before POE::Data::Envelope, the returned Envelope
+object transparently masquerades as an ARRAYREF of processed records to
+preserve backwards compatibility.
+Please see POE::Data::Envelope for more detailed information on the
+implementation and proper use of the module if designing your own filter.
+
my $records = $filter->get( $driver->get( $filehandle ) );
get() processes and returns as many records as possible. This is
@@ -110,15 +122,15 @@
stream chunks. It adds them to the filter's internal buffer and does
nothing else.
-get_one() takes no parameters and returns an ARRAYREF of zero or more
-complete records from the filter's buffer. Unlike the plain get()
+get_one() takes no parameters and returns a POE::Data::Envelope containing zero
+or more complete records from the filter's buffer. Unlike the plain get()
method, get_one() is not greedy. It returns as few records as
possible, preferably just zero or one.
get_one_start() and get_one() reduce or eliminate race conditions when
switching filters in a wheel.
-=item put ARRAYREF
+=item put ARRAYREF/POE::Data::Evenlope
put() serializes records into a form that may be written to a file or
sent across a socket. It accepts a reference to a list of records,
@@ -128,6 +140,10 @@
$driver->put( $filter->put( \@records ) );
+put() may also take a POE::Data::Envelope object if there is OOB data required
+to contruct an appropriate response. The structure of the OOB data is filter
+and protocol specific.
+
=item get_pending
get_pending() returns a filter's partial input buffer. Unlike
=== lib/POE/Wheel/ReadWrite.pm
==================================================================
--- lib/POE/Wheel/ReadWrite.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Wheel/ReadWrite.pm (/local/poe/trunk/poe) (revision 2611)
@@ -29,6 +29,7 @@
sub STATE_READ () { 15 }
sub UNIQUE_ID () { 16 }
sub AUTOFLUSH () { 17 }
+sub ENVELOPES () { 18 }
sub CRIMSON_SCOPE_HACK ($) { 0 }
@@ -133,7 +134,8 @@
undef, # STATE_READ
# Unique ID.
&POE::Wheel::allocate_wheel_id(), # UNIQUE_ID
- delete $params{AutoFlush}, # AUTOFLUSH
+ delete $params{AutoFlush}, # AUTOFLUSH
+ delete $params{Envelopes}, # Enable PDE
], $type;
if (scalar keys %params) {
@@ -266,68 +268,142 @@
$$input_filter->can('get_one') and
$$input_filter->can('get_one_start')
) {
- $poe_kernel->state(
- $self->[STATE_READ] = ref($self) . "($unique_id) -> select read",
- sub {
+
+ # If envelopes are enabled, pass the whole envelope from
+ # the filter to the waiting event.
+ if ($self->[ENVELOPES]) {
+ $poe_kernel->state(
+ $self->[STATE_READ] = ref($self) . "($unique_id) -> select read",
+ sub {
- # Protects against coredump on older perls.
- 0 && CRIMSON_SCOPE_HACK('<');
+ # Protects against coredump on older perls.
+ 0 && CRIMSON_SCOPE_HACK('<');
- # The actual code starts here.
- my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0];
- if (defined(my $raw_input = $driver->get($handle))) {
- $$input_filter->get_one_start($raw_input);
- while (1) {
- my $next_rec = $$input_filter->get_one();
- last unless @$next_rec;
- foreach my $cooked_input (@$next_rec) {
- $k->call($me, $$event_input, $cooked_input, $unique_id);
+ # The actual code starts here.
+ my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0];
+ if (defined(my $raw_input = $driver->get($handle))) {
+ $$input_filter->get_one_start($raw_input);
+ while (1) {
+ my $next_rec = $$input_filter->get_one();
+ $k->call($me, $$event_input, $next_rec, $unique_id);
+ last if $next_rec->error();
+ last if not @$next_rec;
}
+ }
+
+ else {
+ $$event_error and $k->call(
+ $me, $$event_error, 'read', ($!+0), $!, $unique_id
+ );
+ $k->select_read($handle);
}
}
- else {
- $$event_error and $k->call(
- $me, $$event_error, 'read', ($!+0), $!, $unique_id
- );
- $k->select_read($handle);
+ );
+ }
+
+ # Otherwise, default to the original behavior of stripping the records
+ # out of the arrayref
+
+ else {
+ $poe_kernel->state(
+ $self->[STATE_READ] = ref($self) . "($unique_id) -> select read",
+ sub {
+
+ # Protects against coredump on older perls.
+ 0 && CRIMSON_SCOPE_HACK('<');
+
+ # The actual code starts here.
+ my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0];
+ if (defined(my $raw_input = $driver->get($handle))) {
+ $$input_filter->get_one_start($raw_input);
+ while (1) {
+ my $cooked_input = $$input_filter->get_one();
+ last unless @$cooked_input;
+ foreach my $cooked (@$cooked_input) {
+ $k->call($me, $$event_input, $cooked, $unique_id);
+ }
+ }
+ }
+
+ else {
+ $$event_error and $k->call(
+ $me, $$event_error, 'read', ($!+0), $!, $unique_id
+ );
+ $k->select_read($handle);
+ }
}
- }
- );
+ );
+ }
+
}
# Otherwise define the input state in terms of the older, less
# robust, yet faster get().
-
+
else {
- $poe_kernel->state(
- $self->[STATE_READ] = ref($self) . "($unique_id) -> select read",
- sub {
+
+ # If envelopes are enabled, pass the whole envelope from
+ # the filter to the waiting event.
- # Protects against coredump on older perls.
- 0 && CRIMSON_SCOPE_HACK('<');
+ if($self->[ENVELOPES]) {
+ $poe_kernel->state(
+ $self->[STATE_READ] = ref($self) . "($unique_id) -> select read",
+ sub {
- # The actual code starts here.
- my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0];
- if (defined(my $raw_input = $driver->get($handle))) {
- foreach my $cooked_input (@{$$input_filter->get($raw_input)}) {
+ # Protects against coredump on older perls.
+ 0 && CRIMSON_SCOPE_HACK('<');
+
+ # The actual code starts here.
+ my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0];
+ if (defined(my $raw_input = $driver->get($handle))) {
+ my $cooked_input = $$input_filter->get($raw_input);
$k->call($me, $$event_input, $cooked_input, $unique_id);
}
+ else {
+ $$event_error and $k->call(
+ $me, $$event_error, 'read', ($!+0), $!, $unique_id
+ );
+ $k->select_read($handle);
+ }
}
- else {
- $$event_error and $k->call(
- $me, $$event_error, 'read', ($!+0), $!, $unique_id
- );
- $k->select_read($handle);
+ );
+ }
+
+ # Otherwise, default to the original behavior of stripping the records
+ # out of the arrayref
+
+ else {
+ $poe_kernel->state(
+ $self->[STATE_READ] = ref($self) . "($unique_id) -> select read",
+ sub {
+
+ # Protects against coredump on older perls.
+ 0 && CRIMSON_SCOPE_HACK('<');
+
+ # The actual code starts here.
+ my ($k, $me, $handle) = @_[KERNEL, SESSION, ARG0];
+ if (defined(my $raw_input = $driver->get($handle))) {
+ foreach my $cooked_input (@{$$input_filter->get($raw_input)}) {
+ $k->call($me, $$event_input, $cooked_input, $unique_id);
+ }
+ }
+ else {
+ $$event_error and $k->call(
+ $me, $$event_error, 'read', ($!+0), $!, $unique_id
+ );
+ $k->select_read($handle);
+ }
}
- }
- );
+ );
+ }
}
- # register the state's select
+
+ # register the state's select
$poe_kernel->select_read($self->[HANDLE_INPUT], $self->[STATE_READ]);
}
- # undefine the select, just in case
+ # undefine the select, just in case
else {
- $poe_kernel->select_read($self->[HANDLE_INPUT])
+ $poe_kernel->select_read($self->[HANDLE_INPUT]);
}
}
@@ -471,15 +547,26 @@
$self->[FILTER_INPUT]->get_one_start($buf);
while ($self->[FILTER_INPUT] == $old_input_filter) {
my $next_rec = $self->[FILTER_INPUT]->get_one();
- last unless @$next_rec;
- foreach my $cooked_input (@$next_rec) {
+
+ if($self->[ENVELOPES]) {
$poe_kernel->call(
$poe_kernel->get_active_session(),
$self->[EVENT_INPUT],
- $cooked_input, $self->[UNIQUE_ID]
+ $next_rec, $self->[UNIQUE_ID]
);
}
- }
+
+ else {
+ last unless @$next_rec;
+ foreach my $cooked_input (@$next_rec) {
+ $poe_kernel->call(
+ $poe_kernel->get_active_session(),
+ $self->[EVENT_INPUT],
+ $cooked_input, $self->[UNIQUE_ID]
+ );
+ }
+ }
+ }
}
}
@@ -698,6 +785,11 @@
# Experimental: If true, flush output synchronously during put()
AutoFlush => $boolean,
+
+ # Envelopes: If true, enable returning POE::Data::Envelopes from the
+ # assigned filter if it supports it. See POE::Data::Envelope for more
+ # details.
+ Envelopes => $enable,
);
$wheel->put( $something );
@@ -966,6 +1058,21 @@
transmitting altogether upon receipt of a HighEvent, and they can
resume full-speed transmission once LowEvent arrives.
+=item Envelopes - EXPERIMENTAL
+
+With the integration of POE::Data::Envelope, by default the filters
+shipped with POE emit their payloads wrapped up in a thin object that
+provides extra context information in addition to the data.
+
+POE::Data::Envelope objects are transparent to the consumer by masquerading
+as array references with proper stringification and dereferencing semantics.
+
+But for some end developer code that specifically checks for a hard array
+reference, bad things may happen. For now this feature is marked as
+EXPERIMENTAL. If enabled, ReadWrite's payloads for InputEvent will be
+POE::Data::Envelope objects. By default, this is disabled and the data is
+stripped and delivered as it always has been.
+
=back
=head1 SEE ALSO
=== lib/POE/Data (new directory)
==================================================================
=== lib/POE/Data/Envelope.pm
==================================================================
--- lib/POE/Data/Envelope.pm (/mirror/poe/trunk/poe) (revision 2611)
+++ lib/POE/Data/Envelope.pm (/local/poe/trunk/poe) (revision 2611)
@@ -0,0 +1,270 @@
+package POE::Data::Envelope;
+
+use warnings;
+use strict;
+use Carp;
+
+our $VERSION = '0.02';
+
+use constant
+{
+ 'DATA' => 0,
+ 'OOB' => 1,
+ 'ERROR' => 2,
+};
+
+use overload
+(
+ '@{}' => \&_array_deref,
+ '""' => \&_stringification,
+);
+
+sub _stringification
+{
+ my $class = ref($_[0]);
+
+ bless($_[0], 'overload::dummy');
+ my $ref = $_[0]->[+DATA];
+ bless($_[0], $class);
+ return "$ref";
+}
+
+sub _array_deref
+{
+ my $class = ref($_[0]);
+ bless($_[0], 'overload::dummy');
+ my $data = $_[0]->[+DATA];
+ bless($_[0], $class);
+ return $data;
+}
+
+sub data()
+{
+ my $class = ref($_[0]);
+
+ bless($_[0], 'overload::dummy');
+
+ my $data;
+
+ if(@_ > 1)
+ {
+ if(@_ == 2)
+ {
+ if(ref($_[1]) =~ /ARRAY/o)
+ {
+ $_[0]->[+DATA] = $_[1];
+
+ } elsif(ref($_[1])) {
+
+ bless($_[0], $class);
+ Carp::croak('Only array references may be stored');
+
+ } else {
+
+ $data = $_[0]->[+DATA]->[$_[1]];
+ }
+
+ } elsif(@_ == 3) {
+
+ $_[0]->[+DATA]->[$_[1]] = $_[2];
+ }
+
+ } else {
+
+ $data = $_[0]->[+DATA];
+ }
+
+ bless($_[0], $class);
+ return $data;
+}
+
+sub oob()
+{
+ my $class = ref($_[0]);
+
+ bless($_[0], 'overload::dummy');
+
+ my $data;
+
+ if(@_ > 1)
+ {
+ $_[0]->[+OOB] = $_[1];
+
+ } else {
+
+ $data = $_[0]->[+OOB];
+ }
+
+ bless($_[0], $class);
+ return $data;
+}
+
+sub error()
+{
+ my $class = ref($_[0]);
+
+ bless($_[0], 'overload::dummy');
+
+ my $data;
+
+ if(@_ > 1)
+ {
+ $_[0]->[+ERROR] = $_[1];
+
+ } else {
+
+ $data = $_[0]->[+ERROR];
+ }
+
+ bless($_[0], $class);
+ return $data;
+}
+
+sub new()
+{
+ my ($class, $data, $oob, $error) = @_;
+
+ my $self = [];
+ $self->[+DATA] = $data ? $data : [];
+ $self->[+OOB] = $oob ? $oob : [];
+ $self->[+ERROR] = $error ? $error : 0;
+ bless($self, $class);
+
+ return $self;
+}
+
+sub clone()
+{
+ my $class = ref($_[0]);
+
+ bless($_[0], 'overload::dummy');
+
+ my $clone = [];
+
+ $clone->[+DATA] = [];
+ @{$clone->[+OOB]} = @{$_[0]->[+OOB]};
+ $clone->[+ERROR] = $_[0]->[+ERROR];
+
+ bless($_[0], $class);
+ bless($clone, $class);
+
+ return $clone;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+POE::Data::Envelope - An envelope class to be used with Filters that need to
+report out of band data to the consumer of the filtered data.
+
+=head1 VERSION
+
+Version 0.01
+
+=head1 SYNOPSIS
+
+This class is ultimately just a very thin Class::Struct-like object with an
+overloaded array dereference to accommodate legacy filters and applications
+that do not expect to receive an Envelope object.
+
+ package Some::Filter;
+
+ use POE::Data::Envelope;
+
+ sub get_one()
+ {
+ ...
+ # If error
+ my $envelope = POE::Data::Envelope->new();
+ $envelope->oob('There are no records');
+ $envelope->error(1);
+ return $envelope;
+ }
+
+=head1 AUTHOR
+
+Nicholas Perez, C<< <nperez at cpan.org> >>
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+new() takes no arguments and returns an envelope object.
+
+=item oob()
+
+oob() can take and store any arbitrary scalar reference, and return it if no
+arguments are provided. This is useful for sending data out of the normal flow
+to report a problem to downstream consumers.
+
+=item error()
+
+error() can take and store any arbitrary scalar reference, and return it if no
+arguments are provided. If there is an error in processing within the filter
+set this to a positive value to let the downstream consumers adjust program
+behavior accordingly.
+
+=item clone()
+
+clone() does a deep copy of the entire envelope and returns it.
+
+=item data()
+
+data() contains the actual data stored within the envelope. This can also be
+accessed by simply dereferencing the object as an array reference
+
+=back
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-poe-data-envelope at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=POE-Data-Envelope>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc POE::Data::Envelope
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/POE-Data-Envelope>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/POE-Data-Envelope>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=POE-Data-Envelope>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/POE-Data-Envelope>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Nicholas Perez, all rights reserved.
+
+This program is released under the following license: gpl
+
+=cut
+