use BigSister::common;
package Monitor::Tester;

require 5.001;
require Exporter;

use strict;
use vars qw(@ISA);
use FileHandle;
use Requester::Requester;
use TestWorker;
use Monitor::Monitor;

@ISA = qw(Monitor::Monitor);

use cfgfile;

my $tests = {};

sub new
{
    my ($this, $args ) = @_;
    my  $class = ref($this) || $this;
    my  $self = {};

    my @features = split( /,/, $args->{"features"} );
    push( @features, ($args->{"host"} eq $BigSister::common::hostname) ? "local":"remote" ) if( $args->{"host"} );
    my $bestmatch = -1;
    my $bestmatching_test;
    my $match;
    my @ordered = ();
    my $orgname = $args->{"name"};
    if( $args->{"name"} =~ /^!/ ) {
	$args->{"name"} = $';
    }
  outer: while( my( $testname, $test ) = each %$tests ) {
	next unless( defined $test->{"vars"}->{"name"} );
	foreach my $desc ("manufacturer","device","name") {
	    next outer if( $args->{$desc} && (defined $test->{"vars"}->{$desc})
		&& ! grep( $args->{$desc} eq $_->{"value"}, values %{$test->{"vars"}->{$desc}} ) );
	}
	if( ! defined $test->{"vars"}->{"features"} ) {
	    $match = 0;
	}
	else {
	    my $features = $test->{"vars"}->{"features"};
	    $match = 0;
	    while( my( $id, $candidate ) = each %$features ) {
	        my $name = $candidate->{"value"};
	        if( grep( $name eq $_, @features ) ) {
		    $match++;
		}
		else {
		    $match -= 12;
		}
	    }
	}
	push( @ordered, [ $match, $test ] );
    }
    @ordered = sort { $b->[0] <=> $a->[0] } @ordered;
    $args->{"name"} = $orgname;
    foreach my $candidate ( @ordered ) {
        my( $match, $test ) = @$candidate; 
	print "  using test ".($test->{"name"})."\n" if( $BigSister::common::dl> 4 );
	my $testobj = newfrom( $this, $test, $args );
	return( $testobj ) if( $testobj );
    }
    print STDERR "no matching test for $args->{name}\n" if( $BigSister::common::dl );
    return undef;
}


sub niceness {
    my( $self ) = @_;
    return $self->{"Test.niceness"};
}


sub newfrom
{
    my ($this, $test, $args ) = @_;
    my  $class = ref($this) || $this;
    my  $self = {};

    bless($self, $class);

    # preserve/freeze args ... just in case
    my %args = $args?%$args:();
    $self->{"args"} = \%args;;
    $self->{"test"} = $test;
    $self->{"invert"} = ($self->{"args"}->{"name"} =~ /^!/);
    $self->instantiate() || return( undef );;
    if( $args->{"frequency"} ) {
        $self->sched_frequency( $args->{"frequency"} );
    }
    elsif( defined $self->{"instance"}->{"vars"}->{"frequency"} ) {
        $self->sched_frequency( $self->{"instance"}->{"vars"}->{"frequency"}->{0}->{"value"} );
    }

    $self->{"Test.niceness"} = var_to_value( $self->expand( "niceness" ) );
    $self->{"Test.niceness"} = 1 unless( defined $self->{"Test.niceness"} );

    $self->{"discover"} = 0;
    $self->{"monitoring"} = 0;
    $self->{"nodeinstance"}->{"node_executed"} = {};
    $self->{"nodeinstance"}->{"node_executed_result"} = {};
    $self->{"perf_always"} = $self->{"perf_sometimes"} = $self->{"perf_often"} = 0;
    return($self);
}


sub instantiate {
    my( $self ) = @_;
    print "  instantiating ".($self->{"test"}->{"name"})."\n" if( $BigSister::common::dl>3 );
    my $test = $self->{"test"};
    my $host = $self->{"args"}->{"host"};
    my $nodeinstance;
    if( defined $test->{"nodeinstances"}->{$host} ) {
        $nodeinstance = $self->{"nodeinstance"} = $test->{"nodeinstances"}->{$host};
    }
    else {
	my $default = clonehash( $test->{"default_nodeinstance"} );
        $self->{"nodeinstance"} = $test->{"nodeinstances"}->{$host}
	 = $nodeinstance = $default;
	$self->{"nodeinstance"}->{"vars"}->{"host"} = { 0 => { "value" => $host } };
    }
    $self->{"nodeinstance"}->{"vars"}->{"test_available"} = { 0 => { "value" => 1 } };
    $nodeinstance->{"host"} = $host;
    $nodeinstance->{"alias"} = $self->{"args"}->{"alias"};
    $self->{"instance"} = clonehash( $test->{"default_instance"} );
    $self->{"instance"}->{"host"} = $host;
    $self->{"instance"}->{"alias"} = $self->{"args"}->{"alias"};
    $self->{"instance"}->{"env"} = $self;
    $self->{"instance"}->{"monitor"} = $self;
    $self->{"instance"}->{"args"} = $self->{"args"};
    my $worker = $self->execute_step( "precheck" );
    while( ! $worker->is_finished() ) {
        CWorker::one_pass();
    }
    return( 0 ) unless( var_to_value( $self->expand( "test_available" ) ) );
    my $worker = $self->execute_step( "init" );
    while( ! $worker->is_finished() ) {
        CWorker::one_pass();
    }
    return 1;
}



sub execute_step {
    my( $self, $name, $step ) = @_;

    print "    execute_step( $name )\n" if( $BigSister::common::dl > 5 );
    my $pernode;
    if( (defined $self->{"nodeinstance"}->{"node_executed"}->{$name}) ) {
        print "      pernode already scheduled\n" if( $BigSister::common::dl>7 );
        $pernode = $self->{"nodeinstance"}->{"node_executed"}->{$name};
    }
    else {
	print "      scheduling pernode\n" if( $BigSister::common::dl>6 );
        $self->{"nodeinstance"}->{"node_executed"}->{$name} 
	  = $pernode = $self->execute_method( $name, "pernode" );
    }
    return $self->execute_method( $name, "instance", $pernode );
}



