|
From: <ssc...@us...> - 2003-08-21 22:00:36
|
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, '' );
}
}
|