package RFC::Alert;
#$Id: Alert.pm,v 1.43 2026/02/17 07:30:11 sqko Exp $
#################################################################
#
#
#       RFC::Alert
#
#
# The RFC::Alert is a device intended to be used for automatic 
# monitoring of process parameters.
#
# Each instance of RFC::Alert can monitor a single parameter (other
# RFC device) and if a given setpoint is passed, a single alert 
# mail is sent to recipients defined by either the alert_mail
# key for the RFC::Rig instance or the global system administrators
# if the alert_mail key is not defined.
#
# If an alert has occoured, the Alert device can be set up to stop any
# running sequential programs for the rig and / or execute a sequence
# of commands which potentially could rectify the situation leading
# up to the alert.
#
# The alert vill be canceled whenever the parameter beeing monitored
# passes the reset threshold.
#
# The alarm level and the reset level determines if the process 
# parameter have to be either above or below the alarm threshold for 
# an alarm to trigger.
# If the reset level is below the alarm threshold, an alarm is triggered
# whenever the process paramater gets above the alarm threshold.
# If the alarm trheshold is below the reset level, the reverse is the case.
#
# RFC::Alert instances are not included in normal data logging, as the 
# values of the monitored device will be logged by that device iteself.
#
# Complex trigger alarms are possible by combining several individual devices 
# through Math devices, schmidt trigger devices and / or logic 
# devices.
# However care should be observed as the more complex the system 
# becomes the bigger the risk of misconfiguration resulting in loss of 
# experimental results (by premature shutdown of key devices for instance).
#
# To obtaina RFC::Alert instance, call the constructor as shown below:
#
# $id = RFC::Alert->new($name,$rig);
#
# The RFC::Alert class defines the following extra public member function:
#
# $id->check([opt cache])   This function tests if the value of the underlying
#                           device is within the range defined as OK or not.
#                           If the value is outside the accepted range, it 
#                           measures a few times more (up to the retries value)
#                           And if the returned value is consistently outside
#                           the accepted range, an alert is raised (potentially
#                           stopping runing programs and/or executing additional
#                           comands which could correct the situation).
#                           If an instance of type RFC::Cache is supplied, this
#                           is passed on to the underlying device potentially 
#                           speeding up operation.
#                           Note that the retry measurements do NOT pass on the
#                           cache (which woulod be pointless)!
#                           The function returns 0 if the value is within the
#                           accepted range and 1 if the alert has been raised
#                           already.
#                           If this call of ckeck() results in the alert beeing
#                           raised, the return value is a text string describing
#                           the alert and any potential actions taken.
#
#
# the RFC::Trigger class is derived from RFC::Alert. The only difference
# is that instances of RFC::Trigger do NOT have the option to terminate 
# running programs or to send mail as they are instended for normal process 
# control and should thus not influence normal program execution.
# They are thus only usefull if they do in fact include trigger commands.
#
# Notice however that if RFC::Trigger devices are used the content
# of the actual trigger commands may render running programs invalid or wrong, so
# care must be observed when using RFC::Trigger devices in control systems!
#
# Be aware that alert devices needs to be enabled / included
# before they can oparate (Similar to most other RFCcontrol evices).
#
#################################################################
use strict;
use warnings;
use RFC::BaseDevice;
use RFC::Header;
use File::Touch;

our @ISA = qw(RFC::BaseDevice);

BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.0;
    %EXPORT_TAGS = (
        'standard'=>[],
                    );
    Exporter::export_ok_tags('standard');
    Exporter::export_tags('standard');
    @ISA = qw(Exporter);
}

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->die("second argument to new must be a RFC::Rig instance!") unless (ref($rig) eq 'RFC::Rig');
    $self->{'_type'} = 'Alert';
    $self->{'_setup_tags'} = ['class','device_type','device','read_function','title','threshold','reset','retries','kill_program','execute_commands','command_list','output_enable','warning_mails','mail_subject','mail_text'];
    $self->{'_setup_tags_readonly'} = [];
    $self->{'_mail'} = 1;
    $self->{'_desc'} = {
	'class' => 'Device class',
	    'device_type' => 'Type of raw device',
	    'device' => 'Raw device',
	    'title' => 'Optional title',
	    'threshold' => 'Threshold over (or under) which the devices triggeres an alert mail. If the threshold value is higher than the reset value the device value must be higher than the trigger level to trigger an alert, if threshold is lowet than reset value, a value below the threshold value triggers an alert.',
	    'reset' => 'Value under (or over) the device resets the alert. If the threshold value is higher than the reset value the device value must be higher than the trigger level to trigger an alert, if threshold is lowet than reset value, a value below the threshold value triggers an alert.',
	    'retries' => 'The number of retries performed before an alert is triggered (to awoid single read errors to triger alerts)',
	    'kill_program' => 'Terminate any running sequential program if alert is triggered (only terminated once / alert)',
	    'execute_commands' => 'Execute additional commands if alert is triggered (only executed once / alert)',
	    'command_list' => 'List of commands to be executed upon alert trigger. Uses exactly same structure as normal sequential programs. Do NOT include comands which require a komma "," in the argument list or any commands depending on external resources (timeslot and/or impedance commands etc)',
	'read_function' => 'Device function to use for read operations',
	'output_enable' => 'Relay name used to control if this device should act on a trigger event or not. If defined and the specified relay device returns 0, any call to check() will return without any actions! (effectively disabling this device)',
	'warning_mails' => 'Comma separated list of email addresses which will recieve warnings if the threshold is exceeded. If no value is given, the global list is used as default instead',
        'mail_subject' => 'Subject of alert mail, if no is supplied the default is used "Value for device is above/below threshold". Note that the device nami is always appended in paranthesis to be able to identify the device.',
        'mail_text' => 'Additional text to be included in warning mail. Do NOT use comma "," in text as it is used as a newline placeholder!',
    };
    $self->{'_default'} = {
	'class' => 'Normal',
	    'device_type' => 'simplechannel',
	    'device' => '',
	    'threshold' => 1,
	    'reset' => 0.5,
	    'retries' => 3,
	    'kill_program' => 'No',
	    'execute_commands' => 'No',
	    'command_list' => '',
	    'read_function' => 'read',
	    'output_enable' => '',
	    'warning_mails' => '',
	    'mail_text' => ''
    };
    $self->{'_values_class'} = [(RFC::Device::list_Alert())];
    $self->{'_values_kill_program'} = ['Yes','No'];
    $self->{'_values_execute_commands'} = ['Yes','No'];
    bless $self,$class;
    my @list = ('');
    foreach my $t ($self->rig->list_types())
    {
	next unless ($t);
	### Exclude PID and Alert device classes as they make no sense using for input devices for a alert ###
	### For PID devices, anerts should be on the measure device directly and alerts of alert-devices   ###
	### is kind of pointless....                                                                       ###
 	next if ($t eq 'PID');
	next if ($t eq 'Alert');
	push @list,$t;
    }
    $self->{'_values_device_type'} = [@list];
    $self->{'_section'} = 'Alert_'.$self->name;
    $self->load_conf();
    $self->{'_values_output_enable'} = ['',$self->rig->avaliable_devices('relay')];
    $self->{'_values_device'} = ['',$self->rig->avaliable_devices($self->{'_device_type'})];
    if ($self->{'_device_type'} && $self->{'_device'})
    {
        my $dev = $self->rig->get_device($self->{'_device_type'},$self->{'_device'});
	unless ($dev)
	{
	    $dev = $self->rig->init_device($self->{'_device_type'},$self->{'_device'});
	    $dev->readstring_ignore(1) if ($dev);

	}
        $self->{'_dev'} = $dev if ($dev);       
	my @arr = ('read');
	@arr = $self->{'_dev'}->read_names() if ($self->{'_dev'});
	$self->{'_values_read_function'} = \@arr;
    }
    if ($self->{'_output_enable'})
    {
        my $dev = $self->rig->get_device('relay',$self->{'_output_enable'});
	unless ($dev)
	{
	    $dev = $self->rig->init_device('relay',$self->{'_output_enable'});
	    $dev->readstring_ignore(1) if ($dev);

	}
        $self->{'_output_enable_dev'} = $dev if ($dev);       	
    }
    my $recipients = $self->rig->get_cv('main','warning_mails');
    $recipients = $self->{'_warning_mails'} if ($self->{'_warning_mails'});
    if ($recipients)
    {
	$self->{'_info_string'} = 'Alert mail will be sent to: '.$recipients;
    }
    else
    {
	$self->{'_info_string'} = 'Warning, no recipients defined for warning mail! Alerts will only be sent to system administrators! (please setup recipients under miscelaneous setup)';
    }
    $self->{'_class'} = 'Normal';
    return $self;
}