sub execute_method {
    my( $self, $name, $methodscope, $foreworker) = @_;
    my $instance;

    ($methodscope = "instance") unless( $methodscope );
    print "Tester executing method $methodscope.$name\n" if( $BigSister::common::dl>4 );
    if( $methodscope eq "pernode" ) {
        $instance = "nodeinstance";
    }
    else {
        $instance = "instance";
    }

    # during this run *we* are the nodeinstance's environment 
    $self->{"nodeinstance"}->{"env"} = $self;

    my $class = $self->{"test"};
    my @rules =  ();
    while( $class ) {
	if( defined $class->{$methodscope}->{$name} ) {
	    unshift( @rules, @{$class->{$methodscope}->{$name}} );
	}
	last if( $class->{$methodscope}->{"overrides"}->{$name} );
        my $super = $class->{"super"}->[0];
	$class = $tests->{$super} if( $super );
	last unless( $super && $class );
    }
    my $local = $self->{$instance}->{"local"} = { "type" => "${instance}_localvars", "vars" => {}};
    my $worker = new TestWorker();
    if( $foreworker ) {
        $worker->start_after( $foreworker );
	$worker->do_next( sub {
	    $worker->abort() unless( $foreworker->result() );
	    return 1;
	} );
    }

    my $rule_i = 0;
    my $in_rule_i = undef;
    my @for = ();
    my $for_i = undef;
    $worker->do_next( sub {
	for( ; $rule_i <= $#rules; $rule_i++ ) {
	    my $rule = $rules[$rule_i];
	    my $rules = $rule->{"exec"};
	    unless( @for ) {
		@for = ( { "value" => 0 } );
		if( $rule->{"for"} ) {
		    @for = values %{$self->expand( $rule->{"for"} )};
		}
		$for_i = 0;
	    }
	    for( ; $for_i <= $#for; $for_i++ ) {
		unless( defined $in_rule_i ) {;
		    $self->{$instance}->{"local"}->{"vars"} = { "p" => { 0 => $for[$for_i] } };
		    $in_rule_i = 0;
		}
		for( ; $in_rule_i <= $#$rules; $in_rule_i++ ) {
		    my $thisrule = $rules->[$in_rule_i];
		    my $ret;
		    eval {
			$ret = execute_rule( $self->{"test"},
			  $self->{"nodeinstance"},
			  $self->{$instance},
			  $thisrule );
		    };
		    if( $@ ) {
			BigSister::common::log( "warning", "failed to execute rule: $@ (".join(" ",@$thisrule) );
			$ret = undef;
		    }
		    return( $ret ) if( ref($ret) );
		    unless( $ret ) {
		        $in_rule_i = undef;
			$for_i++;
			return $ret;
		    }
		}
		$in_rule_i = undef;
	    }
	    @for = ();
	}
	return 1;
    } );
    return $worker;
}


sub expand {
    my( $self, $var ) = @_;

    foreach my $scope ( $self->{"instance"}, $self->{"nodeinstance"}, $self->{"test"} ) {
        return( $scope->{"vars"}->{$var} ) if( defined $scope->{"vars"}->{$var} );
    }
    return {};
}


sub expand_values {
    my( $self, $var ) = @_;

    return( var_to_array( $self->expand( $var ) ) );
}


sub expand_value {
    my( $self, $var ) = @_;

    my $value = $self->expand( $var );
    if( %$value ) {
        return( $value->{(keys %$value)[0]}->{"value"} );
    }
    return undef;
}


my %inverted_colors = (
    "green" => "red",
    "red" => "green"
);


sub invert_color {
    my( $self, $color ) = @_;

    return( $color ) unless( $self->{"invert"} && defined $inverted_colors{$color} );
    return( $inverted_colors{$color} );
}


	    
sub clonehash {
    my( $ref ) = @_;

    my %result = ();
    while( my($key, $val) = each %$ref ) {
        if( (ref $val) eq "HASH" ) {
	    $result{$key} = clonehash( $val );
	}
	elsif( (ref $val) eq "ARRAY" ) {
	    $result{$key} = clonearray( $val );
	}
	else {
	    $result{$key} = $val;
	}
    }
    return \%result;
}


sub clonearray {
    my( $ref ) = @_;

    my @result = ();
    foreach my $val (@$ref) {
        if( (ref $val) eq "HASH" ) {
	    push( @result, clonehash( $val ) );
	}
	elsif( (ref $val) eq "ARRAY" ) {
	    push( @result, clonearray( $val ) );
	}
	else {
	    push( @result, $val );
	}
    }
    return \@result;
}



#############################################################
##
## discover/monitor
##
#############################################################

sub discover {
    my( $self ) = @_;
    if( $self->{"discover"} < time ) {
        my $discover = $self->execute_step("discover");
	$discover->do_next( sub {
	    if( $discover->result() ) {
		$self->{"discover"} = time + $self->expand_value( "discover_refresh" ) * 60;
		$self->{"monitoring"} = 1;
		$self->{"discovered"} = 1;
		return 1;
	    }
	    else {
		$self->{"discover"} = time + $self->expand_value( "discover_retry" ) * 60;
		print "discover failed!\n";
		return 0;
	   }
	} );
	$self->{"discover"} = time + $self->expand_value( "discover_retry" ) * 60;
    }
}


sub check {
    my( $self ) = @_;
    if( $self->{"discovered"} ) {
        $self->execute_step( "postdiscover" );
	$self->{"discovered"} = 0;
    }
    if( $self->{"monitoring"} ) {
        $self->execute_step( "monitor" );
    }
}


