On 11-May-00 Kirk Rogers wrote:
> Would you be willing to share the programs???...I would like to perform a
> similar task and am struggling to get off first base.
> 
> Thanks,
> Kirk

Hello Kirk,

I've attached a modified version (I've added a few englisch comments to the
code) of my netbuf.pl program. 
To use it, you have to edit the file and replace the command to execute in the
open call with whatever you want. The program take's only one argument, the
port to use for incoming connections. If none is specified, it will use 8765.

There is a little "strange" behavior when more than one client connects to this
server: it won't see the first two lines in the buffer because of the way I
poll for the output of the backend program - but it works for my purposes. If
only one display client connects everything is very fine. If you need more than
one client with all data from the backend, than I would use a multiplexer
server (read via socket from netbuf.pl and write to all connected clients).


Greetings, Dieter

>  -----Original Message-----
> From:         Dieter Gobbers [mailto:[EMAIL PROTECTED]] 
> Sent: Thursday, May 11, 2000 5:07 AM
> To:   Perl-Win32-Users Mailing List
> Cc:   Perl-Win32-Users Mailing List
> Subject:      Re: Communicating between Perl/Tk and child processes
> 
> 
> On 10-May-00 Anthony George wrote:
>> Take a look at http://www.generation.net/~aminer/Perl/, specifically the
>> MemMap module, I use this to take between a Win32::GUI interface and a
>> 'worker'(no-console app)...
> 
> Meanwhile I've found another, portable solution:
>  My worker process is started by a "glue" program which reads the output
> from
> the worker and sends the data over a socket connection to my Perl/Tk
> program.
>  My Perl/Tk program runs in a endless loop, updating the windows, using
> select
> to poll for new data from the socket and process the data (if something is
> available ;-). I've tried to do that with fileevent, but I had no luck.
> 
> 
> 
> 
>>>tony
>> 
>> Dieter Gobbers wrote:
>> 
>>> On 01/07/00, ""Melissa Matthews" <[EMAIL PROTECTED]>" wrote:
>>> > I am using Perl/Tk on a win32 platform.  We would like to be able to
>>> > execute a second perl script and get progress statements back from it
> as
>>> > it is running that can be displayed in the Tk interface.  We tried
>>> > (unsuccessfully) to use fileevent.  Is anyone doing something
>>> > like this with pipes or anything else?
>>>
>>> Have you got an answer to this? I'm trying the same and i've been
>>> unsuccessful doing it on win32. My scripts are running like a charm under
>>> Solaris...
>>> I use ActivePerl 5.005 btw.
>>>
>>> Dieter
> 
> 
> 
> Dieter Gobbers
> UNIX Systems and Network Administrator
> -- 
> im Auftrag des FAW Ulm (http://www.faw.uni-ulm.de)
> 
> Ingenieurbuero Dieter Gobbers; Unix- und Netzwerkberatung und -betreuung
> Kreuzstr. 19, 89160 Dornstadt, Tel.: 07348/928538
> email: [EMAIL PROTECTED], http://www.gobbers.de
> 
> ---
> You are currently subscribed to perl-win32-users as: [EMAIL PROTECTED]
> To unsubscribe, forward this message to
>          [EMAIL PROTECTED]
> For non-automated Mailing List support, send email to  
>          [EMAIL PROTECTED]

Dieter Gobbers
UNIX Systems and Network Administrator
-- 
im Auftrag des FAW Ulm (http://www.faw.uni-ulm.de)

Ingenieurbuero Dieter Gobbers; Unix- und Netzwerkberatung und -betreuung
Kreuzstr. 19, 89160 Dornstadt, Tel.: 07348/928538
email: [EMAIL PROTECTED], http://www.gobbers.de
#!/amd/bin/perl -w

#
# Because (ActiveState) Perl for Win32 cannot use select on filehandles
# i use this programm as a filehandle to socket wrapper
# It takes as first argument a portnumber, default is 8765
# The program to be wrapped has is currently hardcoded (see open)
#

use strict;
use IO::Socket;
use IO::Select;

my $pid=0;
if ( $  eq "MSWin32" ) {
        $pid=open(ANALYSE,"perl analyse.pl|");
} else {
        $pid=open(ANALYSE,"analyse.pl|");
}


my $port = $ARGV[0] ? $ARGV[0] : 8765;

my $listener = IO::Socket::INET->new(   LocalPort => $port,
                                        Listen => 5,
                                        Reuse => 1);

die "Can't create socket for listening: $!\n" unless $listener;
print STDERR "$0: Listening for connections on port $port\n";

my $readable = IO::Select->new;
my $writeable = IO::Select->new;
$readable->add($listener);
my $count=0;

while (1) {
        my ($ready,$writey) = IO::Select->select($readable,$writeable,undef,unde
f);
        foreach my $s (@$ready) {
                if ($s == $listener) {
                        print STDERR "New connection\n";
                        my $new_sock = $listener->accept;
                        $writeable->add($new_sock) if $new_sock;
                        $readable->add($new_sock) if $new_sock;
                        $count++;
                } else {
                        # This is a leftover from another test
                        # if the display program sends us "goodbye" we
                        # close the connection
                        my $buf = <$s>;
                        if (defined $buf) {
                                if ($buf =~ /goodbye/i) {
                                        print $s "See you later!\n";
                                        $readable->remove($s);
                                        $writeable->remove($s);
                                        $s->close;
                                        $count--;
                                } else {
                                        print $s "You said: $buf\n";
                                }
                        } else {
                                $readable->remove($s);
                                $writeable->remove($s);
                                $count--;
                                $s->close;
                                print STDERR "Client has closed connection\n";
                        }
                }
        }
        my $linebuffer="";
        if ((scalar(@$writey) == $count) && $count>0)  {
                if (eof(ANALYSE)) {
                        print STDERR "Unexpected EOF from backend program.\n";
                        close (ANALYSE);
                        exit(0);
                } else {
                        $linebuffer = <ANALYSE>;
                        exit (0) if (not defined $linebuffer);
                }
        }
        foreach my $s (@$writey) {
                print $s $linebuffer;
        }
        # If we read a line beginning with "Fertig", the exit the wrapper
        # because the backend program has done it's work
        if ($linebuffer =~ /^Fertig:/) {
                print STDERR "netbuf: backend program has send it's exit sequence\n";
                close(ANALYSE);
                foreach my $s (@$writey) {
                        close($s);
                }
                exit(0);
        }
}

Reply via email to