Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

newline detection in Filter::Line; fixed mailer breakage in filtercha…

…nge; added a filter-change test; tweaked some tests
  • Loading branch information...
commit 1b8d2a3e9588f311141987ce1417ed2929fc9af2 1 parent d4fbc45
@rcaputo authored
View
19 Changes
@@ -26,7 +26,9 @@ Version numbers have four fields: X.YYZZAA
,----- To Do -----
|
-| Warn people that the Tk tests will pop up windows.
+| How about Gtk support?
+|
+| Better alarms API.
|
| Why does samples/tk.perl leak memory, and how can I fix it?
|
@@ -58,6 +60,21 @@ newlines in Filter::Line, and we both implemented it in parallel. The
best bits of both implementations are in POE::Filter::Line; see the
documentation for how to enable this nifty feature.
+Addi caught on that long lines in samples/filterchange.perl were
+wrapped by some misguided program. I reformatted the source so that
+no lines are longer than 79 columns, just in case.
+
+Made Wheel::ReadWrite carp about unknown parameters.
+
+Added t/19_filterchange.t to test filter changing between every filter
+that supports the get_pending() method.
+
+Tweaked the timing on t/11_signals_poe.t and t/12_signals_ev.t to take
+less time. Put messages in them anyway to tell people to be patient.
+
+Added a message to t/06_tk.t to let anyone paying attention to the
+test terminal know that a Tk window will pop up.
+
0.1102 2000.07.27
-----------------
View
1  MANIFEST
@@ -82,3 +82,4 @@ t/15_filter_block.t
t/16_filter_stream.t
t/17_filter_ref.t
t/18_filter_line.t
+t/19_filterchange.t
View
12 lib/POE/Filter/Line.pm
@@ -33,6 +33,8 @@ sub new {
# Literal newline for both incoming and outgoing. Every other known
# parameter conflicts with this one.
if (exists $params{Literal}) {
+ croak "Literal must be defined and have a nonzero length"
+ unless defined($params{Literal}) and length($params{Literal});
$input_regexp = quotemeta $params{Literal};
$output_literal = $params{Literal};
croak "$type cannot have Literal with any other parameter"
@@ -52,7 +54,7 @@ sub new {
# InputLiteral is defined. Turn it into a regexp and be done.
# Otherwise we will autodetect it.
- if (defined $input_regexp) {
+ if (defined($input_regexp) and length($input_regexp)) {
$input_regexp = quotemeta $input_regexp;
}
else {
@@ -81,9 +83,8 @@ sub new {
}
delete @params{qw(Literal InputLiteral OutputLiteral InputRegexp)};
- if (keys %params) {
- carp "$type ignores unknown parameters: ", join(', ', sort keys %params);
- }
+ carp("$type ignores unknown parameters: ", join(', ', sort keys %params))
+ if scalar keys %params;
my $self =
bless [ '', # FRAMING_BUFFER
@@ -212,7 +213,8 @@ sub get_pending {
my $self = shift;
my $framing_buffer = $self->[FRAMING_BUFFER];
$self->[FRAMING_BUFFER] = '';
- return $framing_buffer;
+ return [ $framing_buffer ] if length $framing_buffer;
+ return undef;
}
###############################################################################
View
3  lib/POE/Kernel.pm
@@ -3084,7 +3084,8 @@ their states return.
=item TRACE_GARBAGE
TRACE_GARBAGE shows what's keeping sessions alive. It's useful for
-determining why a session simply refuses to die.
+determining why a session simply refuses to die, or why it won't stay
+alive.
=item TRACE_PROFILE
View
100 lib/POE/Wheel/ReadWrite.pm
@@ -35,24 +35,23 @@ sub new {
croak "wheels no longer require a kernel reference as their first parameter"
if (@_ && (ref($_[0]) eq 'POE::Kernel'));
- croak "$type requires a working Kernel"
- unless (defined $poe_kernel);
+ croak "$type requires a working Kernel" unless defined $poe_kernel;
my ($in_handle, $out_handle);
if (exists $params{Handle}) {
carp "Ignoring InputHandle parameter (Handle parameter takes precedence)"
- if (exists $params{InputHandle});
+ if exists $params{InputHandle};
carp "Ignoring OutputHandle parameter (Handle parameter takes precedence)"
- if (exists $params{OutputHandle});
- $in_handle = $out_handle = $params{Handle};
+ if exists $params{OutputHandle};
+ $in_handle = $out_handle = delete $params{Handle};
}
else {
croak "Handle or InputHandle required"
- unless (exists $params{InputHandle});
+ unless exists $params{InputHandle};
croak "Handle or OutputHandle required"
- unless (exists $params{OutputHandle});
- $in_handle = $params{InputHandle};
- $out_handle = $params{OutputHandle};
+ unless exists $params{OutputHandle};
+ $in_handle = delete $params{InputHandle};
+ $out_handle = delete $params{OutputHandle};
}
my ($in_filter, $out_filter);
@@ -61,18 +60,18 @@ sub new {
if (exists $params{InputFilter});
carp "Ignoring OUtputFilter parameter (Filter parameter takes precedence)"
if (exists $params{OutputFilter});
- $in_filter = $out_filter = $params{Filter};
+ $in_filter = $out_filter = delete $params{Filter};
}
else {
croak "Filter or InputFilter required"
unless exists $params{InputFilter};
croak "Filter or OutputFilter required"
unless exists $params{OutputFilter};
- $in_filter = $params{InputFilter};
- $out_filter = $params{OutputFilter};
+ $in_filter = delete $params{InputFilter};
+ $out_filter = delete $params{OutputFilter};
}
- croak "Driver required" unless (exists $params{Driver});
+ croak "Driver required" unless exists $params{Driver};
{ my $mark_errors = 0;
if (exists($params{HighMark}) xor exists($params{LowMark})) {
@@ -106,20 +105,26 @@ sub new {
$out_handle,
$in_filter,
$out_filter,
- $params{Driver},
- $params{InputState},
- $params{ErrorState},
- $params{FlushedState},
+ delete $params{Driver},
+ delete $params{InputState},
+ delete $params{ErrorState},
+ delete $params{FlushedState},
# Water marks.
- $params{HighMark},
- $params{LowMark},
- $params{HighState},
- $params{LowState},
+ delete $params{HighMark},
+ delete $params{LowMark},
+ delete $params{HighState},
+ delete $params{LowState},
0,
# Driver statistics.
0,
];
+ if (scalar keys %params) {
+ carp( "unknown parameters in $type constructor call: ",
+ join(', ', keys %params)
+ );
+ }
+
$self->_define_read_state();
$self->_define_write_state();
@@ -350,48 +355,43 @@ sub put {
# one input and one output, make this set both of them at the same
# time. -RC
-sub set_filter
-{
- my($self, $new_filter)=@_;
- my $buf=$self->[FILTER_INPUT]->get_pending();
- $self->[FILTER_INPUT]=$self->[FILTER_OUTPUT]=$new_filter;
+sub set_filter {
+ my ($self, $new_filter) = @_;
+ my $buf = $self->[FILTER_INPUT]->get_pending();
+ $self->[FILTER_INPUT] = $self->[FILTER_OUTPUT] = $new_filter;
- # Updates a closure dealing with the input filter.
- $self->_define_read_state();
+ # Updates a closure dealing with the input filter.
+ $self->_define_read_state();
- if ( defined($buf) )
- {
- foreach my $cooked_input (@{$new_filter->get($buf)})
- {
- $poe_kernel->yield($self->[EVENT_INPUT], $cooked_input)
- }
+ # Push pending data from the old filter into the new one.
+ if (defined $buf) {
+ foreach my $cooked_input (@{$new_filter->get($buf)}) {
+ $poe_kernel->yield($self->[EVENT_INPUT], $cooked_input)
}
+ }
}
# Redefine input and/or output filters separately.
-
sub set_input_filter {
- my($self, $new_filter)=@_;
- my $buf=$self->[FILTER_INPUT]->get_pending();
- $self->[FILTER_INPUT]=$new_filter;
-
- # Updates a closure dealing with the input filter.
- $self->_define_read_state();
-
- if ( defined($buf) )
- {
- foreach my $cooked_input (@{$new_filter->get($buf)})
- {
- $poe_kernel->yield($self->[EVENT_INPUT], $cooked_input)
- }
+ my ($self, $new_filter) = @_;
+ my $buf = $self->[FILTER_INPUT]->get_pending();
+ $self->[FILTER_INPUT] = $new_filter;
+
+ # Updates a closure dealing with the input filter.
+ $self->_define_read_state();
+
+ if (defined $buf) {
+ foreach my $cooked_input (@{$new_filter->get($buf)}) {
+ $poe_kernel->yield($self->[EVENT_INPUT], $cooked_input)
}
+ }
}
# No closures need to be redefined or anything. All the previously
# put stuff has been serialized already.
sub set_output_filter {
- my($self, $new_filter)=@_;
- $self->[FILTER_OUTPUT]=$new_filter;
+ my ($self, $new_filter) = @_;
+ $self->[FILTER_OUTPUT] = $new_filter;
}
# Set the high water mark.
View
15 samples/filterchange.perl
@@ -112,11 +112,13 @@ sub _start
'"IWANT Stream\nHELLO"',
'"IWANT Reference"',
- '{my $f = freeze(\ "IWANT Line"); return length($f) . "\0" . $f . "HELLO
-\n"}',
+ ( '{my $f = freeze(\ "IWANT Line"); return length($f) ' .
+ '. "\0" . $f . "HELLO\n"}'
+ ),
'"IWANT Reference\n"',
- '{my $f = freeze(\ "IWANT Stream"); return length($f) . "\0" . $f . "HEL
-LO"}',
+ ( '{my $f = freeze(\ "IWANT Stream"); return length($f) ' .
+ '. "\0" . $f . "HELLO"}'
+ ),
'"DONE"',
];
}
@@ -176,7 +178,7 @@ sub received
if($send)
{
print "Cause [$$] send '$send'\n";
-print "Cause [$$] (running $send )\n";
+ #print "Cause [$$] (running $send)\n";
$send=eval($send);
die $@ if $@;
# print "Cause [$$] send '", quotemeta($send), "'\n";
@@ -428,6 +430,3 @@ package main;
print "$me [$$] POE->run\n";
$poe_kernel->run();
print "$me [$$] Exit\n";
-
-
-
View
1  tests/05_macros.t
@@ -8,6 +8,7 @@ use lib qw(./lib ../lib);
use TestSetup;
&test_setup(13);
+sub POE::Kernel::TRACE_DEFAULT () { 1 } # not needed though
use POE::Preprocessor;
# Did we get this far?
View
5 tests/06_tk.t
@@ -31,6 +31,11 @@ BEGIN {
&test_setup(8);
+warn( "***\n",
+ "*** Please note: This test will pop up a Tk window.\n",
+ "***\n",
+ );
+
# Turn on all asserts.
sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE qw(Wheel::ReadWrite Filter::Line Driver::SysRW);
View
2  tests/07_event.t
@@ -1,7 +1,7 @@
#!/usr/bin/perl -w
# $Id$
-# Tests FIFO, alarm, select and Tk postback events using Event's event
+# Tests FIFO, alarm, select and postback events using Event's event
# loop.
use strict;
View
21 tests/11_signals_poe.t
@@ -24,11 +24,19 @@ eval {
import Time::HiRes qw(time sleep);
};
-# Set up a signal catching session. This test uses plain fork(2) and
-# POE's $SIG{CHLD} handler.
-
my $delay_per_child = time() - $^T;
$delay_per_child = 5 if $delay_per_child < 5;
+my $time_to_wait = $delay_per_child * $fork_count;
+
+# Let the user know what in heck is going on.
+warn( "***\n",
+ "*** This test will run for around $time_to_wait seconds.\n",
+ "*** The delay ensures that all child processes are accounted for.\n",
+ "***\n"
+ );
+
+# Set up a signal catching session. This test uses plain fork(2) and
+# POE's $SIG{CHLD} handler.
POE::Session->create
( inline_states =>
@@ -37,7 +45,7 @@ POE::Session->create
$_[HEAP]->{forked} = $_[HEAP]->{reaped} = 0;
$_[KERNEL]->sig( CHLD => 'catch_sigchld' );
- my $wake_time = time() + ($delay_per_child * $fork_count);
+ my $wake_time = time() + $time_to_wait;
# Fork some child processes, all to exit at the same time.
for (my $child = 0; $child < $fork_count; $child++) {
@@ -46,6 +54,7 @@ POE::Session->create
if (defined $child_pid) {
if ($child_pid) {
$_[HEAP]->{forked}++;
+ $_[HEAP]->{children}->{$child_pid} = 1;
}
else {
sleep $wake_time - time();
@@ -64,14 +73,14 @@ POE::Session->create
print "not ok 1 # forked $_[HEAP]->{forked} out of $fork_count\n";
}
- $_[KERNEL]->delay( time_is_up => ($delay_per_child * $fork_count * 2) );
+ $_[KERNEL]->delay( time_is_up => $time_to_wait );
},
_stop =>
sub {
my $heap = $_[HEAP];
if ($heap->{reaped} == $fork_count) {
- print "ok 2\n";
+ print "ok 2 # after ", (time() - $^T), " seconds\n";
}
else {
print "not ok 2 # reaped $heap->{reaped} out of $fork_count\n";
View
15 tests/12_signals_ev.t
@@ -35,6 +35,17 @@ eval {
import Time::HiRes qw(time sleep);
};
+my $delay_per_child = time() - $^T;
+$delay_per_child = 5 if $delay_per_child < 5;
+my $time_to_wait = $delay_per_child * $fork_count;
+
+# Let the user know what in heck is going on.
+warn( "***\n",
+ "*** This test will run for around $time_to_wait seconds.\n",
+ "*** The delay ensures that all child processes are accounted for.\n",
+ "***\n"
+ );
+
# Set up a signal catching session. This test uses plain fork(2) and
# POE's $SIG{CHLD} handler.
@@ -45,7 +56,7 @@ POE::Session->create
$_[HEAP]->{forked} = $_[HEAP]->{reaped} = 0;
$_[KERNEL]->sig( CHLD => 'catch_sigchld' );
- my $wake_time = time() + 60;
+ my $wake_time = time() + $time_to_wait;
# Fork some child processes, all to exit at the same time.
for (my $child = 0; $child < $fork_count; $child++) {
@@ -72,7 +83,7 @@ POE::Session->create
print "not ok 1 # forked $_[HEAP]->{forked} out of $fork_count\n";
}
- $_[KERNEL]->delay( time_is_up => 120 );
+ $_[KERNEL]->delay( time_is_up => $time_to_wait );
},
_stop =>
View
2  tests/15_filter_block.t
@@ -6,6 +6,8 @@
use strict;
use lib qw(./lib ../lib);
+
+sub POE::Kernel::TRACE_DEFAULT () { 1 } # not needed though
use POE::Filter::Block;
use TestSetup;
View
2  tests/16_filter_stream.t
@@ -5,6 +5,8 @@
use strict;
use lib qw(./lib ../lib);
+
+sub POE::Kernel::TRACE_DEFAULT () { 1 } # not needed though
use POE::Filter::Stream;
use TestSetup;
View
2  tests/17_filter_ref.t
@@ -5,6 +5,8 @@
use strict;
use lib qw(./lib ../lib);
+
+sub POE::Kernel::TRACE_DEFAULT () { 1 } # not needed though
use POE::Filter::Reference;
use TestSetup;
View
2  tests/18_filter_line.t
@@ -5,6 +5,8 @@
use strict;
use lib qw(./lib ../lib);
+
+sub POE::Kernel::TRACE_DEFAULT () { 1 } # not needed though
use POE::Filter::Line;
my ($filter, $received, $sent, $base);
Please sign in to comment.
Something went wrong with that request. Please try again.