sub late_check {
    my( $self ) = @_;
    return unless( $self->{"monitoring"} );
    $self->execute_step( "postmonitor" );
    $self->execute_step( "report" );

    my $perf_freq = $self->expand_value( "perf_frequency" );
    if( $perf_freq ) {
	foreach my $perf ("always", "often", "sometimes") {
	    if( $self->{"perf_$perf"} <= time + 30 ) {
	        $self->{"perf_$perf"} += $perf_freq*60;
		if( $self->{"perf_$perf"} < time ) {
		    $self->{"perf_$perf"} = time;
		}
		$self->{"instance"}->{"perf_$perf"} = 1;
		$self->{"nodeinstance"}->{"perf_$perf"} = 1;
	    }
	    $perf_freq *= 2;
	}
	my $worker = $self->execute_step( "perf" );
	$worker->do_next( sub {
	    foreach my $perf ("always", "often", "sometimes") {
		delete $self->{"instance"}->{"perf_$perf"};
		delete $self->{"nodeinstance"}->{"perf_$perf"};
	    }
	    return 1;
	} );
    }
}
   

sub unconfigure {
    my( $self ) = @_;

    $self->execute_step( "unconfigure" );
}


sub cycle_done {
    my( $self ) = @_;

    $self->{"nodeinstance"}->{"node_executed"} = {};
    $self->{"nodeinstance"}->{"node_executed_result"} = {};
}



#############################################################
##
## static
##
#############################################################

my( $lf_file, @lf_tokens );

sub load_file {
    ( $lf_file ) = @_;

    $lf_file->rewind();
    my @lf_tokens = ();

    while( defined( my $token = lf_token()) ) {
	if( $token eq "test" ) {
	    lf_parse_test() || return(0);
	}
	else {
	    lf_err( "unexpected $token" );
	    return 0;
	}
    }

    foreach my $class (values %$tests) {
	lf_init_class( $class );
    }
    return 1;


    sub lf_parse_test() {
	my $name = lf_token();
	if( ! $name ) {
	    lf_err( "expected test modules name" );
	    return 0;
	}
        my $class = { 
	    "super" => [],
	    "static" => {},
	    "pernode" => {},
	    "instance" => {},
	    "nodeinstances" => {},
	    "instances" => {},
	    "vars" => {},
	    "type" => "classvars",
	    "default_instance" => { "type" => "instancevars", "vars" => {} },
	    "default_nodeinstance" => { "type" => "nodeinstancevars", "vars" => {} },
	    "name" => $name,
	    "main" => { "exec" => [] }
	};
	$tests->{$name} = $class;
	my $next;
	while( ($next = lf_token()) ne "{" ) {
	    if( $next eq "extends" ) {
		push( @{$class->{"super"}}, lf_token() );
	    }
	    else {
		lf_err( "'{' expected" );
		return 0;
	    }
	}
	while( ($next = lf_token()) ne "}" ) {
	    unless( defined $next ) {
	        lf_err( "'}' expected" );
		return 0;
	    }
	    my $scope = "instance";
	    my $overrides = 0;
	    while(1) {
		if( ($next eq "pernode") || ($next eq "static") ) {
		    $scope = $next;
		    $next = lf_token();
		    redo;
		}
		if( $next eq "overrides" ) {
		    $overrides = 1;
		    $next = lf_token();
		    redo;
		}
		last;
	    }; 
	    if( grep( $next eq $_, "precheck", "init", "discover", "postdiscover", "monitor", "postmonitor",
		"report", "postreport", "perf", "postperf", "unconfigure" ) ) {
		unless( defined $class->{$scope}->{"overrides"} ) {
		    $class->{$scope}->{"overrides"} = {};
		}
		($class->{$scope}->{"overrides"}->{$next} = 1) if( $overrides );
		unless( defined $class->{$scope}->{$next} ) {
		    $class->{$scope}->{$next} = [];
		}
		my $subrule = {};
		push( @{$class->{$scope}->{$next}}, $subrule );
		while( ($next = lf_token()) ne "{" ) {
		    if( $next eq "for" ) {
			$subrule->{"for"} = lf_token();
		    }
		    else {
		       lf_err( "'{' expected" );
		       return 0;
		    }
		}
		while( ($next = lf_token()) ne "}" ) {
		    if( ! $next ) {
			lf_err( "'}' expected" );
		    }
		    lf_parse_rule( $subrule, $next ) || return 0;
		}
	    } 
	    else {
		my $subrule = $class->{"main"};
		unshift( @lf_tokens, $next );
		lf_parse_rule( $subrule, $scope ) || return 0;
	    }
	}
        return 1;
    }

    sub lf_init_class {
	my( $class ) = @_;

	if( $class->{"initialized"} && ($class->{"initialized"} eq "inprogress") ) {
	    lf_err( "class ".($class->{"name"}).": cyclic inheritance\n" );
	    return 0;
	}
	return( 1 ) if( $class->{"initialized"} );
	$class->{"initialized"} = "inprogress";

	foreach my $super (@{$class->{"super"}}) {
	    unless( defined $tests->{$super} ) {
	        lf_err( "super class $super is not defined" );
		$class->{"initialized"} = "yes";
		return 0;
	    }
	    my $superclass = $tests->{$super};
	    lf_init_class( $superclass );
	    foreach my $scope ("", "default_nodeinstance", "default_instance" ) {
	        my $source = $scope?($superclass->{$scope}->{"vars"}):($superclass->{"vars"});
		my $dest = $scope?($class->{$scope}->{"vars"}):($class->{"vars"});
		while( my( $var, $val ) = each %{$source} ) {
		    $dest->{$var} = $val;
		}
            }	
        }
	$class->{"default_instance"}->{"local"} = { "type" => "instance_localvars", "vars" => {} };
	execute( $class, $class->{"default_nodeinstance"}, $class->{"default_instance"}, $class->{"main"}->{"exec"} );
	$class->{"initialized"} = "yes";
	return 1;
    }


    sub lf_parse_rule() {
	my( $subrule, $next ) = @_;

	my @rule;
	while( $next ne ";" ) {
	    push( @rule, $next );
	    $next = lf_token();
	    unless( defined $next ) {
		lf_err( "';' expected" );
		return 0;
	    }
	}
	if( @rule ) {
	    unless( defined $subrule->{"exec"} ) {
		$subrule->{"exec"} = [];
	    }
	    push( @{$subrule->{"exec"}}, \@rule );
	}
	return 1;
    }


    sub lf_token() {
	if( @lf_tokens ) {
	    return shift @lf_tokens;
	}
	my $nextline = $lf_file->nextline();
	return(undef) unless( $nextline );
	@lf_tokens = BigSister::common::parse( $nextline, "();," );
	return lf_token();
    }


    sub lf_err() {
	my( $err ) = @_;

	BigSister::common::log( "err", "$err at line $. (".($lf_file->current_file()).")" );
	print STDERR "$err at line $. (".($lf_file->current_file()).")\n";
    }

}


