#!/opt/local/bin/perl -w
#
#       Glue Logic  Server
#                               Copyright (c) 1995-1999  Masayuki Takata
#
#               This software is provided "AS IS" with "NO WARRANTY".
#               Entire risk on using this software is with you.


BEGIN {
    $RCSstring = q$Id: Server,v 1.6 1999/11/19 06:40:22 takata Exp $;
    print STDERR <<"ETX";
Glue Logic  Server System\t\t\t\t(c)1995-1997  M. Takata
\tRCS $RCSstring

ETX
}

use Socket;
use English;

require "sys/errno.ph";


########################################################################
################					################
################	M a i n   R o u t i n e		################
################					################
########################################################################


########
#	Open Transaction Channel Socket

$GluePort = 9669;
$GluePort = $ARGV[0] if $ARGV[0];
chomp($ServerName = `hostname`);
$sockaddr = 'S n a4 x8';

AGAIN: ;
($name, $aliases, $ProtoTCP) = getprotobyname('tcp');
($name, $aliases, $type, $len, $ServerAddr ) = gethostbyname($ServerName);
$Trans = pack($sockaddr, AF_INET, $GluePort,  $ServerAddr);

socket(AcceptS, AF_INET, SOCK_STREAM, $ProtoTCP) || die "socket: $!";
bind(AcceptS, $Trans) || ( $GluePort ++, goto AGAIN );# die "bind: $!";
listen(AcceptS, 5) || die "listen: $!";
select(AcceptS); $OUTPUT_AUTOFLUSH = 1;
select(STDOUT);  $OUTPUT_AUTOFLUSH = 1;
select(STDERR);  $OUTPUT_AUTOFLUSH = 1;

print "PORT: $GluePort\n";

sub ShutdownChannel {
    for ($i=$MaxFn; $i>3; $i--) {
	close($FileHandle[$i]) if defined $FileHandle[$i];   }
    shutdown(AcceptS,2); exit(0);
}
$SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = $SIG{'TSTP'} = 'ShutdownChannel';
$SIG{'TTIN'} = 'IGNORE';
END { shutdown(AcceptS,2); }

########
#	Setup for Select System Call

$FileDescs = '';
vec( $FileDescs, $AcceptFn = fileno(AcceptS), 1 ) = 1;
vec( $FileDescs, $StdinFn = fileno(STDIN), 1 ) = 1;
printf "fileno ... %d %d $AcceptFn  $StdinFn\n", fileno(STDOUT), fileno(STDERR);
#die "Nanka hen...\n" unless ($AcceptFn == 3);
#die "Nanka hen...\n" unless ($StdinFn == 0);
$MaxFn = $LastFn = $AcceptFn;
$ChSeq = 1;


########
##	Arrays for Socket Management
##
##	FileHandle[]:	fileno -> FILEHANDLE
##	NetAddr[]:	fileno -> "hostname:port"
##	MesgFileNo[]:	fileno -> corresponding Message Socket fileno
##	OpenHandle{}:	FILEHANDLE -> opened:1 or closed:0

%OpenHandle = ();

########
#	Main Loop