sub print_config()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Threshold: '.$self->{'_threshold'};
    push @arr,'Reset: '.$self->{'_reset'};
    my $kill = 'No';
    $kill = 'Yes' if ($self->{'_kill_program'} && $self->{'_kill_program'} eq 'Yes');
    push @arr,'Kill_program: '.$kill;
    my $ex = 'No';
    $ex = 'Yes' if ($self->{'_execute_commands'} && $self->{'_execute_commands'} eq 'Yes');
    $ex = 'No' unless ($self->{'_command_list'});
    push @arr,'Execute commands: '.$ex;
    push @arr,'Commands: "'.$self->{'_command_list'}.'"' if ($self->{'_command_list'});
    push @arr,'Output enable: '.$self->{'_output_enable_dev'}->print_config() if ($self->{'_output_enable_dev'});
    return join (', ',@arr);
}

sub status
{
    my $self = shift;
    my $val = $self->read(@_);
    if ($self->{'_threshold'} < $self->{'_reset'})
    {
	if ($val < $self->{'_threshold'})
	{
	    return 1;
	}
	if ($val > $self->{'_reset'})
	{
	    return 0;
	}
    }
    else
    {
	if ($val > $self->{'_threshold'})
	{
	    return 1;
	}	
	if ($val < $self->{'_reset'})
	{
	    return 0;
	}
    }
    return undef;
}

sub has_triggered
{
    my $self = shift;
    return 1 if $self->rig->check_warning($self);
    return 0;
}

sub check
{
    my $self = shift;
    return undef unless ($self->device());
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug) if ($self->debug);
    }
    $self->check_cache($data);
    return undef unless ($self->do_output($data));
    my $val = $self->read($data);
    my $count = $self->{'_retries'};
    if ($self->{'_threshold'} < $self->{'_reset'})
    {
	if ($val > $self->{'_threshold'})
	{
	    $self->rig->unset_warning($self);
	    return 0;
	}
	return 1 if $self->rig->check_warning($self);
	while ($count--)
	{
	    sleep(1);
	    $data = RFC::Cache->new();
	    $val = $self->read($data);
	    return 0 if ($val > $self->{'_threshold'});
	} 
	return $self->alert("Value for '".$self->device->name."' is below threshold (".$self->{'_threshold'}.").\nMeasured value: $val",'Alert from rig '.$self->rig->name.", Alert device '".$self->name. "' has triggered!",$data);
    }
    else
    {
	if ($val < $self->{'_threshold'})
	{
	    $self->rig->unset_warning($self);
	    return 0;
	}
	return 1 if $self->rig->check_warning($self);
	while ($count--)
	{
	    sleep(1);
	    $data = RFC::Cache->new();
	    $val = $self->read($data);
	    return 0 if ($val < $self->{'_threshold'});
	}
	return $self->alert("Value for '".$self->device->name."' is above threshold (".$self->{'_threshold'}.").\nMeasured value: $val",'Alert from rig '.$self->rig->name.", Alert device '".$self->name. "' has triggered!",$data);
    }
}

sub do_output()
{
    my $self = shift;
    if ($self->{'_output_enable_dev'} && $self->{'_output_enable_dev'}->read(@_) == 0)
    {
	return 0;
    }
    return 1;
}


sub test
{
    my $self = shift;
    my $ok = 1;
    $ok = 0 unless ($self->device->test(@_));
    if ($self->{'_output_enable_dev'})
    {
	$ok = 0 unless ($self->{'_output_enable_dev'}->test(@_));
    }
    return $ok;
}

sub Accept
{
    my $self = shift;
    my $visitor= shift;
    return undef if ($self->{'_seen_visitors'}{$visitor});
    $self->{'_dev'}->Accept($visitor) if ($self->{'_dev'});       
    $visitor->VisitComplex($self);
    $self->{'_seen_visitors'}{$visitor} = 1;
    return undef;
}


