r54973 - in /branches/upstream/libwx-perl-processstream-perl/current: Changes META.yml README lib/Wx/Perl/ProcessStream.pm t/01-events.t t/WxTesting.pm
chrisb at users.alioth.debian.org
chrisb at users.alioth.debian.org
Sun Mar 28 20:26:50 UTC 2010
Author: chrisb
Date: Sun Mar 28 20:26:35 2010
New Revision: 54973
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=54973
Log:
[svn-upgrade] Integrating new upstream version, libwx-perl-processstream-perl (0.27)
Modified:
branches/upstream/libwx-perl-processstream-perl/current/Changes
branches/upstream/libwx-perl-processstream-perl/current/META.yml
branches/upstream/libwx-perl-processstream-perl/current/README
branches/upstream/libwx-perl-processstream-perl/current/lib/Wx/Perl/ProcessStream.pm
branches/upstream/libwx-perl-processstream-perl/current/t/01-events.t
branches/upstream/libwx-perl-processstream-perl/current/t/WxTesting.pm
Modified: branches/upstream/libwx-perl-processstream-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-processstream-perl/current/Changes?rev=54973&op=diff
==============================================================================
--- branches/upstream/libwx-perl-processstream-perl/current/Changes (original)
+++ branches/upstream/libwx-perl-processstream-perl/current/Changes Sun Mar 28 20:26:35 2010
@@ -1,4 +1,22 @@
Revision history for Wx-Perl-ProcessStream
+
+0.27 2010-02-28 00:00
+ Use param to Wx::Yield (Wx 0.9701+) to avoid recursive
+ Yield calls and pass tests with debugging wxWidgets
+ (e.g. pre-installed wxWidgets on OSX);
+
+0.26 2010-02-26 00:00
+ Changed behaviour of $process->IsAlive
+ will now return false if process has
+ already returned an exit code.
+
+0.25 2010-02-25 00:00
+ Continuous stream will hang app rt.cpan.org #54962
+ Fixed by adding SetMaxLines setting with default 1000
+ Added PeekStdErrBuffer, PeekStdOutBuffer
+ Added GetStdErrBufferLineCount GetStdOutBufferLineCount
+ Added EVT_WXP_PROCESS_STREAM_MAXLINES
+ Stopped tests displaying frame (not necessary in this case)
0.24 2010-01-05 00:00
Added tests to confirm correct operation of 'print 0;'
Modified: branches/upstream/libwx-perl-processstream-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-processstream-perl/current/META.yml?rev=54973&op=diff
==============================================================================
--- branches/upstream/libwx-perl-processstream-perl/current/META.yml (original)
+++ branches/upstream/libwx-perl-processstream-perl/current/META.yml Sun Mar 28 20:26:35 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Wx-Perl-ProcessStream
-version: 0.24
+version: 0.27
abstract: access IO of external processes via events
author:
- Mark Dootson <mdootson at cpan.org>
Modified: branches/upstream/libwx-perl-processstream-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-processstream-perl/current/README?rev=54973&op=diff
==============================================================================
--- branches/upstream/libwx-perl-processstream-perl/current/README (original)
+++ branches/upstream/libwx-perl-processstream-perl/current/README Sun Mar 28 20:26:35 2010
@@ -2,7 +2,7 @@
Wx-Perl-ProcessStream
-(c)2007 - 2009 Mark Dootson
+(c)2007 - 2010 Mark Dootson
#########################################################
@@ -20,8 +20,7 @@
Linux / *nix
-To install this module, using VC6 run the following
-commands
+To install this module the following commands
perl Makefile.PL
make
@@ -40,7 +39,7 @@
COPYRIGHT AND LICENCE
-Copyright (C) 2007-2009 Mark Dootson
+Copyright (C) 2007-2010 Mark Dootson
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
Modified: branches/upstream/libwx-perl-processstream-perl/current/lib/Wx/Perl/ProcessStream.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-processstream-perl/current/lib/Wx/Perl/ProcessStream.pm?rev=54973&op=diff
==============================================================================
--- branches/upstream/libwx-perl-processstream-perl/current/lib/Wx/Perl/ProcessStream.pm (original)
+++ branches/upstream/libwx-perl-processstream-perl/current/lib/Wx/Perl/ProcessStream.pm Sun Mar 28 20:26:35 2010
@@ -4,14 +4,14 @@
## Author: Mark Dootson
## Modified by:
## Created: 11/05/2007
-## Copyright: (c) 2007-2009 Mark Dootson
+## Copyright: (c) 2007-2010 Mark Dootson
## Licence: This program is free software; you can redistribute it and/or
## modify it under the same terms as Perl itself
#############################################################################
package Wx::Perl::ProcessStream;
-our $VERSION = '0.24';
+our $VERSION = '0.27';
=head1 NAME
@@ -19,15 +19,16 @@
=head1 VERSION
-Version 0.24
+Version 0.27
=head1 SYNOPSYS
use Wx::Perl::ProcessStream qw( :everything );
- EVT_WXP_PROCESS_STREAM_STDOUT( $self, \&evt_process_stdout);
- EVT_WXP_PROCESS_STREAM_STDERR( $self, \&evt_process_stderr);
- EVT_WXP_PROCESS_STREAM_EXIT ( $self, \&evt_process_exit );
+ EVT_WXP_PROCESS_STREAM_STDOUT ( $self, \&evt_process_stdout );
+ EVT_WXP_PROCESS_STREAM_STDERR ( $self, \&evt_process_stderr );
+ EVT_WXP_PROCESS_STREAM_EXIT ( $self, \&evt_process_exit );
+ EVT_WXP_PROCESS_STREAM_MAXLINES ( $self, \&evt_process_maxlines );
my $proc1 = Wx::Perl::ProcessStream::Process->new('perl -e"print qq($_\n) for(@INC);"', 'MyName1', $self);
$proc1->Run;
@@ -41,6 +42,8 @@
$proc3->Run;
my $proc4 = Wx::Perl::ProcessStream::Process->new(\@args, 'MyName2', $self, 'readline')->Run;
+
+ my $proc5 = Wx::Perl::ProcessStream::Process->new(\@args, 'MyName2', $self);
sub evt_process_stdout {
my ($self, $event) = @_;
@@ -81,6 +84,15 @@
$process->Destroy;
}
+ sub evt_process_maxlines {
+ my ($self, $event) = @_;
+ my $process = $event->GetProcess;
+
+ ..... bad process
+
+ $process->Kill;
+ }
+
=head1 DESCRIPTION
@@ -110,13 +122,21 @@
$name = an arbitray name for the process.
$eventhandler = the Wx EventHandler (Wx:Window) that will handle events for this process.
$readmethod = 'read' or 'readline' (default = 'readline') an optional param. From Wx version
- 0.75 you can specifiy the method you wish to use to read the output of an
+ 0.75 you can specify the method you wish to use to read the output of an
external process.
The default depends on your Wx version ( 'getc' < 0.75,'readline' >= 0.75)
read -- uses the Wx::InputStream->READ method to read bytes.
readline -- uses the Wx::InputStream->READLINE method to read bytes
getc -- alias for read (getc not actually used)
+=item SetMaxLines
+
+Set the maximum number of lines that will be read from a continuous stream before raising a
+EVT_WXP_PROCESS_STREAM_MAXLINES event. The default is 1000. A continuous stream will cause
+your application to hang.
+
+ $process->SetMaxLines(10);
+
=item Run
Run the process with the parameters passed to new. On success, returns the process object itself.
@@ -167,6 +187,32 @@
my $arryref = $process->GetStdOutBuffer();
+=item GetStdErrBufferLineCount
+
+This returns the number of lines currently in the stderr buffer.
+
+ my $count = $process->GetStdErrBufferLineCount();
+
+=item GetStdOutBufferLineCount
+
+This returns the number of lines currently in the stdout buffer.
+
+ my $count = $process->GetStdOutBufferLineCount();
+
+=item PeekStdErrBuffer
+
+This returns a reference to an array containing all the lines sent by the process to stderr.
+To retrieve the buffer and clear it, call GetStdErrBuffer instead.
+
+ my $arryref = $process->PeekStdErrBuffer();
+
+=item PeekStdOutBuffer
+
+This returns a reference to an array containing all the lines sent by the process to stdout.
+To retrieve the buffer and clear it, call GetStdOutBuffer instead.
+
+ my $arryref = $process->PeekStdOutBuffer();
+
=item GetProcessId
Returns the process id assigned by the system.
@@ -182,10 +228,9 @@
=item IsAlive
Check if the process still exists in the system.
-Returns 1 if process exists, 0 if process does not exist, and undefined if there was some problem
-in signaling the process. If the process has already signalled its exit, the IsAlive method will
-wait until the system recogises the process exit before returning. Therefore IsAlive should
-always return 0 (false) once a EVT_WXP_PROCESS_STREAM_EXIT event has been received.
+Returns 1 if process exists, 0 if process does not exist. If the process has already
+signalled its exit, the IsAlive method will always return 0. Therefore IsAlive should
+always return 0 (false) once a EVT_WXP_PROCESS_STREAM_EXIT event has been sent.
my $isalive = $process->IsAlive();
@@ -274,6 +319,19 @@
$newdefaction = one of wxpSIGTERM or wxpSIGKILL
+=item SetDefaultMaxLines
+
+Sets the default maximum number of lines that will be processed continuously from
+an individual process. If a process produces a continuous stream of output, this would
+hang your application. This setting provides a maximum number of lines that will be
+read from the process streams before control is yielded and the events can be processed.
+Additionally, a EVT_WXP_PROCESS_STREAM_MAXLINES event will be sent to the eventhandler.
+The setting can also be set on an individual process basis using $process->SetMaxLines
+
+ Wx::Perl::ProcessStream->SetDefaultMaxLines( $maxlines );
+
+ the default maxlines number is 1000
+
=item GetPollInterval
Get the current polling interval. See SetPollInterval.
@@ -323,6 +381,15 @@
EVT_WXP_PROCESS_STREAM_EXIT( $eventhandler, $codref );
+=item EVT_WXP_PROCESS_STREAM_MAXLINES
+
+Install an event handler for an event of type wxpEVT_PROCESS_STREAM_MAXLINES exported on request by this module.
+The event subroutine will receive a Wx::Perl::ProcessStream::ProcessEvent when the external process produces
+a continuous stream of lines on stderr and stdout that exceed the max lines set via $process->SetMaxLines or
+Wx::Perl::ProcessStream->SetDefaultMaxLines.
+
+ EVT_WXP_PROCESS_STREAM_MAXLINES( $eventhandler, $codref );
+
=back
=head3 Methods
@@ -341,7 +408,7 @@
=head1 COPYRIGHT & LICENSE
-Copyright (C) 2007-2009 Mark Dootson, all rights reserved.
+Copyright (C) 2007-2010 Mark Dootson, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
@@ -376,8 +443,6 @@
Wx::ExecuteStdout
Wx::ExecuteStdoutStderr
-
-
=cut
@@ -403,20 +468,25 @@
# initialise
#-----------------------------------------------------
-our ($ID_CMD_EXIT, $ID_CMD_STDOUT, $ID_CMD_STDERR, $WXP_DEFAULT_CLOSE_ACTION, $WXPDEBUG);
+our ($ID_CMD_EXIT, $ID_CMD_STDOUT, $ID_CMD_STDERR, $ID_CMD_MAXLINES,
+ $WXP_DEFAULT_CLOSE_ACTION, $WXP_DEFAULT_MAX_LINES, $WXPDEBUG, $WX_YIELD_EXTENDED);
$ID_CMD_EXIT = Wx::NewEventType();
$ID_CMD_STDOUT = Wx::NewEventType();
$ID_CMD_STDERR = Wx::NewEventType();
+$ID_CMD_MAXLINES = Wx::NewEventType();
$WXP_DEFAULT_CLOSE_ACTION = wxSIGTERM;
+$WXP_DEFAULT_MAX_LINES = 1000;
our @EXPORT_OK = qw( wxpEVT_PROCESS_STREAM_EXIT
wxpEVT_PROCESS_STREAM_STDERR
wxpEVT_PROCESS_STREAM_STDOUT
+ wxpEVT_PROCESS_STREAM_MAXLINES
EVT_WXP_PROCESS_STREAM_STDOUT
EVT_WXP_PROCESS_STREAM_STDERR
EVT_WXP_PROCESS_STREAM_EXIT
+ EVT_WXP_PROCESS_STREAM_MAXLINES
wxpSIGTERM
wxpSIGKILL
);
@@ -428,15 +498,31 @@
our $ProcHandler = Wx::Perl::ProcessStream::ProcessHandler->new();
-sub wxpEVT_PROCESS_STREAM_EXIT () { $ID_CMD_EXIT }
-sub wxpEVT_PROCESS_STREAM_STDERR () { $ID_CMD_STDERR }
-sub wxpEVT_PROCESS_STREAM_STDOUT () { $ID_CMD_STDOUT }
+sub wxpEVT_PROCESS_STREAM_EXIT () { $ID_CMD_EXIT }
+sub wxpEVT_PROCESS_STREAM_STDERR () { $ID_CMD_STDERR }
+sub wxpEVT_PROCESS_STREAM_STDOUT () { $ID_CMD_STDOUT }
+sub wxpEVT_PROCESS_STREAM_MAXLINES () { $ID_CMD_MAXLINES }
sub wxpSIGTERM () { wxSIGTERM }
sub wxpSIGKILL () { wxSIGKILL }
-sub EVT_WXP_PROCESS_STREAM_STDOUT ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_STDOUT, $_[1] ) };
-sub EVT_WXP_PROCESS_STREAM_STDERR ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_STDERR, $_[1] ) };
-sub EVT_WXP_PROCESS_STREAM_EXIT ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_EXIT, $_[1] ) };
+sub EVT_WXP_PROCESS_STREAM_STDOUT ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_STDOUT, $_[1] ) };
+sub EVT_WXP_PROCESS_STREAM_STDERR ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_STDERR, $_[1] ) };
+sub EVT_WXP_PROCESS_STREAM_EXIT ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_EXIT, $_[1] ) };
+sub EVT_WXP_PROCESS_STREAM_MAXLINES ($$) { $_[0]->Connect(-1,-1,&wxpEVT_PROCESS_STREAM_MAXLINES, $_[1] ) };
+
+sub Yield {
+ if(defined($WX_YIELD_EXTENDED)) {
+ ($WX_YIELD_EXTENDED) ? Wx::wxTheApp->Yield(1) : Wx::wxTheApp->Yield();
+ } else {
+ eval { Wx::TheApp->Yield(1); };
+ if($@) {
+ $WX_YIELD_EXTENDED = 0;
+ Wx::wxTheApp->Yield();
+ } else {
+ $WX_YIELD_EXTENDED = 1;
+ }
+ }
+}
# Old interface - call Wx::Perl::ProcessStream::new
@@ -453,9 +539,14 @@
$WXP_DEFAULT_CLOSE_ACTION = ($newaction == wxSIGTERM||wxSIGKILL) ? $newaction : $WXP_DEFAULT_CLOSE_ACTION;
}
-sub GetDefaultAppCloseAction {
- $WXP_DEFAULT_CLOSE_ACTION;
-}
+sub GetDefaultAppCloseAction { $WXP_DEFAULT_CLOSE_ACTION; }
+
+sub SetDefaultMaxLines {
+ my $class = shift;
+ $WXP_DEFAULT_MAX_LINES = shift || 1;
+}
+
+sub GetDefaultMaxLines { $WXP_DEFAULT_MAX_LINES; }
sub GetPollInterval {
$ProcHandler->GetInterval();
@@ -551,11 +642,12 @@
my $procexitcode = $process->GetExitCode;
my $linedataread = 0;
-
+ my $maxlinecount = $process->GetMaxLines;
+ $maxlinecount = 1 if $maxlinecount < 1;
if(!$process->_exit_event_posted) {
# STDERR
-
+
while( ( my $linebuffer = $process->__read_error_line ) ){
$continueprocessloop ++;
$linedataread ++;
@@ -565,24 +657,27 @@
$event->SetLine( $linebuffer );
$event->SetProcess( $process );
$process->__get_handler()->AddPendingEvent($event);
+ last if $linedataread == $maxlinecount;
}
# STDOUT
-
- while( ( my $linebuffer = $process->__read_input_line ) ){
- $continueprocessloop ++;
- $linedataread ++;
- $linebuffer =~ s/(\r\n|\n)$//;
- my $event = Wx::Perl::ProcessStream::ProcessEvent->new( &Wx::Perl::ProcessStream::wxpEVT_PROCESS_STREAM_STDOUT, -1 );
- push(@{ $process->{_stdout_buffer} }, $linebuffer);
- $event->SetLine( $linebuffer );
- $event->SetProcess( $process );
- $process->__get_handler()->AddPendingEvent($event);
+ if( $linedataread < $maxlinecount ) {
+ while( ( my $linebuffer = $process->__read_input_line ) ){
+ $continueprocessloop ++;
+ $linedataread ++;
+ $linebuffer =~ s/(\r\n|\n)$//;
+ my $event = Wx::Perl::ProcessStream::ProcessEvent->new( &Wx::Perl::ProcessStream::wxpEVT_PROCESS_STREAM_STDOUT, -1 );
+ push(@{ $process->{_stdout_buffer} }, $linebuffer);
+ $event->SetLine( $linebuffer );
+ $event->SetProcess( $process );
+ $process->__get_handler()->AddPendingEvent($event);
+ last if $linedataread == $maxlinecount;
+ }
}
}
-
+
if(defined($procexitcode) && !$linedataread) {
# defer exit event until we think all IO buffers are empty
# post no more events once we post exit event;
@@ -593,16 +688,23 @@
$process->__get_handler()->AddPendingEvent($event);
}
- #Wx::wxTheApp->Yield;
+ # raise the maxline event if required
+ # this will be actioned during outer loop yield
+ if($linedataread == $maxlinecount) {
+ my $event = Wx::Perl::ProcessStream::ProcessEvent->new( &Wx::Perl::ProcessStream::wxpEVT_PROCESS_STREAM_MAXLINES, -1 );
+ $event->SetLine( undef );
+ $event->SetProcess( $process );
+ $process->__get_handler()->AddPendingEvent($event);
+ }
+
} # for my $process (@checkprocs) {
-
#-----------------------------------------------------------------
# yield to allow changes to $self->{_procs}
# we will not exit this outer loop until $continueprocessloop == 0
#-----------------------------------------------------------------
- Wx::wxTheApp->Yield();
+ Wx::Perl::ProcessStream::Yield();
} # while( $continueprocessloop ) {
@@ -697,8 +799,8 @@
my $self = $class->SUPER::new($_eventhandler);
$self->Redirect();
- $self->SetAppCloseAction($WXP_DEFAULT_CLOSE_ACTION);
-
+ $self->SetAppCloseAction(Wx::Perl::ProcessStream->GetDefaultAppCloseAction());
+ $self->SetMaxLines(Wx::Perl::ProcessStream->GetDefaultMaxLines());
$self->{_readlineon} = ( lc($readmethod) eq 'readline' ) ? 1 : 0;
if($self->{_readlineon} && ($Wx::VERSION < 0.75)) {
carp('A read method of "readline" cannot be used with Wx versions < 0.75. Reverting to default "read" method');
@@ -714,7 +816,6 @@
$self->{_stderr_buffer} = [];
$self->{_stdout_buffer} = [];
$self->{_arg_command} = $command;
-
return $self;
}
@@ -737,17 +838,19 @@
}
}
+sub SetMaxLines { $_[0]->{_max_read_lines} = $_[1]; }
+sub GetMaxLines { $_[0]->{_max_read_lines} }
+
sub __read_input_line {
my $self = shift;
my $linebuffer;
my $charbuffer = '0';
use bytes;
if($self->{_readlineon}) {
- #print qq(readline method used for pid: ) . $self->GetPid . qq(\n) if($Wx::Perl::ProcessStream::WXPDEBUG);
- if( $self->IsInputAvailable() && defined( my $tempbuffer = readline( $self->GetInputStream() ) ) ){
-
+ #print qq(readline method used for pid: ) . $self->GetPid . qq(\n) if($Wx::Perl::ProcessStream::WXPDEBUG);
+ if( $self->IsInputAvailable() && defined( my $tempbuffer = readline( $self->GetInputStream() ) ) ){
$linebuffer = $tempbuffer;
- }
+ }
} else {
#print qq(read method used for pid: ) . $self->GetPid . qq(\n) if($Wx::Perl::ProcessStream::WXPDEBUG);
while( $self->IsInputAvailable() && ( my $chars = read($self->GetInputStream(),$charbuffer,1 ) ) ) {
@@ -767,9 +870,9 @@
use bytes;
if($self->{_readlineon}) {
#print qq(readline method used for pid: ) . $self->GetPid . qq(\n) if($Wx::Perl::ProcessStream::WXPDEBUG);
- if( $self->IsErrorAvailable() && defined( my $tempbuffer = readline( $self->GetErrorStream() ) ) ){
+ if( $self->IsErrorAvailable() && defined( my $tempbuffer = readline( $self->GetErrorStream() ) ) ){
$linebuffer = $tempbuffer;
- }
+ }
} else {
#print qq(read method used for pid: ) . $self->GetPid . qq(\n) if($Wx::Perl::ProcessStream::WXPDEBUG);
while($self->IsErrorAvailable() && ( my $chars = read($self->GetErrorStream(),$charbuffer,1 ) ) ) {
@@ -836,6 +939,28 @@
return \@buffers;
}
+sub GetStdOutBufferLineCount {
+ my $self = shift;
+ return scalar @{ $self->{_stdout_buffer} };
+}
+
+sub GetStdErrBufferLineCount {
+ my $self = shift;
+ return scalar @{ $self->{_stderr_buffer} };
+}
+
+sub PeekStdOutBuffer {
+ my $self = shift;
+ my @buffers = @{ $self->{_stdout_buffer} };
+ return \@buffers;
+}
+
+sub PeekStdErrBuffer {
+ my $self = shift;
+ my @buffers = @{ $self->{_stderr_buffer} };
+ return \@buffers;
+}
+
sub GetProcessId {
my $self = shift;
return $self->{_processpid};
@@ -874,36 +999,23 @@
sub IsAlive {
my $self = shift;
- my $alive = Wx::Process::Kill( $self->GetProcessId(), wxSIGNONE );
-
- return 0 if $alive == wxKILL_NO_PROCESS;
-
- if( defined( $self->GetExitCode ) ) {
- # wait for a while to allow process to drop
- my $maxwait = 10.0; #seconds
- my $interval = 0.1; #seconds
- while($maxwait > 0.0) {
-
- $alive = Wx::Process::Kill( $self->GetProcessId(), wxSIGNONE );
- last if $alive != wxKILL_OK;
-
- $maxwait -= $interval;
- sleep ( $interval ) if $maxwait > 0.0;
- }
- }
-
- if( $alive == wxKILL_NO_PROCESS ) {
- return 0;
- } elsif( $alive == wxKILL_OK ) {
- return 1;
- } else {
- return undef;
- }
+
+ # if we already have the exitcode from the system
+ # we should return 0 - regardless if system tells
+ # us process is still hanging around - as it will
+ # sometimes
+
+ return 0 if defined( $self->GetExitCode );
+
+ # otherwise, return the system result
+
+ return ( Wx::Process::Exists( $self->GetProcessId() ) ) ? 1 : 0;
+
}
sub Destroy {
my $self = shift;
- Wx::Process::Kill($self->GetPid(), wxSIGKILL) if $self->IsAlive; # this will force us to wait for exit if we have received exit event
+ Wx::Process::Kill($self->GetPid(), wxSIGKILL) if $self->IsAlive;
$Wx::Perl::ProcessStream::ProcHandler->RemoveProc( $self );
$self->SUPER::Destroy;
$self = undef;
@@ -965,13 +1077,11 @@
return $clone;
}
-
package Wx::Perl::ProcessStream::ProcEvtHandler;
use strict;
use Wx 0.50 qw( wxID_ANY );
use base qw( Wx::Process );
use Wx::Event qw(EVT_END_PROCESS);
-
sub new {
my ($class, @args) = @_;
@@ -991,8 +1101,8 @@
$Wx::Perl::ProcessStream::Process::_runningpids->{$pid} = $exitcode;
}
-
1;
+
__END__
Modified: branches/upstream/libwx-perl-processstream-perl/current/t/01-events.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-processstream-perl/current/t/01-events.t?rev=54973&op=diff
==============================================================================
--- branches/upstream/libwx-perl-processstream-perl/current/t/01-events.t (original)
+++ branches/upstream/libwx-perl-processstream-perl/current/t/01-events.t Sun Mar 28 20:26:35 2010
@@ -3,7 +3,7 @@
package main;
use strict;
-use Test::More tests => 51 + $ENV{WXPPS_MULTITEST};
+use Test::More tests => 68 + $ENV{WXPPS_MULTITEST};
use lib 't';
use Wx;
use WxTesting qw( app_from_wxtesting_frame );
@@ -14,7 +14,7 @@
package ProcessStreamTestingFrame;
use strict;
use base qw(WxTesting::Frame);
-use Wx::Perl::ProcessStream 0.24 qw( :everything );
+use Wx::Perl::ProcessStream 0.27 qw( :everything );
use Test::More;
use Time::HiRes qw( sleep );
@@ -24,7 +24,8 @@
my $self = $class->SUPER::new( undef, -1, 'Testing Wx::Perl::ProcessStream ');
EVT_WXP_PROCESS_STREAM_STDOUT( $self, \&evt_process);
EVT_WXP_PROCESS_STREAM_STDERR( $self, \&evt_process);
- EVT_WXP_PROCESS_STREAM_EXIT( $self, \&evt_process);
+ EVT_WXP_PROCESS_STREAM_EXIT( $self, \&evt_process);
+ EVT_WXP_PROCESS_STREAM_MAXLINES( $self, \&evt_process);
$self->{_stdout} = [];
$self->{_stderr} = [];
$self->{_exitcode} = undef;
@@ -65,12 +66,12 @@
$process = undef;
}
-
if($^O =~ /^MSWin/) {
$cmd = [ $perl, '-e', q("print 'HELLO WORLD', qq(\n);") ];
} else {
$cmd = [ $perl, '-e', q(print 'HELLO WORLD', qq(\n);) ];
}
+
{
$process = $self->start_process_a( $cmd );
ok( $process->IsAlive() );
@@ -211,7 +212,7 @@
$process->WriteProcess(qq(WX TEST DATA\n));
$process->CloseInput();
}
- Wx::wxTheApp->Yield();
+ Wx::Perl::ProcessStream::Yield();
}
is( $process->IsAlive(), 0 );
@@ -248,7 +249,7 @@
foreach my $mpid (sort keys( %{ $self->{_multiresult} } ) ) {
$stillrunning ++ if(!defined($self->{_multiresult}->{$mpid}->{received}));
}
- Wx::wxTheApp->Yield();
+ Wx::Perl::ProcessStream::Yield();
}
}
for( @multiprocs ) {
@@ -265,6 +266,51 @@
# test group 7 - num procs should be zero
is(Wx::Perl::ProcessStream::ProcessCount(), 0, 'check process count is zero');
+
+
+ # test group 8 - maxline testing
+ {
+ $self->{_eventmode} = 'single';
+
+ if($^O =~ /^MSWin/) {
+ $cmd = [ $perl, '-e', q("$x = 1200; while($x){ print qq($x\n); $x--; };") ];
+ } else {
+ $cmd = [ $perl, '-e', q($x = 1200; while($x){ print qq($x\n); $x--; };) ];
+ }
+ $self->{_maxlineevtcount} = 0;
+ $process = $self->start_process_b( $cmd );
+ ok( $process->IsAlive() );
+ $self->wait_for_test_complete();
+ is( $process->IsAlive(), 0 );
+ is( $self->{_stdout}->[0], 1200 );
+ my $num = scalar @{$self->{_stdout}};
+ is( $self->{_stdout}->[$num -1], 1 );
+ is( $num, 1200 );
+ is( $self->{_exitcode}, 0 );
+ is( $process->GetExitCode() , 0 );
+ $process->Destroy;
+ $process = undef;
+ is( $self->{_maxlineevtcount}, 1 );
+
+ Wx::Perl::ProcessStream->SetDefaultMaxLines(10);
+ is( Wx::Perl::ProcessStream->GetDefaultMaxLines, 10 );
+ $self->{_maxlineevtcount} = 0;
+
+ $process = $self->start_process_b( $cmd );
+ ok( $process->IsAlive() );
+ $self->wait_for_test_complete();
+ is( $process->IsAlive(), 0 );
+ is( $self->{_stdout}->[0], 1200 );
+ $num = scalar @{$self->{_stdout}};
+ is( $self->{_stdout}->[$num -1], 1 );
+ is( $num, 1200 );
+ is( $self->{_exitcode}, 0 );
+ is( $process->GetExitCode() , 0 );
+ $process->Destroy;
+ $process = undef;
+ is( $self->{_maxlineevtcount}, 120 );
+
+ }
return 1;
}
@@ -292,7 +338,8 @@
sub wait_for_test_complete {
my $self = shift;
while(!defined($self->{_exitcode})) {
- Wx::wxTheApp->Yield();
+ Wx::Perl::ProcessStream::Yield();
+ sleep 0.1;
}
}
@@ -321,6 +368,8 @@
push(@{ $self->{_stdout} }, $line);
} elsif ( $evttype == wxpEVT_PROCESS_STREAM_STDERR) {
push(@{ $self->{_stderr} }, $line);
+ } elsif ( $evttype == wxpEVT_PROCESS_STREAM_MAXLINES) {
+ $self->{_maxlineevtcount} ++;
} elsif ( $evttype == wxpEVT_PROCESS_STREAM_EXIT) {
if( $self->{_eventmode} ne 'multi') {
$self->{_exitcode} = $process->GetExitCode();
Modified: branches/upstream/libwx-perl-processstream-perl/current/t/WxTesting.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwx-perl-processstream-perl/current/t/WxTesting.pm?rev=54973&op=diff
==============================================================================
--- branches/upstream/libwx-perl-processstream-perl/current/t/WxTesting.pm (original)
+++ branches/upstream/libwx-perl-processstream-perl/current/t/WxTesting.pm Sun Mar 28 20:26:35 2010
@@ -86,7 +86,7 @@
my $frameclass = &$framesub;
my $mainwindow = $frameclass->new(undef, -1, 'Wx Testing Frame');
$self->SetTopWindow($mainwindow);
- $mainwindow->Show(1);
+ #$mainwindow->Show(1);
return 1;
}
More information about the Pkg-perl-cvs-commits
mailing list