$this->{START_CMD} = "$this->{R_BIN} --slave --vanilla" ; #### sub send { my $CLASS_HPLOO ; $CLASS_HPLOO = $this if defined $this ; my $this = UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : $CLASS_HPLOO ; my $class = ref($this) || __PACKAGE__ ; $CLASS_HPLOO = undef ; my $cmd = shift(@_) ; $cmd =~ s/\r\n?/\n/gs ; $cmd .= "\n" if $cmd !~ /\n$/ ; $cmd =~ s/\n/\r\n/gs ; while ( $this->is_blocked ) { sleep(1) ;} my $n = $this->read_processR ; $n = 1 if $n eq '0' || $n eq '' ; my $file = "$this->{LOG_DIR}/input.$n.r" ; while( -e $file || -e "$file._" ) { ++$n ; $file = "$this->{LOG_DIR}/input.$n.r" ; } open (my $fh,">$file._") ; print $fh "$cmd\n" ; close ($fh) ; chmod(0777 , "$file._") ; $this->{OUTPUT_R_POS} = -s $this->{OUTPUT_R} ; rename("$file._" , $file) ; my $has_quit = 1 if $cmd =~ /^\s*(?:q|quit)\s*\(.*?\)\s*$/s ; ##print "CMD[$n]$has_quit>> $cmd\n" ; my $status = 1 ; my $delay = 0.02 ; my ($x,$xx) ; while( (!$has_quit || $this->{STOPING} == 1) && -e $file && $this->is_started( !$this->{STOPING} ) ) { ++$x ; ##print "sleep $file\n" ; select(undef,undef,undef,$delay) ; if ( $x == 20 ) { my (undef , $data) = $this->read_processR ; if ( $data =~ /\s$n\s+\.\.\.\s+\// ) { last ;} $x = 0 ; ++$xx ; $delay = 0.5 ; } if ( $xx > 5 ) { $status = undef ;} ## xx > 5 = x > 50 } if ( $has_quit && !$this->{STOPING} ) { $this->stop(1) ;} return $status ; } #### sub read { my $CLASS_HPLOO ; $CLASS_HPLOO = $this if defined $this ; my $this = UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : $CLASS_HPLOO ; my $class = ref($this) || __PACKAGE__ ; $CLASS_HPLOO = undef ; my $timeout = shift(@_) ; $timeout = -1 if $timeout eq '' ; open (my $fh, $this->{OUTPUT_R} ) ; binmode($fh) ; seek($fh , ($this->{OUTPUT_R_POS}||0) , 0) ; my $time = time ; my ($x,$data) ; while( $x == 0 || (time-$time) <= $timeout ) { ++$x ; my $s = -s $this->{OUTPUT_R} ; my $r = read($fh , $data , ($s - $this->{OUTPUT_R_POS}) , length($data) ) ; $this->{OUTPUT_R_POS} = tell($fh) ; last if !$r ; } close($fh) ; my @lines = split(/(?:\r\n?|\n)/s , $data) ; return @lines if wantarray ; return join("\n", @lines) ; }