sub execute {
    my( $class, $nodeinstance, $instance, $rules ) = @_;

    for( my $i=0; $i <= $#$rules; $i++ ) {
        my $rule = $rules->[$i];
	eval {
	    execute_rule( $class, $nodeinstance, $instance, $rule ) || return 0;
	};
	if( $@ ) {
	    BigSister::common::log( "warning", "failed to execute rule: $@" );
	}
    }
    return 1;
}


my %warned_rules = ();

sub execute_rule {
    my( $class, $nodeinstance, $instance, $rule ) = @_;

    my @scope = ( $class, $nodeinstance, $instance, $instance->{"local"} );
    my @rule = @$rule;
    if( $rule[0] eq "static" ) {
        @scope = ( $class );
	shift @rule;
    }
    elsif( $rule[0] eq "pernode" ) {
        @scope = ( $nodeinstance );
	shift @rule;
    }
    elsif( $rule[0] eq "instance" ) {
        @scope = ( $instance );
	shift @rule;
    }
    elsif( $rule[0] eq "local" ) {
        @scope = ( $instance->{"local"} );
	shift @rule;
    }

    if( ! @rule ) {
        ;
    }
    elsif( $rule[0] eq "set" ) {
        my $var = $rule[1];
	shift @rule; shift @rule;
	my $val = compute( $class, $nodeinstance, $instance, \@rule );
	set_var( \@scope, $var, $val );
    }
    elsif( $rule[0] eq "import" ) {
        my $var = $rule[1];
	my $alias = $rule[2];
	($alias = $var) unless( $alias );
	if( defined $instance->{"args"}->{$var} ) {
	    my $value = $instance->{"args"}->{$var};
	    my @value = ($value);
	    if( $value =~ /^\@(.)/ ) {
		$value = $';
	        @value = split( /\Q$1/, $value );
	    }
	    set_var( \@scope, $alias, \@value );
	}
    }
    elsif( $rule[0] eq "debug" ) {
	shift @rule;
	my $val = var_to_array( compute( $class, $nodeinstance, $instance, \@rule ));
	if( $val->[0] < $BigSister::common::dl ) {
	    shift @$val;
	    print " debug ".($class->{"name"}).": ".join( " ", @$val )."\n";
	}
    }
    elsif( $rule[0] eq "get" ) {
	shift @rule;
	my $vars = var_to_array(compute( $class, $nodeinstance, $instance, \@rule ));
	my @getvars = ();
	foreach my $var (@$vars) {
	    if( $var =~ /\[(\d+)\]$/ ) {
	        push( @getvars, "$`.$1" );
	    }
	    else {
	        push( @getvars, $var );
	    }
	}
	my $values = Requester::Requester::get( $instance->{"env"}, \@getvars );
	return( $values ) if( UNIVERSAL::isa( $values, "CWorker" ) );
	return(0) unless( $values );
	my %consolidate = ();
	for( my $i=0; $i<=$#$vars; $i++ ) {
	    my $var = $vars->[$i];
	    my $getvarname = $getvars[$i];
	    next unless( defined $values->{$getvarname} );
	    my $value = $values->{$getvarname};
	    $var =~ s/^\@//;
	    if( $var =~ /\[(\d+)\]$/ ) {
	        my $name = $`;
		my $index = $1;
		unless( defined $consolidate{$name} ) {
		    $consolidate{$name} = {};
		}
		my $cons = $consolidate{$name};
		$cons->{$index} = $value->{0};
	    }
	    else {
		set_var( \@scope, $var, $value );
	    }
	}
	while( my( $name, $cons ) = each %consolidate ) {
	    set_var( \@scope, $name, $cons );
	}
    }	

    elsif( $rule[0] eq "select" ) {
        shift @rule;
	my $resultvar = shift @rule;
	my $selectvar = shift @rule;
	my $values = ex_expand( $selectvar, $class, $nodeinstance, $instance );
	my $result = {};
	foreach my $idx (keys %$values) {
	    $instance->{"local"}->{"vars"}->{"i"} = { 0 => {"value" => $idx} };
	    my $val = var_to_array( compute( $class, $nodeinstance, $instance, \@rule ) );
	    if( $#$val >= 0 && $val->[0] ) {
	        $result->{$idx} = { "value" => $idx };
	    }
	}
	set_var( \@scope, $resultvar, $result );
    }

    elsif( $rule[0] eq "for" ) {
        shift @rule;
	my $resultvar = shift @rule;
	my $selectvar = shift @rule;
	my $values = ex_expand( $selectvar, $class, $nodeinstance, $instance );
	my $result = ex_expand( $resultvar, $class, $nodeinstance, $instance );
	$result = {} unless( $result );
	foreach my $iter (values %$values) {
	    my $idx = $iter->{"value"};
	    $instance->{"local"}->{"vars"}->{"i"} = { 0 => {"value" => $idx} };
	    my $val = var_to_array( compute( $class, $nodeinstance, $instance, \@rule ) );
	    if( $#$val >= 0 ) {
	        $result->{$idx} = { "value" => join( "", @$val ) };
	    }
	}
	set_var( \@scope, $resultvar, $result );
    }

    elsif( $rule[0] eq "comment" ) {
	shift @rule;
        my $style = shift @rule;
	my $val = var_to_array( compute( $class, $nodeinstance, $instance, \@rule ) );
	my $item = var_to_value( ex_expand( "report_item", $class, $nodeinstance, $instance ) );
	$instance->{"env"}->report( 
	    ($nodeinstance->{"alias"}).".".$item,
	    ($style eq "text")?100:101,
	    (($style eq "html")?"&html":"").join( "", @$val ) 
	);
    }

    elsif( $rule[0] eq "export" ) {
	shift @rule;
	my $when = shift @rule;
	return 1 unless( $instance->{"perf_$when"} );

	my @vals = compute( $class, $nodeinstance, $instance, \@rule, "," );
	my $name = var_to_value( $vals[0] );
	while( my( $idx, $contents ) = each %{$vals[1]} ) {
	    my $index = $idx;
	    print "  sending perf variable $name\[$index\]\n" if( $BigSister::common::dl > 6 );
	    $instance->{"env"}->perfreport(
		$nodeinstance->{"alias"},
		"$name.$index",
		(defined $contents->{"time"})?($contents->{"time"}):time,
		$contents->{"value"}
	    );
	}
    }

    elsif( $rule[0] eq "event" ) {
	shift @rule;
	my $val = var_to_array( compute( $class, $nodeinstance, $instance, \@rule ) );
	if( $#$val >= 1 ) {
	    my $prio = shift @$val;
	    my $item = var_to_value( ex_expand( "report_item", $class, $nodeinstance, $instance ) );
	    $instance->{"env"}->event( 
		($nodeinstance->{"alias"}).".".$item,
		time,
		$prio,
		join( "", @$val )
	    );
	}
    }

    elsif( $rule[0] eq "status" ) {
	shift @rule;
        my $color = $instance->{"env"}->invert_color( shift @rule );
	my $colorcode = (defined $BigSister::common::status_codes{$color})?$BigSister::common::status_codes{$color}:undef;
	unless( defined $colorcode ) {
	    BigSister::common::log( "err", "unknown color $color in status command" );
	    return 0;
	}
	if( (! defined $instance->{"local"}->{"vars"}->{"|statuslevel"}) 
	    || $instance->{"local"}->{"vars"}->{"|statuslevel"} >= $colorcode ) {
	    my $values = var_to_array( compute( $class, $nodeinstance, $instance, \@rule ) );
	    if( shift @$values ) {
		$instance->{"local"}->{"vars"}->{"|statuslevel"} = $colorcode;
		my $item = var_to_value( ex_expand( "report_item", $class, $nodeinstance, $instance ) );
		my $text = join( "", @$values );
		my $outtext = "";
		while( $text =~ /\&([a-z]+)/ ) {
		    $text = $';
		    $outtext .= $`."&";
		    $outtext .= $instance->{"env"}->invert_color( $1 );
		}
		$instance->{"env"}->report(
		    ($nodeinstance->{"alias"}).".".$item,
		    $colorcode,
		    $outtext.$text
		);
	    }
	}
    }

    else {
	return(0) if( $warned_rules{$rule} );
	$warned_rules{$rule} = 1;
        BigSister::common::log( "err", "unexecutable rule in class ".($class->{"name"}).": ".(join( " ", @rule )) );
        print STDERR "unexecutable rule in class ".($class->{"name"}).": ".(join( " ", @rule ))."\n";
	return 0;
    }

    return 1;
}

	   