sub test_string
{
    my $self = shift;
    $self->{'_mail'} = 0;
    my $str;
    my $status = $self->status(@_);
    my $trg = $self->has_triggered(@_);
    if (defined($status))
    {
	if ($status)
	{
	    $str = 'Status for alert device '.$self->name.': Not ok. Device value: '.$self->read(@_); 
	    if ($trg)
	    {
		$str .= "\nTrigger action(s) has run";
	    }
	    else
	    {
		$str .= "\nTrigger action(s) has NOT run yet!";
	    }
	}
	else
	{
	    $str = 'Status for alert device '.$self->name.': Ok. Device value: '.$self->read(@_); 
	    if ($trg)
	    {
		$str .= "\nDevice has not yet reset!";
	    }
	}
    }
    else
    {
	$str = 'Status for alert device '.$self->name.': within hysteresis. Device value: '.$self->read(@_); 
	if ($trg)
	{
	    $str .= "\nTrigger actions has run";
	}
	else
	{
	    $str .= "\nDevice has reset!";
	}	
    }
    $str .= "\n\n".$self->device->test_string(@_);
    if ($self->{'_output_enable_dev'})
    {
	my $enabled = $self->{'_output_enable_dev'}->read(@_);
	if ($enabled)
	{
	    $str .= "\nOutput: ENABLED - ".$self->{'_output_enable_dev'}->test_string(@_);	    
	}
	else
	{
	    $str .= "\nOutput: DISABLED - ".$self->{'_output_enable_dev'}->test_string(@_);
	}
    }
    else
    {
	$str .= "\nOutput: ENABLED\n";
    }
    $self->{'_mail'} = 1;
    return $str;
}


sub kill_program()
{
    my $self = shift;
    return 0 unless ($self->do_output(@_));
    return 0 unless ($self->{'_kill_program'} && $self->{'_kill_program'} eq 'Yes');
    $self->writedebug("Killing running program") if ($self->debug);
    my $cmd = '/bin/ps -efl | /bin/grep custom_prog.pl';
    my @list = `$cmd`;
    $self->writedebug(@list) if ($self->debug);
    my $r = $self->rig->name();
    for my $st (@list)
    {
        chomp $st;
        ### Finding the right processid to kill ###
        if ($st =~ /^\d+\s+\w+\s+rig$r\s+(\d+)\s+.*\/custom_prog\.pl\s+$r\s+/ )
        {
            my $pid = $1+0;
	    $self->writedebug("Killing program with PID $pid") if ($self->debug() > 1);
            ### Using a SIGINT (kill -s 2) to emulate a Ctrl+C to custom_prog.pl ###
            system("/bin/kill -s 2 $pid &");
	    return 1;
        }   
    }
    return 0;
}


sub kill_furnace_program()
{
    my $self = shift;
    return 0 unless ($self->do_output(@_));
    return 0 unless ($self->{'_kill_program'} && $self->{'_kill_program'} eq 'Yes');
    $self->writedebug("Killing running program") if ($self->debug);
    my $cmd = '/bin/ps -efl | /bin/grep run_furnace.pl';
    my @list = `$cmd`;
    $self->writedebug(@list) if ($self->debug);
    my $r = $self->rig->name();
    for my $st (@list)
    {
        chomp $st;
        ### Finding the right processid to kill ###
        if ($st =~ /^\d+\s+\w+\s+rig$r\s+(\d+)\s+.*\/run_furnace\.pl/ )
        {
            my $pid = $1+0;
	    $self->writedebug("Killing program with PID $pid") if ($self->debug() > 1);
            ### Using a SIGINT (kill -s 2) to emulate a Ctrl+C to custom_prog.pl ###
            system("/bin/kill -s 2 $pid &");
	    return 1;
        }   
    }
    return 0;
}

sub execute_cmds()
{
    my $self = shift;
    return 0 unless ($self->do_output(@_));
    return 0 unless ($self->{'_execute_commands'} && $self->{'_execute_commands'} eq 'Yes');
    return 0 unless ($self->{'_command_list'});
    $self->writedebug("Executing command list") if ($self->debug);
    my @lines = split(/\,/,$self->{'_command_list'});
    $self->writedebug(join("\n",@lines)) if ($self->debug > 1);
    my $file = '/tmp/Rig'.$self->rig->name.'_Alert_'.$self->name;
    unless (-e $file)
    {
	touch $file;
	chmod 0666,$file;
    }
    open ALERT,'>',$file or $self->die("could not open file $file for writing $!");
    print ALERT join("\n",@lines);
    close ALERT;
    my $cmd = $RFC::Header::libdir.'custom_prog.pl '.$self->rig->name.' '.$file.' >/dev/null &';
    $self->writedebug($cmd) if ($self->debug > 1);
    system($cmd);
    return 1;
}

