Re: [PERL] Fejlmeddelse

[Bo Pedersen <sslug@sslug>]

Anders Sønderberg Mortensen wrote:

> Hej Bo,
>
> Kan du give et udsnit af din kode, der genererer fejlmeddelelsen?


Klart!

/Bo

#! /usr/bin/perl -wd
#
# $Id: service.pl,v 1.9 2001/12/31 13:25:48 work Exp work $
#
# perl wrapper turning C app into network service
# sends input sentence to wrapped app and passes
# response back to lcient until a the EOF pattern
# is encoutered.
#
# Normally connected to from cgi script when the application
# is slow to start.
#
# run this program in the background before any requests are made.
# service.pl <parser command>
#

use IO::Socket;
use IPC::Open2;
use strict;

# open a socket to recieve incoming requests
my $socket = IO::Socket::INET->new( LocalAddr=>"localhost:9995",
                                    Listen=>1, Reuse=>1 ) or die;

# comand to start up parser taken from command line
my $command = @ARGV ? "@ARGV" : "/home/rob/textparser -p 
/home/rob/noflt90inf5frq11cxtIndexFile -ls 2000 -lm 2000";
my $maxdata = 10_000; # limit of 10mb memory
my $timeout = 1; # max 1 second for results
my $pid;

$SIG{PIPE} = sub { warn "parser died" };
$SIG{ALRM} = sub {
    warn "parser times out";
    kill 9, $pid;
};

sub startup {
    $pid = open2( RESULTS=> INPUT=> "ulimit -d $maxdata; $command" ) or 
die;
    warn "Started parser [$pid]: '$command'";

    # set pipe through to parser to flush automatically
    select INPUT; $|=1; select STDOUT;

    # mop up the first prompt from parser
    <RESULTS>;
    warn "read the query prompt";
}

startup();

while( 1 ) {
    eval{
        my $request = $socket->accept() or next;
        my @query = split /=/, $request->getline();
        warn "read sslug@sslug: @query";

        #query now contains type and value rather than handling query 
type in cgi
        foreach my $half (@query) {

                chomp($half); #remove any existing LF
                while ( not print INPUT $half, "\n" ) {
                        startup();
                }

                warn ">> sent through: $half ... at ".localtime $^T;
                alarm $timeout;

                while ( 1 ) {
                        my $out = <RESULTS>;

#                        warn ">> read: $out ... at".localtime $^T;

                        # EOF from parser
                        if ( not defined $out ) {
                        warn "Parser crash?";
                        startup();
                        last;
                        }

                        # check if parser is waiting for new input
                        # patch this to match program's prompt
                        last if $out =~ /Query/;
                        last if $out =~ /^Input/;

                        # format numbers into table if not 
"Processing..." line
                        print $request $out;
                }
        }
    };
    warn $@ if $@;

    alarm 0; # cancel timeout
    warn ">> finished ".localtime $^T;
}

> Cheerio,
>
> --Anders
>
> On Wed, 24 Apr 2002, Bo Pedersen wrote:
>
>
> > Hej
> >
> > Jeg har et perlprogram som agerer portservice for et cgi-script.
> > Perlprogrammet kalder et C-program. Programmet virker på en vens RH
> > server men ikke på min. Hvis jeg singlestepper får jeg på et tidspunkt
> > følgende frem:
> >
> >   DB<2> IPC::Open3::xfork(/usr/lib/perl5/5.6.0/IPC/Open3.pm:120):
> > 120:        defined $pid or croak "$Me: fork failed: $!";
> > ######### Forked, but do not know how to change a TTY. #########
> >   Define $DB::fork_TTY
> >        - or a function DB::get_fork_TTY() which will set $DB::fork_TTY.
> >   The value of $DB::fork_TTY should be the name of TTY to use.
> >   On UNIX-like systems one can get the name of a TTY for the given window
> >   by typing tty, and disconnect the shell from TTY by sleep 1000000.
> >   DB<2>
> >
> > Siger det nogen noget?
> >
> > /Bo
> >
> > --
> > Bo Pedersen, Center for Sprogteknologi, cst.dk,  35329069, 28312518


--
Bo Pedersen, Center for Sprogteknologi, cst.dk,  35329069, 28312518