view release on metacpan or  search on metacpan

web/bin/uplug-server.pl  view on Meta::CPAN

#!/usr/bin/perl
#---------------------------------------------------------------------------
# server.pl
#
#---------------------------------------------------------------------------
# Copyright (C) 2004 Jörg Tiedemann  <joerg@stp.ling.uu.se>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#---------------------------------------------------------------------------

require 5.002;
use strict;

use FindBin qw($Bin);
use POSIX qw(uname);
use CGI qw/:standard/;
use Fcntl qw(:DEFAULT :flock);
use vars qw($UPLUGHOME $UPLUGDATA $UPLUGCWB $UPLUG $LogFile);

######################################################################

BEGIN{
    setpgrp(0,0);              # become leader of the process group

    $UPLUGDATA = '/corpora/OPUS/UPLUG';
    $UPLUGCWB  = $UPLUGDATA.'/cwb/';
    $LogFile   = "$UPLUGDATA/.process/.serverlog";
    $UPLUGHOME = "$Bin/../..";
    $UPLUG=$UPLUGHOME.'/uplug';

    $ENV{UPLUGHOME}=$UPLUGHOME;
    $ENV{UPLUGDATA}=$UPLUGDATA;
    #$SIG{TERM} = \&interrupt;
    #$SIG{INT} = \&interrupt;
}

######################################################################

use lib $UPLUGHOME;
use Uplug::Web::Process;
use Uplug::Web::Corpus;
use Uplug::Web::User;
use Uplug::Web::Process::Lock;


my $HOST=(uname)[1];
my $ME=(getpwuid($>))[0];

our $OUTPUT;       # file to store stdout
our $LOCK;         # lock file for $OUTPUT
our $TempDir;      # temporary directory for running processes

######################################################################

END{
    if (-d $TempDir){
	chdir '/';
	system "rm -fr $TempDir";
    }
    local $SIG{HUP}='IGNORE';  # ignore HANGUP signal for right now
    kill ('HUP',-$$);          # kill child processes before you die
}

######################################################################

# don't start if already running or if not alone!!

if (&nmbr_running('uplug-server.pl')){&my_die("already running!");}
my @u=`w | sed '1,2d' | cut -f1 -d ' ' | sort | uniq | grep -v '$ME'`;
if (@u){&my_die("I'm not alone!");}


######################################################################


my @data=();
my $pid=fork();                              # create a new child process


#----------------------------------------------------------------------------
# this is the parent:
#   * check if I'm alone anbd die if not
#----------------------------------------------------------------------------

if ($pid){
    local $SIG{HUP}= sub { &my_die("$$: got hangup signal!") };
    local $SIG{CHLD}= sub { if (wait() eq $pid){&my_die("server stopped!");} };
    while (1){
	my @u=`w | sed '1,2d' | cut -f1 -d ' ' | sort | uniq | grep -v '$ME'`;
	if (@u){&my_die("I'm not alone!");}
	sleep(2);
    }
}



#----------------------------------------------------------------------------
# this is the child process (the actual server):
#     * get the next process
#     * run it and check the return value
#     * move process to 'failed' if there were any problems!
#----------------------------------------------------------------------------

else{

    local $SIG{HUP} = \&interrupt;