sub alert
{
    my $self = shift;
    my $message = shift;
    my $subj = shift;
    if ($self->{'_mail_subject'})
    {
	$subj = $self->{'_mail_subject'} .' ( Device '.$self->name. ' )';
    }
    if ($self->{'_mail'})
    {
	my $emails =  $self->{'_warning_mails'};
	$message .= "\nRunning program terminated!" if ($self->kill_program(@_));
	$message .= "\nRFCFurnace program terminated!" if ($self->kill_furnace_program(@_));
	$message .= "\nTrigger commands activated!" if ($self->execute_cmds(@_));
	$message .= "\n\nDevice status:\n".$self->device->test_string(@_);
	if ($self->{'_mail_text'})
	{
	    my $txt = $self->{'_mail_text'};
	    $txt =~ s/\,/\n/g;
	    $message .= "\n\nAdditional minformation:\n".$txt;
	}
	if ($self->do_output(@_))
	{
	    my $ignore = $self->rig->disable_warning_mails();
	    $self->rig->disable_warning_mails(0);
	    if ($self->{'_warning_mails'})
	    {
		$self->rig->warning_mail($self,$message,$subj,$self->{'_warning_mails'}); 
	    }
	    else
	    {
		$self->rig->warning_mail($self,$message,$subj);
	    }
	    $self->rig->disable_warning_mails($ignore);
	}
	return 1;
    }
    else
    {
	return $subj."\n".$message;
    }
}

sub device()
{
    my $self = shift;
    return $self->{'_dev'};
}


sub read
{
    my $self = shift;
    return $self->device->read_named($self->{'_read_function'},@_) if ($self->device());
    return -32768;
}

sub read_nocache
{
    my $self = shift;
    $self->{'_last_read'} = Time::HiRes::time;
    return $self->read(@_);
}


package RFC::Trigger;
use RFC::Header;
our @ISA = qw(RFC::Alert);

sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{'_setup_tags'} = ['class','device_type','device','read_function','title','threshold','reset','retries','command_list','output_enable'];
    $self->{'_type'} = 'Trigger';
    $self->{'_mail'} = 0;
    $self->{'_class'} = 'Trigger';
    $self->{'_default'}{'class'} = 'Trigger';
    $self->{'_execute_commands'} = 'Yes';
    $self->{'_kill_program'} = 'No';
    $self->{'_info_string'} = 'Note that RFC::Trigger devices do not send emails and can only do anything usefull if they have trigger commands.';
    bless $self,$class;
    return $self;
}

sub test_string
{
    my $self = shift;
    my $str;
    my $status = $self->status(@_);
    my $trg = $self->has_triggered(@_);
    if (defined($status))
    {
	if ($status)
	{
	    $str = 'Status for alert device '.$self->name.': Not ok. Device value: '.$self->device->read(@_); 
	    if ($trg)
	    {
		$str .= "\nTrigger action(s) has run";
	    }
	    else
	    {
		$str .= "\nTrigger action(s) has NOT run yet!";
	    }
	}
	else
	{
	    $str = 'Status for alert device '.$self->name.': Ok. Device value: '.$self->device->read(@_); 
	    if ($trg)
	    {
		$str .= "\nDevice has not yet reset!";
	    }
	}
    }
    else
    {
	$str = 'Status for alert device '.$self->name.': within hysteresis. Device value: '.$self->device->read(@_); 
	if ($trg)
	{
	    $str .= "\nTrigger actions has run";
	}
	else
	{
	    $str .= "\nDevice has reset!";
	}	
    }
    $str .= "\n\n".$self->device->test_string(@_);
    if ($self->{'_output_enable_dev'})
    {
	my $enabled = $self->{'_output_enable_dev'}->read(@_);
	if ($enabled)
	{
	    $str .= "\nOutput: ENABLED - ".$self->{'_output_enable_dev'}->test_string(@_);	    
	}
	else
	{
	    $str .= "\nOutput: DISABLED - ".$self->{'_output_enable_dev'}->test_string(@_);
	}
    }
    else
    {
	$str .= "\nOutput: ENABLED\n";
    }
    return $str;
}

sub alert
{
    my $self = shift;
    my $res = $self->execute_cmds();
    $self->rig->set_warning($self);
    return $res;
}

return 1;

