r54975 - in /trunk/libwx-perl-processstream-perl: Changes META.yml README debian/changelog 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:32:09 UTC 2010


Author: chrisb
Date: Sun Mar 28 20:31:54 2010
New Revision: 54975

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=54975
Log:
Integrating new upstream release 0.27

Modified:
    trunk/libwx-perl-processstream-perl/Changes
    trunk/libwx-perl-processstream-perl/META.yml
    trunk/libwx-perl-processstream-perl/README
    trunk/libwx-perl-processstream-perl/debian/changelog
    trunk/libwx-perl-processstream-perl/lib/Wx/Perl/ProcessStream.pm
    trunk/libwx-perl-processstream-perl/t/01-events.t
    trunk/libwx-perl-processstream-perl/t/WxTesting.pm

Modified: trunk/libwx-perl-processstream-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwx-perl-processstream-perl/Changes?rev=54975&op=diff
==============================================================================
--- trunk/libwx-perl-processstream-perl/Changes (original)
+++ trunk/libwx-perl-processstream-perl/Changes Sun Mar 28 20:31:54 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: trunk/libwx-perl-processstream-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwx-perl-processstream-perl/META.yml?rev=54975&op=diff
==============================================================================
--- trunk/libwx-perl-processstream-perl/META.yml (original)
+++ trunk/libwx-perl-processstream-perl/META.yml Sun Mar 28 20:31:54 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: trunk/libwx-perl-processstream-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwx-perl-processstream-perl/README?rev=54975&op=diff
==============================================================================
--- trunk/libwx-perl-processstream-perl/README (original)
+++ trunk/libwx-perl-processstream-perl/README Sun Mar 28 20:31:54 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: trunk/libwx-perl-processstream-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwx-perl-processstream-perl/debian/changelog?rev=54975&op=diff
==============================================================================
--- trunk/libwx-perl-processstream-perl/debian/changelog (original)
+++ trunk/libwx-perl-processstream-perl/debian/changelog Sun Mar 28 20:31:54 2010
@@ -1,8 +1,12 @@
-libwx-perl-processstream-perl (0.24-2) UNRELEASED; urgency=low
+libwx-perl-processstream-perl (0.27-1) UNRELEASED; urgency=low
 
+  [ Damyan Ivanov ]
   * add -a option to xvfb-run invocation
 
- -- Damyan Ivanov <dmn at debian.org>  Mon, 15 Mar 2010 08:39:36 +0200
+  [ Chris Butler ]
+  * New upstream release
+
+ -- Chris Butler <chrisb at debian.org>  Sun, 28 Mar 2010 21:27:29 +0100
 
 libwx-perl-processstream-perl (0.24-1) unstable; urgency=low
 

Modified: trunk/libwx-perl-processstream-perl/lib/Wx/Perl/ProcessStream.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwx-perl-processstream-perl/lib/Wx/Perl/ProcessStream.pm?rev=54975&op=diff
==============================================================================
--- trunk/libwx-perl-processstream-perl/lib/Wx/Perl/ProcessStream.pm (original)
+++ trunk/libwx-perl-processstream-perl/lib/Wx/Perl/ProcessStream.pm Sun Mar 28 20:31:54 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: trunk/libwx-perl-processstream-perl/t/01-events.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwx-perl-processstream-perl/t/01-events.t?rev=54975&op=diff
==============================================================================
--- trunk/libwx-perl-processstream-perl/t/01-events.t (original)
+++ trunk/libwx-perl-processstream-perl/t/01-events.t Sun Mar 28 20:31:54 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: trunk/libwx-perl-processstream-perl/t/WxTesting.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libwx-perl-processstream-perl/t/WxTesting.pm?rev=54975&op=diff
==============================================================================
--- trunk/libwx-perl-processstream-perl/t/WxTesting.pm (original)
+++ trunk/libwx-perl-processstream-perl/t/WxTesting.pm Sun Mar 28 20:31:54 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