print STDERR "Entering Main Loop ...\n";
for(;;) {
    $found = select( $Descs=$FileDescs, undef, undef, undef );
    print STDERR "select: $!" if $found < 0;
    next if $found <= 0;

    if ( vec( $Descs, $StdinFn,  1 ) ) {   &ServerConsole;    next;   }
    if ( vec( $Descs, $AcceptFn, 1 ) ) {   &AcceptConnection; next;   }

    for ( $NextFn = $LastFn+1; $NextFn <= $MaxFn; $NextFn++ ) {
	last if ( vec( $Descs, $NextFn, 1 ) );   }
    if ( $NextFn > $MaxFn ) {
	for ($NextFn = $AcceptFn+1; $NextFn <= $MaxFn; $NextFn++) {
	    last if ( vec( $Descs, $NextFn, 1 ) );   }   }
    next if ( $NextFn > $MaxFn );

    $TS = $FileHandle[$NextFn];
    $MS = $FileHandle[$MesgFileNo[$NextFn]];
    if ( eof $TS ) {
print STDERR "Aborting#$NextFn  Handle: $TS & $MS\n";
	&CloseChannel(); next;   }
    select($TS); $OUTPUT_AUTOFLUSH = 1;
    select($MS); $OUTPUT_AUTOFLUSH = 1; select(STDERR);

    $ChannelCloseFlag = 0;
    undef %OldValues;
    undef %TriggeredName;

    chomp ( $LineIn = <$TS> );
    $LineOut = &MainProcess( $LineIn );
    print $TS "$LineOut\n";
    &PostProcess();
    $LastFn = $NextFn;

    if ( $ChannelCloseFlag ) {
print STDERR "Closing#$NextFn  Handle: $TS & $MS\n";
	&CloseChannel();   }
}

exit;


sub CloseChannel {
    print STDERR "TS:[$TS](", fileno($TS), ") MS:[$MS](", fileno($MS), ")\n";
    print $MS "!DisconnectChannel\n";
    close( $MS ); close( $TS );
    undef $FileHandle[$NextFn];
    undef $FileHandle[$MesgFileNo[$NextFn]];
    undef $NetAddr[$NextFn];
    undef $NetAddr[$MesgFileNo[$NextFn]];
    undef $MesgFileNo[$NextFn];
    delete $OpenHandle{$MS};
    vec( $FileDescs, $NextFn, 1 ) = 0;
    $LastFn = 3;
}



########
#	Accept Connections

sub AcceptConnection {
    local($TrnsS, $TrnsFn, $MesgS, $MesgFn, $addr, $af, $port, $inetaddr);

    ########
    #	    Opening Sockets
    $TrnsS = 'TransCh#' . ($ChSeq++);
print STDERR "Accepting at $TrnsS\n";
    ( $addr = accept($TrnsS, AcceptS) ) || die "AcceptConnection: $!";
    select($TrnsS); $OUTPUT_AUTOFLUSH = 1;
    select(STDERR); $OUTPUT_AUTOFLUSH = 1;
    $IPPROTO_TCP = 6; $TCP_NODELAY = 0x01;
    setsockopt( $TrnsS, $IPPROTO_TCP, $TCP_NODELAY, 1 );

    ########
    #	    Check if correct connection initiation
    chomp( $InitialLine = <$TrnsS> );
print STDERR "[$InitialLine]\n";
    unless ( ($ClientSpec, $MesgS)
	= ($InitialLine =~ /^!InitiateChannel\s+(\S+)\s+(\S+)/o) ) {
	    close( $TrnsS );	return; }

    ########
    #	    Message Channel Identifier Check
    if ( $OpenHandle{$MesgS} ) {
	print $TrnsS "Duplicate Agent ID\n";
	return undef;
    } else {
	print $TrnsS "Greeting $RCSstring\n";
    }

    ########
    #	    Message Channel Destination
    ( $ClientHost, $MesgPort ) = ( $ClientSpec =~ /^([^:]+):([0-9]+)$/io );
    print STDERR "Connecting Message Socket to $ClientHost:$MesgPort\n";

    ########
    #	    Message Channel Connection
    ($name, $aliases, $type, $len, $ClientAddr) = gethostbyname($ClientHost);
    $ServerEnd = pack( $sockaddr, AF_INET, 0,         $ServerAddr );
    $ClientEnd = pack( $sockaddr, AF_INET, $MesgPort, $ClientAddr );

    ( warn($!), close( $TrnsS ), return )
	unless( socket($MesgS, AF_INET, SOCK_STREAM, $ProtoTCP) );
    ( warn($!), close( $TrnsS ), return )
	unless( bind($MesgS, $ServerEnd) );
    ( warn($!), close( $TrnsS ), return )
	unless( connect($MesgS, $ClientEnd) );
    print STDERR "Message Socket Connected Successfully\n";
    $IPPROTO_TCP = 6; $TCP_NODELAY = 0x01;
    setsockopt( $MesgS, $IPPROTO_TCP, $TCP_NODELAY, 1 );
    select($MesgS); $OUTPUT_AUTOFLUSH = 1;
    select(STDERR); $OUTPUT_AUTOFLUSH = 1;

    ########
    #	    Management Data update

    vec( $FileDescs, $TrnsFn = fileno($TrnsS), 1 ) = 1;
    $MesgFileNo[$TrnsFn] = $MesgFn = fileno($MesgS);

    $FileHandle[$TrnsFn] = $TrnsS;
    $FileHandle[$MesgFn] = $MesgS;

    ($af,$port,$inetaddr) = unpack($sockaddr, $addr);
    $NetAddr[$TrnsFn] = join('.', unpack('C4', $inetaddr)) . ":$port";
    $NetAddr[$MesgFn] = $ClientSpec;

    $OpenHandle{$MesgS} = 1;
    print $MesgS "!Greeting\n";
#$dummy = <$MesgS>;

    ########
    #	    Maintain Maximum of Fd number
    $MaxFn = $TrnsFn if ($TrnsFn > $MaxFn);
    $MaxFn = $MesgFn if ($MesgFn > $MaxFn);
print STDERR "#$TrnsFn  Trns: $NetAddr[$TrnsFn]($TrnsS)  Mesg: $NetAddr[$MesgFn]($MesgS)  MaxFn: $MaxFn\n";
}


