[popfile-commit] engine/Proxy Proxy.pm,1.30,1.31

[<ssc...@us...>]

Update of /cvsroot/popfile/engine/Proxy
In directory sc8-pr-cvs1:/tmp/cvs-serv4497

Modified Files:
	Proxy.pm 
Log Message:
normalize pipe behaviour to account for platform incompatibilities

Index: Proxy.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/Proxy.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -C2 -d -r1.30 -r1.31
*** Proxy.pm	1 Aug 2003 01:11:28 -0000	1.30
--- Proxy.pm	21 Aug 2003 19:47:36 -0000	1.31
***************
*** 23,26 ****
--- 23,28 ----
  #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  #
+ #   Modified by     Sam Schinke (ssc...@us...)
+ #
  # ---------------------------------------------------------------------------------------------
  
***************
*** 40,44 ****
  # new
  #
! #   Class new() function, all real work gets done by initialize and 
  #   the things set up here are more for documentation purposes than
  #   anything so that you know that they exists
--- 42,46 ----
  # new
  #
! #   Class new() function, all real work gets done by initialize and
  #   the things set up here are more for documentation purposes than
  #   anything so that you know that they exists
***************
*** 66,69 ****
--- 68,75 ----
      $self->{flush_child_data_} = \&flush_child_data_;
  
+     # Holding variable for MSWin32 pipe handling
+ 
+     $self->{pipe_cache__};
+ 
      # This is the error message returned if the connection at any
      # time times out while handling a command
***************
*** 187,190 ****
--- 193,249 ----
  }
  
+ 
+ # ---------------------------------------------------------------------------------------------
+ #
+ # read_pipe_
+ #
+ # reads a single message from a pipe in a cross-platform way.
+ # returns undef if the pipe has no message
+ #
+ # $handle   The handle of the pipe to read
+ #
+ # ---------------------------------------------------------------------------------------------
+ 
+ sub read_pipe_
+ {
+     my ($self, $handle) = @_;
+ 
+     if ( $^O eq "MSWin32" ) {
+ 
+         # PLATFORM SPECIFIC CODE
+         # bypasses bug in -s $pipe under ActivePerl
+ 
+         my $message;
+ 
+         if ( ( $self->{pipe_cache__} eq '' ) && &{ $self->{pipeready_} }($handle) ) {
+ 
+             # refill the cache when it is empty
+ 
+             sysread($handle, my $string, -s $handle);
+ 
+             # push messages onto the end of our cache
+ 
+             $self->{pipe_cache__} .= $string;
+         }
+ 
+         # pop the oldest message;
+ 
+         $message = $1 if ($self->{pipe_cache__} =~ s/(.*?\n)//);
+ 
+         return $message;
+ 
+     } else {
+ 
+         # do things normally
+ 
+         if ( &{ $self->{pipeready_} }($handle) ) {
+             return <$handle>;
+         }
+     }
+ 
+     return undef;
+ }
+ 
+ 
  # ---------------------------------------------------------------------------------------------
  #
***************
*** 205,239 ****
      my $stats_changed = 0;
  
!     while ( &{$self->{pipeready_}}($handle) )
!     {
!         my $message = <$handle>;
! 
!         if ( defined( $message ) ) {
!             $message =~ s/[\r\n]//g;
  
!             $self->log_( "Child proxy message $message" );
  
!             if ( $message =~ /CLASS:(.*)/ ) {
  
!                 # Post a message to the MQ indicating that we just handled
!                 # a message with a specific classification
  
!                 $self->mq_post_( 'CLASS', $1, '' );
!             }
  
!             if ( $message =~ /NEWFL:(.*)/ ) {
!                 $self->mq_post_( 'NEWFL', $1, '' );
!             }
  
!             if ( $message =~ /LOGIN:(.*)/ ) {
!                 $self->mq_post_( 'LOGIN', $1, '' );
!             }
!         } else {
!             # This is here so that we get in errorneous position where the pipeready
!             # function is returning that there's data, but there is none, in fact the
!             # pipe is dead then we break the cycle here.  This was happening to me when
!             # I tested POPFile running under cygwin.
  
!             last;
          }
      }
--- 264,289 ----
      my $stats_changed = 0;
  
!     my $message;
  
!     while ( ($message = $self->read_pipe_( $handle )) && defined($message) )
!     {
!         $message =~ s/[\r\n]//g;
  
!         $self->log_( "Child proxy message $message" );
  
!         if ( $message =~ /CLASS:(.*)/ ) {
  
!             # Post a message to the MQ indicating that we just handled
!             # a message with a specific classification
  
!             $self->mq_post_( 'CLASS', $1, '' );
!         }
  
!         if ( $message =~ /NEWFL:(.*)/ ) {
!             $self->mq_post_( 'NEWFL', $1, '' );
!         }
  
!         if ( $message =~ /LOGIN:(.*)/ ) {
!             $self->mq_post_( 'LOGIN', $1, '' );
          }
      }