sub set_var {
    my( $scope, $var, $val ) = @_;

    for( my $idx=0; $idx <= $#$scope; $idx++ ) {
	my $namespace = $scope->[$idx];
	if( (defined $namespace->{"vars"}->{$var}) || ($idx == $#$scope) ) {
	    if( (ref $val) eq "ARRAY" ) {
	        my $href = {};
		for( my $i=0; $i<=$#$val; $i++ ) {
		    $href->{$i} = { "value" => $val->[$i] };
		}
		$val = $href;
	    }
	    if( $BigSister::common::dl > 10 ) {
		print "    setting $var to ";
		while( my( $id, $val ) = each %$val ) { 
		    print "$id=".($val->{"value"})." ";
		}
		print "\n";
	    }
	    $namespace->{"vars"}->{$var} = $val;
	    return;
	}
    }
}


my( $ex_class, $ex_nodeinstance, $ex_instance, $ex_expr, $ex_single, $ex_atom );
my( $ex_single, $ex_varres, $ex_computedepth, @ex_endmarkers );
my %operators = (
    "&&" => 5,
    "||" => 6,
    "+" => 3,
    "-" => 3,
    "*" => 2,
    "/" => 2,
    ">" => 8,
    "<" => 8,
    "==" => 8
);
my %defaults = (
    "&&" => 0,
    "||" => 0,
    ">" => 0,
    "<" => -1
);
my %functions = (
    "contains" => \&contains,
    "contains_pattern" => \&contains_pattern,
    "null" => \&null,
    "not" => \&not,
    "remove" => \&remove,
    "percentage" => \&percentage,
    "format_kbsize" => \&format_kbsize,
    "format_percentage" => \&format_percentage,
    "pad" => \&pad,
    "input_kbsize" => \&input_kbsize,
    "in_range" => \&in_range,
    "unmonitored" => \&unmonitored,
    "nowmonitored" => \&nowmonitored,
    "when" => \&when,
    "if" => \&func_if,
    "reference_url" => \&func_reference_url,
    "call" => \&func_call,
    "size" => \&func_size,
    "domain_available" => \&func_domain_available
);

sub compute {
    ( $ex_class, $ex_nodeinstance, $ex_instance, $ex_expr, @ex_endmarkers ) = @_;
    $ex_atom = 0;
    $ex_computedepth = 0;
    my @result;
    do {
	push( @result, compute_next( @ex_endmarkers ) );
    } while( $ex_atom++ <= $#$ex_expr );
    if( ($#result == 0) || ! wantarray() ) {
        return $result[0];
    }
    return @result;

    # compute the next expression chain up to the next end marker
    sub compute_next {
        my( @endmarker ) = @_;
	my %result;

	if( $ex_computedepth++ > 16 ) {
	    ex_err( "expression depth" );
	    $ex_computedepth--;
	    return {};
	}
	my $id;
	while( $ex_atom <= $#$ex_expr ) {
	    if( grep( $ex_expr->[$ex_atom] eq $_,  @endmarker ) ) {
		last;
	    }
	    my $next = compute_one(100);
	    if( %result ) {
	        unless( defined $id ) {
		    my @ids = sort keys %result;
		    $id = $ids[$#ids] + 1;
		}
		foreach my $tid (sort keys %$next) {
		    $result{$id++} = $next->{$tid};
		}
	    }
	    else {
		while( my( $tid, $tval ) = each %$next ) {
		    $result{$tid} = $tval;
		}
	    }
	    last if( $ex_single );
	}
	$ex_computedepth--;
	return \%result;
    }


    sub compute_one {
	my( $prio ) = @_;
        my $next = $ex_expr->[$ex_atom];

        my $leftoperator;
	if( $next eq "(" ) {
	    $ex_atom++;
	    $leftoperator = compute_next( ")" );
	    unless( $ex_expr->[$ex_atom] eq ")" ) {
	        ex_err( "missing ')'" );
	    }
	}
	elsif( defined $operators{$next} ) {
	    ex_err( "unexpected operator $next" );
	}
	else {
	    $leftoperator = compute_resolve( $next );
	}
	$ex_atom++;
	if( (defined $leftoperator->{0}) && ($leftoperator->{0}->{"value"} eq $next)
	  && ($ex_expr->[$ex_atom] eq "(") ) {
	    # function call
	    my @args;
	    $ex_atom++;
	    do {
	        push( @args, compute_next( ")", "," ) );
	    } while( $ex_expr->[$ex_atom++] eq "," );
	    unless( defined $functions{$next} ) {
	        ex_err( "undefined function: $next" );
		$leftoperator = {};
	    }
	    else {
	        $leftoperator = $functions{$next}->(@args);
	    }
	}
	   
	while( defined $operators{$next=$ex_expr->[$ex_atom]} ) {
	    my $newprio = $operators{$next};
	    last if( $newprio > $prio );
	    $ex_atom++;
	    my $right_operator = compute_one( $newprio - 1 );
	    my $newleft = {};
	    my $leftsize = keys %$leftoperator;
	    my $rightsize = keys %$right_operator;
	    while( my( $i, $leftvalue ) = each %$leftoperator ) {
		my $i = $i;
	        my $left = $leftvalue->{"value"};
		my $right;
		unless( defined $right_operator->{$i} ) { 
		    # very ugly ... we make an exception for single value OP single value
		    # since otherwise operations with constants mostly fail
		    if( ($leftsize == 1) && ($rightsize == 1) ) {
		        $right = ((values %$right_operator)[0])->{"value"};
			$i = 0;
		    }
		    else {
		        next;
		    }
		}
		else {
		    $right = $right_operator->{$i}->{"value"};
		}
		my $result;
		if( $next eq "&&" ) {
		    $result = $left && $right;
		}
		elsif( $next eq "||" ) {
		    $result = $left || $right;
		}
		elsif( $next eq "*" ) {
		    $result = $left * $right;
		}
		elsif( $next eq "/" ) {
		    if( $right == 0 ) {
		        $result = 0;
		    }
		    else {
			$result = $left / $right;
		    }
		}
		elsif( $next eq "+" ) {
		    $result = $left + $right;
		}
		elsif( $next eq "-" ) {
		    $result = $left - $right;
		}
		elsif( $next eq ">" ) {
		    $result = $left > $right;
		}
		elsif( $next eq "<" ) {
		    $result = $left < $right;
		}
		elsif( $next eq "==" ) {
		    $result = $left == $right;
		}
		$newleft->{$i} = { "value" => $result };
	    }
	    $leftoperator = $newleft;
	    if( (! %$leftoperator) && defined $defaults{$next} ) {
	        $leftoperator = { 0 => { "value" => $defaults{$next} } };
	    }
	}
	return $leftoperator;
    }


    sub compute_resolve {
        my( $var, $level, $pos ) = @_;
	$pos = 0 unless( defined $pos );
	$level = 0 unless( defined $level );
	return( { 0 => {"value" => $var}} ) unless( index( $var, "\$" ) >= 0 );
	my $result = { 0=> {"value"=>""} };
	my $len = length($var);
	my $joined = 0;
	for( my $i=$pos; $i<$len; $i++ ) {
	    my $char = substr( $var, $i, 1 );
	    my $text = "";
	    while( ($char ne "\$") 
	      && ($char ne "}") && ($i<$len) ) {
		if( $char eq "\\" ) {
		    $char = substr( $var, ++$i, 1 );
		}
		$text .= $char;
	        $char = substr( $var, ++$i, 1 );
	    }
	    if( $text ) {
		while( my($key,$val) = each %$result ) {
		    $val->{"value"} .= $text;
		}
	    }
	    if( $char eq "}" ) {
	        if( ! $level ) {
		    ex_err( "additional '}'" );
		}
		else { 
		    return( $result, $i );
		}
	    }
	    elsif( $char eq "\$" ) {
	        $char = substr( $var, ++$i, 1 );
		unless( $char eq "{" ) {
		    ex_err( "missing '{'" );
		}
		my $inparens;
		( $inparens, $i ) = compute_resolve( $var, $level+1, $i+1 );
		$inparens = var_to_array( $inparens );
		if( ($joined+=$#$inparens+1) > 1 ) {
		    my $before = var_to_array( $result );
		    $result = {};
		    my $id = 0;
		    foreach my $varname (@$inparens) {
			my $expanded = var_to_array( ex_expand( $varname ) );
			foreach my $value (@$expanded) {
			    foreach my $thisresult (@$before) {
				$result->{$id++} = { "value" => $thisresult.$value };
			    }
			}
		    }
		}
		elsif( $#$inparens < 0 ) {
		}
		else {
		    my $prepend = $result->{0}->{"value"};
		    $result = {};
		    my $expanded = ex_expand( $inparens->[0] );
		    while( my( $id, $var ) = each %$expanded ) {
			$var->{"value"} = $prepend.($var->{"value"});
			$result->{$id} = $var;
		    }
		}
	    }
	}
	return $result;
    }

    # given a variable name return its contents
    sub ex_expand {
        my( $var, $class, $nodeinstance, $instance ) = @_;
	$class = $ex_class unless( $class );
	$instance = $ex_instance unless( $instance );
	$nodeinstance = $ex_nodeinstance unless( $nodeinstance );

	my $index;
	if( $var =~ /\[(\d+)\]$/ ) {
	    $index = $1;
	    $var = $`;
	}
	foreach my $scope ($instance->{"local"}, $instance, $nodeinstance, $class ) {
	    if( defined $scope->{"vars"}->{$var} ) {
		if( defined $index ) {
		    if( defined  $scope->{"vars"}->{$var}->{$index} ) {
			return( { $index => clonehash( $scope->{"vars"}->{$var}->{$index} ) } );
		    }
		    else {
		        return( {} );
		    }
		}
		else {
		    return clonehash( $scope->{"vars"}->{$var} )
		}
	    }
	}
        return( {} );
    }



    sub ex_err {
        my( $message ) = @_;

	$message .= ":\nnext:";
	for( my $i=$ex_atom; $i<=$#$ex_expr; $i++ ) {
	    $message .= " ".$ex_expr->[$i];
	}
	BigSister::common::log( "err", $message );
	$ex_atom = $#$ex_expr;
	# print STDERR $message."\n";
    }
}


sub var_to_array {
    my( $val ) = @_;

    my @result = ();
    foreach my $key (sort { $a <=> $b } keys %$val) {
        push( @result, $val->{$key}->{"value"} );
    }
    return \@result;
}


sub var_to_value {
    my( $val ) = @_;

    my $key = (sort { $a <=> $b } keys %$val)[0];
    return unless( defined $key );
    return( $val->{$key}->{"value"} );
}



################################################################
##
## functions available in test expressions
##
################################################################

sub null {
    my( $var ) = @_;

    return { 0 => { "value" => ( $var && %$var )?0:"TRUE" } };
}


sub contains_pattern {
    my( $arg1, $arg2 ) = @_;
    my @arg2 = @{var_to_array( $arg2 )};
    foreach my $arg (@{var_to_array( $arg1 )}) {
	if( $arg =~ /^\~/ ) {
	    my $pattern = $';
	    if( grep( /$pattern/, @arg2 ) ) {
		return( { 0 => { "value" => "TRUE" } } );
	    }
	}
	elsif( grep( $arg eq $_, @arg2 ) ) {
	    return( { 0 => { "value" => "TRUE" } } );
	}
    }
    return( { 0 => {"value" => 0 } } );
}


sub contains {
    my( $arg1, $arg2 ) = @_;
    my @arg2 = @{var_to_array( $arg2 )};
    foreach my $arg (@{var_to_array( $arg1 )}) {
        if( grep( $arg eq $_, @arg2 ) ) {
	    return( { 0 => { "value" => "TRUE" } } );
	}
    }
    return( { 0 => {"value" => 0 } } );
}


sub not {
    my( $arg ) = @_;

    $arg = var_to_array( $arg );
    return { 0 => {"value" => ($arg && ($#$arg>=0) && $arg->[0])?0:"TRUE"} };
}
       

sub remove {
    my( $from, $what ) = @_;

    my $result = {};
    my $what = var_to_array( $what );
    while( my( $key, $var ) = each %$from ) {
        my $val = $var->{"value"};
	unless( grep( $val eq $_, @$what ) ) {
	    $result->{$key} = $var;
	}
    }
    return $result;
}


sub percentage {
    my( $amount, $base ) = @_;

    $amount = var_to_value( $amount );
    $base = var_to_value( $base );
    unless( defined $amount && defined $base ) {
        return {};
    }
    my $percents = $base ? int(10000*$amount/$base+0.5)/100 : 100;
    return { 0 => { "value" => $percents } };
}


sub format_kbsize {
    my( $sizevar ) = @_;

    my $size = var_to_value( $sizevar );
    return( $sizevar ) unless( $size =~ /^\d/ );
    if( $size > 1024*1024 ) {
        $size = int( $size/1024/102.4 + 0.5 ) / 10;
	$size .= "GB";
    }
    elsif( $size > 1024 ) {
        $size = int( $size/102.4 + 0.5 ) / 10;
	$size .= "MB";
    }
    elsif( $size >= 1 ) {
	$size = int( $size * 10 + 0.5 ) / 10;
        $size .= "kB";
    }
    else {
	$size = int( $size * 1024 + 0.5 );
	$size .= "B";
    }
    return { 0 => { "value" => $size } };
}


sub format_percentage {
    my( $percents ) = @_;

    $percents = var_to_value( $percents );
    if( ($percents > 90) || ($percents < 10) ) {
        $percents = int(10*$percents+0.5)/10;
    }
    else {
        $percents = int($percents+0.5);
    }
    return { 0 => { "value" => $percents."\%" } };
}


sub pad {
    my( $text, $len, $just ) = @_;

    $text = var_to_value( $text );
    $len = var_to_value( $len );
    $just = var_to_value( $just );
    my $pad = "";
    for( my $i=length($text); $i<$len; $i++ ) {
        $pad .= " ";
    }
    if( $just eq "l" ) {
        $text .= $pad;
    }
    elsif( $just eq "r" ) {
        $text = $pad.$text;
    }
    elsif( $just eq "c" ) {
        $text = substr( $pad, 0, length($pad)/2 ).$text.substr( $pad, 0, length($pad)-length($pad)/2 );
    }
    return { 0 => { "value" => $text } };
}


sub in_range {
    my( $lower, $upper, $absolute, $percents ) = @_;

    $lower = var_to_value( $lower );
    $upper = var_to_value( $upper );
    $absolute = var_to_value( $absolute );
    $percents = var_to_value( $percents );
    my $result;
    unless( defined $absolute && defined $percents ) {
        $result = 0;
    }
    elsif( $lower =~ /\%$/ ) {
        $result = $` <= $percents;
    }
    else {
        $result = $lower <= $absolute;
    }
    if( $upper =~ /\%$/ ) {
        $result &&= $` >= $percents;
    }
    else {
        $result &&= $upper >= $absolute;
    }
    return { 0 => { "value" => $result } };
}


sub unmonitored {
    my( $formerly, $now, $description, $text ) = @_;

    $text = "stopped monitoring: " unless( $text );
    $formerly = var_to_array( $formerly );
    $now = var_to_array( $now );
    my @monitor = ();
    foreach my $former (@$formerly) {
        push( @monitor, $former ) unless( grep( $_ eq $former, @$now ) );
    }
    if( @monitor ) {
        my $result = { 
	   0 => { "value" => $text }
	};
	my $idx = 1;
	for( my $i=0; $i<=$#monitor; $i++ ) {
	    $result->{$idx++} = {"value" => $description->{$monitor[$i]}->{"value"}};
	    $result->{$idx++} = {"value" => " " };
	}
	return $result;
    }
    return {};
}


sub nowmonitored {
    my( $formerly, $now, $description ) = @_;

    return unmonitored( $now, $formerly, $description, "started monitoring: " );
}


sub input_kbsize {
    my( $size ) = @_;

    $size = var_to_value( $size );
    $size =~ s#(/s)$##;
    if( $size =~ /k(b|B|)$/ ) {
        $size = $`;
    }
    elsif( $size =~ /M(B|)$/ ) {
        $size = $`*1024;
    }
    elsif( $size =~ /Mb$/ ) {
        $size = $`*1000;
    }
    elsif( $size =~ /G(B|)$/ ) {
        $size = $`*1024*1024;
    }
    elsif( $size =~ /Gb$/ ) {
        $size = $`*1000*1000;
    }
    elsif( $size =~ /T(B|)$/ ) {
        $size = $`*1024*1024*1024;
    }
    elsif( $size =~ /Tb$/ ) {
        $size = $`*1000*1000*1000;
    }
    elsif( $size =~ /^(\d+)$/ ) {
        $size /= 1024;
    }
    return { 0 => { "value" => $size } };
}


# actually this is more or less the same as the "-" operator
sub when {
    my( $current ) = @_;
    my $result = {};

    foreach my $key (keys %$current) {
        next unless( defined $current->{$key}->{"time"} );
	$result->{$key} = { "value" => $current->{$key}->{"time"} };
    }
    return $result;
}


# determine argument size
sub func_size {
    my( $table ) = @_;
    my @entries = keys %$table;
    return { 0 => { "value" => $#entries + 1 } };
}


# determine argument size
sub func_domain_available {
    my( $domain ) = @_;

    $domain = var_to_value( $domain );
    my $handler = Requester::Requester::get_handler( $domain );
    my $available = $handler && $handler->available();
    return { 0 => { "value" => $available } };
}



sub func_if {
    my( $cond, $alt1, $alt2 ) = @_;

    return( var_to_value($cond) ? $alt1 : $alt2 );
}



sub func_call {
    my( $procedure, @args ) = @_;

    $procedure = var_to_value( $procedure );
    if( $procedure =~ /::/ ) {
        require "Requester/$`.pm";
    }
    my $procref = eval "\\&Requester::$procedure";
    return &$procref( @args );
}



sub func_reference_url {
    my( $text, $pattern, $host, $url, $port, $service ) = @_;
    $text = var_to_value( $text );
    $pattern = var_to_value( $pattern );
    $host = var_to_value( $host );
    $url = var_to_value( $url );
    $port = var_to_value( $port );
    $service = var_to_value( $service );

    $_ = $text;
    if( eval( $pattern ) ) {
	$text = $_;
	unless( $url =~ /^[a-z]+:/i ) {
	    my $txt = $service."://$host";
	    if( $port ne $service ) {
		my $number = getservbyname( $port, 6 );
		($number = $port) unless( $number );
		$txt .= ":$number";
	    }
	    $url = $txt.$url;
	}
	if( $text =~ /\<URL\>/ ) {
	    $text = $`.$url.$';
	}
    }
    return { 0 => { "value" => $text } };
}



sub testnames {
    return( keys %{$tests} );
}


sub gettest {
    my( $name ) = @_;

    return $tests->{$name};
}


load_file( new cfgfile( "etc/tests.cfg" ) );
print "Tester known tests: ".join( " ", keys %{$tests} )."\n" if( $BigSister::common::dl>1 );


1;