########
#	Main Process of Transaction

sub MainProcess {
    local( $In ) = @_;
    local( $Out ) = '';
#print STDERR "Rx#$NextFn: $In\n";

    ($ChannelCloseFlag=1, return '') if $In =~ /^!DisconnectChannel$/o;
    return ProcCommands( $In ) if $In =~ /^!/o;

    @Commands = split( /\034/, $In );
    undef @Returns;	# List of return values
    undef $Diag;	# Diagnostic message is stored by ProcNames directly
    $Condition = 1;	# Turned off by ProcNames directly if assumption failed

    while ($_ = shift @Commands) {
	last unless defined $_;
	next if $_ eq '';
	last unless ( $Condition || m/^[A-Za-z0-9'\.]+:/o );
	last if defined $Diag;
	push @Returns, ProcNames( $_ );
    }

    $Diag = "Condition failed" unless $Condition || defined $Diag;
    unshift @Returns, "!$Diag" if defined $Diag;
    $Out = join ( "\034", @Returns );
#foreach $k (sort keys %ValueDataBase) { print STDERR "db> $k $ValueDataBase{$k}\n"; }
#print STDERR "Tx#$NextFn: $Out\n";

    return $Out;
}


########################################################################
################					################
################    C o m m a n d  P r o c e s s o r	################
################					################
########################################################################


sub ProcCommands {
    local( $cmd ) = @_;
    local( $_, @param ) = split( /\s+/, $cmd );

#print STDERR "ProcCommands: [", join("] [", ( $_, @param ) ), "]\n";
    if ( /^!Sync$/o ) {
	select($MS); $OUTPUT_AUTOFLUSH = 1;
	print $MS "$cmd\n"; #  $dummy = <$MS>;
	return $cmd;
    }

    return &AddInformTo   ( @param )	if /^!AddInformTo$/o;
    return &DelInformTo   ( @param )	if /^!DelInformTo$/o;
    return &AddTriggers   ( @param )	if /^!AddTriggers$/o;
    return &DelTriggers   ( @param )	if /^!DelTriggers$/o;
    return &AddCondition  ( @param )	if /^!AddCondition$/o;
    return &DelCondition  ( @param )	if /^!DelCondition$/o;

    return &QueryFullName ()		if /^!QueryFullName$/o;
    return &QueryRootName ()		if /^!QueryRootName$/o;
    return &QueryVariant  ( @param )	if /^!QueryVariant$/o;
    return &QueryDescendant ( @param )	if /^!QueryDescendant$/o;
    return &GetDescendant ( @param )	if /^!GetDescendant$/o;
    return &QueryExistence( @param )	if /^!QueryExistence$/o;
    return &QueryAttribute( @param )	if /^!QueryAttribute$/o;

    return "!Unknown Command";
}


sub AddInformTo {	# !AddInformTo NAME CLIENT
    my( $name, $client ) = @_;
    $name =~ s/'[A-Za-z0-9]+$//o;
    my( $n ) = $name;
    $name .= "'InformTo";
    $tmp = '' unless defined ($tmp = $ValueDataBase{$name});
    $ValueDataBase{$name} = &AddElement( $tmp, $client );
    &GetName( $n, $n, '' );
}

sub DelInformTo {	# !DelInformTo NAME CLIENT
    my( $name, $client ) = @_;
    $name =~ s/'[A-Za-z0-9]+$//o;
    my( $n ) = $name;
    $name .= "'InformTo";
    $tmp = '' unless defined ($tmp = $ValueDataBase{$name});
    $ValueDataBase{$name} = $tmp = &DelElement( $tmp, $client );
    delete $ValueDataBase{$name} if $tmp eq '';
    &GetName( $n, $n, '' );
}

sub AddTriggers {	# !AddTriggers Source Destination
    my( $src, $dest ) = @_;
    $src  =~ s/'[A-Za-z0-9]+$//o;
    $dest =~ s/'[A-Za-z0-9]+$//o;
    $tmp = '' unless defined ($tmp = $ValueDataBase{$src."'Triggers"});
    $ValueDataBase{$src."'Triggers"} = &AddElement( $tmp, $dest );
    $tmp = '' unless defined ($tmp = $ValueDataBase{$dest."'TriggeredBy"});
    $ValueDataBase{$dest."'TriggeredBy"} = &AddElement( $tmp, $src );
    "$src $dest";
}

sub DelTriggers {	# !DelTriggers Source Destination
    my( $src, $dest ) = @_;
    $src  =~ s/'[A-Za-z0-9]+$//o;
    $dest =~ s/'[A-Za-z0-9]+$//o;
    $tmp = '' unless defined ($tmp = $ValueDataBase{$src."'Triggers"});
    $ValueDataBase{$src."'Triggers"} = $tmp = &DelElement( $tmp, $dest );
    delete $ValueDataBase{$src."'Triggers"} if $tmp eq '';
    $tmp = '' unless defined ($tmp = $ValueDataBase{$dest."'TriggeredBy"});
    $ValueDataBase{$dest."'TriggeredBy"} = $tmp = &DelElement( $tmp, $src );
    delete $ValueDataBase{$dest."'TriggeredBy"} if $tmp eq '';
    "$src $dest";
}

sub AddCondition {	# !AddCondition Name Expr TriggeredBy
    my( $name, $expr, @TriggeredBy ) = @_;
    $name =~ s/'[A-Za-z0-9]+$//o;
    $ValueDataBase{$name."'IfTriggered"} = $expr;
    foreach ( @TriggeredBy ) {   &AddTriggers( $_, $name );   }
    $TriggeredName{$name} = 1;
    $expr;
}

sub DelCondition {	# !DelCondition Name
    my( $name ) = @_;
    my( @TriggeredBy );
    $name =~ s/'[A-Za-z0-9]+$//o;
    delete $ValueDataBase{$name."'IfTriggered"};
    @TriggeredBy = split( /\s+/, $ValueDataBase{$name."'TriggeredBy"} );
    foreach ( @TriggeredBy ) {   &DelTriggers( $_, $name );   }
    '';
}

sub QueryFullName {	# !QueryFullName
    my( @tmp );
    my( %uniq ) = ();
    @tmp = grep { !/'/o } ( keys %ValueDataBase );
    grep( ($uniq{$_}=1, 0), @tmp );
    join( ' ', keys %uniq );
}

sub QueryRootName {	# !QueryRootName
    local( @tmp );
    local( %uniq ) = ();
    @tmp = grep { !/'/o } ( keys %ValueDataBase );
    grep( ( s/\..*$//o, $uniq{$_}=1, 0 ), @tmp );
    join( ' ', keys %uniq );
}

sub QueryVariant {	# !QueryVariant Stem
    my( $stem ) = @_;
    my( %uniq ) = ();
    $stem = quotemeta $stem;
    @tmp = grep { !/'/o } ( keys %ValueDataBase );
    @tmp = grep { s/^$stem\.// } @tmp;
    grep( ( s/\..*$//o, $uniq{$_}=1, 0 ), @tmp );
    join( ' ', keys %uniq );
}

sub QueryDescendant {	# !QueryDescendant Stem
    my( $stem ) = @_;
    my( %uniq ) = ();
    $stem = quotemeta $stem;
    @tmp = grep { !/'/o } ( keys %ValueDataBase );
    @tmp = grep { /^$stem(\..*)?$/ } @tmp;
    grep( ($uniq{$_}=1, 0), @tmp );
    join( ' ', keys %uniq );
}

sub GetDescendant {	# !GetDescendant Stem
    my( $stem ) = @_;
    my( %uniq ) = ();
    $stem = quotemeta $stem;
    @tmp = grep { !/'/o } ( keys %ValueDataBase );
    @tmp = grep { /^$stem(\..*)?$/ } @tmp;
    grep( ($uniq{$_}=1, 0), @tmp );
    @tmp = map { &GetName( $_, $_, '' ); } ( keys %uniq );
    join( "\034", @tmp );
}

sub QueryExistence {	# !QueryExistence Name
    my( $name ) = @_;
    return $name if defined( $ValueDataBase{$name} );
    return '';
}

sub QueryAttribute {	# !QueryAttribute Name
    my( $name ) = @_;
    my( %uniq ) = ();
    $name = quotemeta $name;
    @tmp = keys %ValueDataBase;
    @tmp = grep { s/^$name'// } @tmp;
    join( ' ', @tmp );
}

#print STDERR join( ' ', @tmp), "\n";


sub AddElement {
    my( $list, @add ) = @_;
    my( @List ) = split( /\s+/, $list );
    my( %uniq ) = ();
    grep( ($uniq{$_}=1, 0), @List, @add );
    join( ' ', keys %uniq );
}

sub DelElement {
    my( $list, @del ) = @_;
    my( @List ) = split( /\s+/, $list );
    my( %uniq ) = ();
    grep( ($uniq{$_}=1, 0), @List );
    grep( (delete $uniq{$_}, 0), @del );
    join( ' ', keys %uniq );
}


########################################################################
################					################
################   N a m e   S p a c e   A c c e s s	################
################					################
########################################################################


sub ProcNames {
    my( $In ) = @_;
    local( $Name, $OName, $Op, $Rest, $Value, $Current );

    unless (($Name,$Op,$Rest)=($In =~ /^([A-Za-z][\w'\.]*)([=?:])(.*)$/o)) {
	$Diag='unknown operation'; return ''; };
    $OName = $Name;

    $Name =~ s/'Value$//o;
    $Attr = '' unless ( ($Attr) = ( $Name =~ /('[A-Za-z]\w*)$/o ) );
    $Name =~ s/'\w+$//o;

    return GetName( $OName, $Name, $Attr )		if $Op eq '?';
    return PutName( $OName, $Name, $Attr, $Rest )	if $Op eq '=';
    return TestName( $OName, $Name, $Attr, $Rest )	if $Op eq ':';
}

sub GetName {
    local( $OName, $Name, $Attr ) = @_;
#print STDERR "GetName: n=[$Name] a=[$Attr]\n";
    $Name = &NameResolution( $Name, $Attr );
    $Current = &ValueResolution( $Attr, ($dummy = $ValueDataBase{$Name.$Attr}) );
    $Current = 'UNBOUND' unless defined $Current;
    return "$OName=$Current";
}

sub TestName {
    local( $OName, $Name, $Attr ) = @_;
#print STDERR "TestName: n=[$Name] a=[$Attr]\n";
    $Name = &NameResolution( $Name, $Attr );
    $Value = &ValueResolution( $Attr, $Rest );
    $Current = &ValueResolution( $Attr, ($dummy = $ValueDataBase{$Name.$Attr}) );
    $Current = 'UNBOUND' unless defined $Current;
    $Value   = 'UNBOUND' unless defined $Value;
    $Condition = 0 unless $Value eq $Current;
    return "$OName=$Current";
}

sub PutName {
    local( $OName, $Name, $Attr, $Rest ) = @_;
#print STDERR "PutName: n=[$Name] a=[$Attr] r=[$Rest]\n";
    $Name = &NameResolution( $Name, $Attr );
    $Value = &ValueResolution( $Attr, $Rest );
    $Current = &ValueResolution( $Attr, ($dummy = $ValueDataBase{$Name.$Attr}) );
    $Current = 'UNBOUND' unless defined $Current;
    $Value   = 'UNBOUND' unless defined $Value;

    if ( $Value eq 'UNBOUND' ) {
	delete $ValueDataBase{$Name.$Attr};
	delete $ValueDataBase{$Name} if $Attr eq "'Control";
    } else {
	$ValueDataBase{$Name.$Attr} = $Value;
	$ValueDataBase{$Name} = $Value if $Attr eq "'Control";
    }
    &MarkTriggerFlag($Name, $Current) if ( $Attr eq '' );
    return "$OName=$Value";
}

sub MarkTriggerFlag {
    local( $Name, $Current ) = @_;
    local( $Trig );

#print STDERR "MarkTriggerFlag for $Name\n";
    $OldValues{$Name} = $Current unless defined $OldValues{$Name};
    if ( defined( $Trig = $ValueDataBase{$Name."'Triggers"} ) ) {
#print STDERR "Triggering: $Trig\n";
	grep( ( $TriggeredName{$_}=1, 0 ), split( /\s+/, $Trig ) );
    }
    return undef;
}

sub NameResolution {
    local( $name, $attr ) = @_;
    local( $new, $val );

#print STDERR "NameRes: n=[$name] a=[$attr]\n";
    @ids = split( /\./, $name );
    $new = '';
    while (scalar(@ids)) {
	$_ = shift @ids;
	$_ = '0' unless $_;
	$new .= $_;
#print STDERR "NameRes: t=[$new]\n";
	last if ($attr ne '') && (scalar(@ids) == 0);	# attribute -- no modification
	while ( defined ( $ValueDataBase{$new."'Control"} ) ) {
	    $val = $ValueDataBase{$new."'Control"};
	    last unless ( $val =~ /^@/o );
	    ($new = $val) =~ s/^@//o;
#print STDERR "NameRes: o=[$new]\n";
	}
	$new .= '.' if @ids;
    }
#print STDERR "NameRes: o=[$new]\n";
    return $new;
}

sub ValueResolution {				# returns GLUE representation
    local( $attr, $value ) = @_;
    local( $name );
    $value = 'UNBOUND' unless defined $value;
#print STDERR "ValueRes: a=[$attr] v=[$value]\n";
    return $value unless $attr eq '';		# no modification with attribute
    while ($value =~ s/^@//o) {	# Link  --  start with @
	$name = &NameResolution( $value, '' );
	$value = 'UNBOUND';
	$value = &ValueResolution( '', $ValueDataBase{$name} )
	    if defined ( $ValueDataBase{$name} );
    }
    if ($value =~ s/^%//o) {	# Expr  --  start with %
	$value = EvaluateExpression( $value );
	unless ( $value eq 'UNBOUND' ) {
	    if ( $value =~ /^[-+0-9]+$/ ) { $value = '#' . $value }
	    elsif ( $value =~ /^[-+0-9\.]+$/ ) { $value = '$' . $value }
	    else { $value = '"' . $value }
	}
#print STDERR "ValueRes: v=[$value]\n";
	return $value;   }
    return $value;				# no modification
}

sub EvaluateName {				# returns PERL data representation
    local( $name ) = $_[0];
#print STDERR "EvalName: n=[$name]\n";
    $name = &NameResolution( $name, '' );
    $ans = 'UNBOUND';
    $ans = &ValueResolution( '', $ValueDataBase{$name} )
	if defined ( $ValueDataBase{$name} );
#print STDERR "EvalName: a=[$ans]\n";
    return "'$ans'" if $ans =~ s/^[#\$"]//o;
    return 'UNBOUND';
}

sub EvaluateExpression {			# returns PERL data representation
    local( $expr ) = $_[0];
#print STDERR "EvalExpr: e=[$expr]\n";
    $expr =~ s/'[A-Za-z0-9]+//go;
    $expr =~ s/\b(lt|gt|le|ge|eq|ne|cmp|not|and|or|xor)\b/&escape($1)/ge;
    $expr =~ s/("[^"]*?")/&escape($1)/ge;
    $expr =~ s/\b([A-Za-z][A-Za-z0-9\.]*)\b/&EvaluateName($1)/ge;
    $expr =~ y/\240-\376/\040-\176/;
#print STDERR "EvalExpr: x=[$expr]\n";
    $ans = eval $expr;
#print STDERR "EXPR: $@" if $@;
#print STDERR "EvalExpr: a=[$ans]\n";
    $ans = 'UNBOUND' if $@;
#print STDERR "EvalExpr: a=[$ans]\n";
    $ans = 0 if $ans eq '';
#print STDERR "EvalExpr: a=[$ans]\n";
    return $ans;
}

sub escape {
    my( $str ) = @_;
    $str =~ y/\040-\176/\240-\376/;
    return $str;
}


########################################################################
################					################
################      P o s t - P r o c e s s o r	################
################					################
########################################################################


sub PostProcess {  # return undef;
    local( $Current, $Value, $i, $k, $d, $old, $now );

#   Triggers
    for ( $i=0; $i<10; $i++ ) {
	@Trig = keys %TriggeredName;
#print STDERR "Triggered: ", join( ',', @Trig ), "\n";
	last unless @Trig;
	undef %TriggeredName;
	foreach $k (@Trig) {
#print STDERR "Updating $k  ";
	    next unless ( defined ( $d = $ValueDataBase{$k."'IfTriggered"} ) );
	    $Current = &ValueResolution( '', $ValueDataBase{$k} );
	    $ValueDataBase{$k} = $Value = &ValueResolution( '', $d );
#print STDERR "[$Current] -> [$Value]\n";
	    &MarkTriggerFlag( $k, $Current );
	}
    }

#	Inform
    %Informed = ();
    foreach $k (keys %OldValues) {
	if ( defined ( $OldValues{$k} ) ) { $old = $OldValues{$k}; }
	else { $old = 'UNBOUND'; }
	if ( defined ( $ValueDataBase{$k} ) ) { $now = $ValueDataBase{$k}; }
	else { $now = 'UNBOUND'; }
	next if ( $old eq $now );
	&ProcInformation( $k, $old, $now );
    }
}


sub ProcInformation {
    local( $key, $old, $new ) = @_;
    my( %sent, $verb, $mode, $cond, $destlist, $dle, $dest );
#print STDERR "ProcInformation [$key] [$old] [$new]\n";

    %sent = ();
    while (1) {
	if ( defined $ValueDataBase{$key."'InformTo"} ) {
	    $destlist = $ValueDataBase{$key."'InformTo"};
#print STDERR "Inform to [$destlist] for [$key]\n";
	    foreach $dle ( split( /\s+/, $destlist ) ) {
		unless ( ($dest,$mode,$verb) = ($dle =~ m!([^/]+)/([^/]*)/(.*)!o) ) {
		    $verb = "Changed";
		    unless ( ($dest,$mode) = ($dle =~ m!([^/]+)/([^/]*)!o) ) {
			$mode = "any"; $dest = $dle; }
		}
#print STDERR "Inform for [$key] with [$verb] and [$mode]\n";
		next unless &JudgeCond( $old, $new, $mode );
		next unless defined ( $OpenHandle{$dest} );
		next if defined ( $Informed{$key,$dest,$verb} );
		next if defined ( $sent{$dest,$verb} );
#print STDERR "Informed to $dest: $verb $key\n";
		select( $dest );
		$OUTPUT_AUTOFLUSH = 1;
		print $dest "$verb $key\n";
		$Informed{$key,$dest,$verb} = 1;
		$sent{$dest,$verb} = 1;
	    }
	}
	last unless ( $key =~ s/\.[A-Za-z0-9]+$//o );
    }
    select( STDERR );
}


sub JudgeCond {
    my( $old, $new, $mode ) = @_;
    my( $old0, $old1, $new0, $new1, $cond );

    $old1 = ( ( $old =~ /^([#\$]0|\")$/o )         ? 0 : 1 );
    $old0 = ( ( $old =~ /^([#\$]0|\"|UNBOUND)$/o ) ? 0 : 1 );
    $new1 = ( ( $new =~ /^([#\$]0|\")$/o )         ? 0 : 1 );
    $new0 = ( ( $new =~ /^([#\$]0|\"|UNBOUND)$/o ) ? 0 : 1 );

    if    ($mode eq      'ON')	{ $cond = !$old0 && $new0 ; }
    elsif ($mode eq     'OFF')	{ $cond = $old1 && !$new1; }
    elsif ($mode eq    'BOTH')	{ $cond = (!$old0 && $new0) || ($old1 && !$new1); }
    elsif ($mode eq   'BOUND')	{ $cond = ($old eq 'UNBOUND') && ($new ne 'UNBOUND'); }
    elsif ($mode eq 'UNBOUND')	{ $cond = ($old ne 'UNBOUND') && ($new eq 'UNBOUND'); }
    elsif ($mode eq 'BINDING')	{ $cond = ($old eq 'UNBOUND') && ($new ne 'UNBOUND')
				       || ($old ne 'UNBOUND') && ($new eq 'UNBOUND'); }
    else			{ $cond = $old ne $new; };
#print STDERR "BoolCondition [$old1] [$old0] [$new1] [$new0] [$cond]\n";
    return $cond;
}


########################################################################
################					################
################	Server Console Operation	################
################					################
########################################################################


sub ServerConsole {
    local($line, $i);

    ( vec($FileDescs, $StdinFn, 1) = 0, return undef ) if eof STDIN;
    chomp( $line = <STDIN> );

    if ( $line =~ /^DumpDatabase$/ ) {
	foreach $k (sort keys %ValueDataBase) {
	    print STDERR "db> $k";
	    print STDERR ": $ValueDataBase{$k}" if defined ($ValueDataBase{$k});
	    print STDERR "\n";
	}
	print STDERR "---\n";
	return undef;
    }

    if ( $line =~ /^EXIT$/o ) {
	shutdown(AcceptS,2);
#print STDERR "MaxFn: $MaxFn\n";
	for ($i=$MaxFn; $i>3; $i--) {
#print STDERR "Closing $i:$FileHandle[$i]\n";
	    if ( defined $FileHandle[$i] ) {
		close($FileHandle[$i]) || warn($!);   }
	}
	exit(0);
    }

    print STDERR eval $line, "\n";
    warn $@ if $@;
    return undef;
}