head     1.1;
branch   1.1.1;
access   ;
symbols  INITIAL:1.1.1.1 TOLKIEN:1.1.1;
locks    ; strict;
comment  @# @;


1.1
date     2002.09.03.09.15.12;  author tolkien;  state Exp;
branches 1.1.1.1;
next     ;

1.1.1.1
date     2002.09.03.09.15.12;  author tolkien;  state Exp;
branches ;
next     ;


desc
@@



1.1
log
@Initial revision
@
text
@#!/usr/bin/perl
# run CMUcl as backgroud process
# Joh Yong-iL <tolkien@@nownuri.net>

use POSIX;
use POSIX qw(setsid);
use POSIX ":sys_wait_h";
use IPC::Open3;
use IO::Select;
use IO::Handle;
use Socket;

my ($lin, $lout, $lerr, $sel, $pid);

  $lin  = new IO::Handle;
  $lout = new IO::Handle;
  $lerr = new IO::Handle;
  $sel = IO::Select->new();

  eval CMUcl_init;
  print "PID: $pid\n";

  my $port = 2000;
  my $proto = getprotobyname('tcp');
  socket(SERVER, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
  setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR,
                                pack("l", 1))  || die "setsockopt: $!";
  bind(SERVER, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
  listen(SERVER,SOMAXCONN)                     || die "listen: $!";

  my $paddr;

#  $SIG{CHLD} = \&REAPER;

    for ( ; $paddr = accept(CLIENT,SERVER); close CLIENT) {
        $ppid = POSIX::waitpid( $pid, &POSIX::WNOHANG );
        if ($ppid == $pid) {
            print "died \n";
            close CLIENT;
            $sel->remove($lin);
            $sel->remove($lout);
            $sel->remove($lerr);
            eval CMUcl_init;
        }

        do_lisp(CLIENT);
    }

sub CMUcl_init {
  my (@@ready, $fh, $ln);

# open3(\*WTRFH, \*RDRFH, \*ERRFH, 'some cmd and args', 'optarg', ...);
  $pid = open3($lin, $lout, $lerr, 'lisp -batch');
  print "start : $pid\n";

  $sel->add($lin);
  $sel->add($lout);
  autoflush $lout, 1;
  $sel->add($lerr);
  autoflush $lerr, 1;

  sleep 1;
  @@ready = $sel->can_read(1);
  foreach $fh (@@ready) {
      if ($fh == $lout) {
          $fh->sysread($ln, 1024);
          print $ln;
      }
  }
}

sub do_lisp {
    my $sock = shift;
    my $old_rslt = '';
    my ($halt, $fh, @@ready, $line, $result);

    if (!defined($line = $sock->getline())) {
        if ($sock->error()) {
            print "connection error %s", $sock->error();
        }
        return;
    }
    $line =~ s/\s+$//; # Remove CRLF

# IN
    @@ready = $sel->can_write(1);
    foreach $fh (@@ready) {
        if ($fh == $lin) {
            $fh->syswrite($line."\n", 1024);
        }
    }

    while (1) {
        $halt = 0;
        for(my $i=0; $i < 2; $i++) {
# OUTPUT
            @@ready = $sel->can_read(1);
            foreach $fh (@@ready) {
                if ($fh == $lout) {
                    $fh->sysread($result, 1023);
                    $halt = 1;
                }
            }
            if ($halt) { last; }

# ERR
            @@ready = $sel->has_error(1);
            foreach $fh (@@ready) {
                if ($fh == $lerr) {
                    $fh->sysread($result, 1023);
                    $halt = 2;
                }
            }
            if ($halt) { last; }
        }

        if ($result) {
            if ($old_rslt eq $result)   { last; }
            else                        { $old_rslt = $result; }
            my $rc = printf $sock ("%s\n", $result);
            if (!$rc) {
                print "connection error %s", $sock->error();
                return;
            }
        } else { last; }
    }
}
@


1.1.1.1
log
@initial from kang.sarang.net
@
text
@@
