package RFC::BaseRelay;
#$Id: BaseRelay.pm,v 1.83 2024/05/01 09:52:50 sqko Exp $


###########################################################################
#
#
#      RFC::BaseRelay
#
#
#  This class defines the behaviour of simple relays
#  To obtain a relay instance use one of the constructors like shown below:
#
#  my $id = BaseRelay->new($name,$rig);
#
#  The rig argument must be a RFC::Rig instance or a similar object honoring
#  the get_conf() member function.
#  The constructior can also be called with additional arguments:
#
#  my $id = BaseRelay->new($name,$rig,$tty,$address,$channel);
#
#  where the last 3 argmeutns specify the serial device, the module address 
#  and the channel number of the relay (as most relay modules contains more 
#  than one relay.
#
#  All relay objects have the following member functions (excluding those 
#  derived from RFC::BaseDevce and Debug.pm):
#
#  $id->set($[$][$])    Sets the status of the relay to the specified arguemnt
#                       one indicates closed relay, 0 open.
#                       If an additional argument is specified, it is assumed to be
#                       the username of the controlling user and that name is appended
#                       to the string appended to the rigs proglog.
#                       an exception to this is if a further argument is specified in 
#                       which case no proglog entry is appended! 
#
#  $id->set_noinfo($)   Similar to set() except no proglog info is appended.
#  $id->master()        Returns a reference to the master device (if such exists).
#
#  It is possible to have a relay device beeing controlled by an other relay device
#  through the observer pattern. To use this feature, set the 'master device' value
#  to the relay acting as the controlling device. Note that a slave relay can not
#  act as a master for an other slave relay (use the original master relay instead)!
#  This feature is in place in order to prevent circular references.
#
#  If no data can be read from the device attatched to the object, the read() 
#  function returns -1 to indicate the error.
#
#  Notice that the bool() function returns 0 (false) in case the status of the relay can 
#  not be determined!
#  
####################################################################



use strict;
use warnings;
use RFC::BaseDevice;
use RFC::Cache;
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 $self = $class->SUPER::new(@_);
    $self->{'_type'} = 'BaseRelay';
    $self->{'_mode'} = 'Automatic';
    $self->{'_setup_tags'} = ['mode','tty','address','channel','title','show_plot','use_cache','CRC','master_device','invert_master'];
    $self->{'_desc'} = {
	'mode' => 'Device control mode',
	    'tty' => 'Serial device for communication',
	    'address' => 'Device address',
	    'channel' => 'Channel number on device (Note is 0 based)',
	    'title' => 'Optional title',
	    'show_plot'=>'Determines if the current device data is to be shown in the daily data plots',
	    'use_cache'=>'Determines if persisten caching of read values is allowed',
	    'CRC' => 'Determines if checksum is to be used for serial communication',
	    'master_device' => 'Master control relay. Relay status will be controlled by master relay status (through the observer pattern)',
	    'invert_master' => 'Inverts status of master relay (if master relay is set)',
    };
    $self->{'_default'} = {
	'mode' => 'Automatic',
	    'tty' => 'ttyS0',
	    'address' => 0,
	    'channel' => 0,
	    'show_plot'=>'Yes',
	    'use_cache'=>'No',
	    'invert_master'=>'No',
	    'CRC'=>'No',
    };
    $self->{'_set_fn_names'} = ['set']; # List of function names which can trigger a notify event
    $self->{'_values_mode'} = ['Automatic'];
    $self->{'_values_CRC'} = ['No','Yes'];
    $self->{'_values_invert_master'} = ['No','Yes'];
    $self->{'_tty'} = 'ttyS0';
    $self->{'_address'} = 0;
    $self->{'_channel'} = 0;
    bless $self,$class;
    $self->{'_section'} = 'relay_'.$self->name;
    $self->{'_title'} = $self->get_conf('title');
    return $self;
}

sub init
{
    my $self = shift;
    $self->load_conf();
    return $self;
}

sub observe($$)
{
    my $self = shift;
    my $action = shift; ## Must always be 'set' or 'set_noinfo' as logic devices emulates relays;
    my $value = shift;
    if ($self->{'_mdev'} && $self->{'_invert_master'} && $self->{'_invert_master'} =~ /yes/i)
    {
	if ($value == 1 )
	{
	    $value = 0;
	}
	else
	{
	    $value = 1;
	}
    }
    $self->set($value,@_) if ($action eq 'set');
    $self->set_noinfo($value,@_) if ($action eq 'set_noinfo');
}

sub set_noinfo($)
{
    my $self = shift;
    my $status = shift;
    $self->writedebug("Setting status for $self to $status") if ($self->debug > 2);
    $self->die($self->{'_type'}." is a base class and does not impelemnt id->set(), only the derived classes does so!");
    $self->notify('set_noinfo',$status,@_);
    return undef;
}

sub set($)
{
    my $self = shift;
    my $status = shift;
    $self->writedebug("Setting status for $self to $status") if ($self->debug > 2);
    $self->die($self->{'_type'}." is a base class and does not impelemnt id->set(), only the derived classes does so!");
    $self->notify('set',$status,@_);
    return undef;
}

sub print_config()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,'TTY: '.$self->{'_tty'};
    push @arr,'Address: '.$self->{'_address'};
    push @arr,'channel: '.$self->{'_channel'};
    return join (', ',@arr);
}

sub master()
{
    my $self = shift;
    return $self->{'_mdev'};
}




package RFC::ManualRelay;
use RFC::Header;
our @ISA = qw(RFC::BaseRelay);

sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{'_type'} = 'ManualRelay';
    $self->{'_mode'} = 'Manual';
    $self->{'_setup_tags'} = ['output_device','title','show_plot','master_device','invert_master'];
    $self->{'_desc'} = {
	'output_device' => 'Relay device for output (optional, can be used to control a physical realy or logic device)',
	'title' => 'Optional title',
        'show_plot'=>'Determines if the current device data is to be shown in the daily data plots',
    };
    $self->{'_default'} = {
	'show_plot' => 'Yes',
    };
    bless $self,$class;
    $self->{'_file'} = SemaforeFile->new($userdir.'rig'.$self->rig->name.'/relay_'.$self->name,'/home/celltest/Gas_rig'.$self->rig->name.'.lock');
    unless ($self->{'_file'}->exist)
    {
        ### Create file with rw for all           ###
        ### Yes I know 666 is the number of evil! ###
        $self->{'_file'}->lock_ex;
        $self->{'_file'}->writeline('0');
        chmod 0666, $self->{'_file'}->filename;
        $self->{'_file'}->unlock;
    }
    $self->load_conf();
    return $self->init();
}

sub init
{
    my $self = shift;
    my @list = ();
    ### Load list of relays for output list ###
    foreach ($self->rig->avaliable_devices('relay'))
    {
        next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    $self->{'_values_output_device'} = ['',@list];
    $self->{'_values_master_device'} = ['',@list];
    $self->{'_mdev'} = undef;
    if ($self->{'_master_device'})
    {
        my $dev = $self->rig->init_device('relay',$self->{'_master_device'});
        $self->die("Could not get a device instance for master device '".$self->{'_master_device'}."'!") unless ($dev);
        $self->die("A device can not be slave to an other slave device!") if ($dev->master);
        $self->{'_mdev'} = $dev;
        $dev->attatch_observer(\$self);
        $self->{'_readonly'} = 1; ### A slave device can not  be directly controlled, only indirectly ###
    }
    my $tag = '_output_device';
    if ($self->{$tag})
    {
	unless ($self->{'_dev'})
	{
	    my $dev = $self->rig->get_device('relay',$self->{$tag});
	    unless ($dev)
	    {
		$dev = $self->rig->init_device('relay',$self->{$tag});
		$dev->readstring_ignore(1) if ($dev);
	    }
	    if ($dev)
	    {
		$dev->debug($self->debug);
		$self->{'_dev'} = $dev; 
		$dev->set_readonly();
	    }
	}
    }
    return $self;
}

sub DESTROY
{
    my $self = shift;
    $self->{'_file'}->DESTROY() if ($self->{'_file'});
    return undef;
}

sub test()
{
    return 1;
}

sub test_string()
{
    my $self = shift;
    my $val = $self->read();
    return $self->name.' is a virtual relay and thus physically controlled manually! Status for relay: '.$val;
}

sub set($)
{
    my $self = shift;
    my $status = shift;
    $self->writedebug("Setting status for relay $self to $status manually!") if ($self->debug > 2);
    $self->{'_file'}->writeline($status);
    $self->notify('set',$status,@_);
    $self->{'_dev'}->set($status,@_) if ($self->{'_dev'});
    $self->proglog(ucfirst("$self set to $status manually"),@_);
    return $status;
}

sub set_noinfo($)
{
    my $self = shift;
    my $status = shift;
    $self->writedebug("Setting status for relay $self to $status manually!") if ($self->debug > 2);
    $self->{'_file'}->writeline($status);
    $self->notify('set_noinfo',$status,@_);
    $self->{'_dev'}->set_noinfo($status,@_) if ($self->{'_dev'});
    return $status;
}

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

sub read
{
    my $self = shift;
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
	$data = RFC::Cache->new();
	$data->debug($self->debug()) if ($self->debug);
    }
    $self->check_cache($data);
    my $flow = 0;
    my $cached = $data->get('manual_relay',$self->name);
    if (defined($cached))
    {
        $self->writedebug("Returnming already cached value for $self") if ($self->debug);
        return $cached;
    }
    else
    {
        $self->writedebug("reading status $self from file") if ($self->debug);
        my @lines = $self->{'_file'}->readlines;
        $flow = $lines[0] if (@lines);
        $data->set('manual_relay',$self->name,$flow);
        return $flow;
    }
}

sub print_config()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,'Mode: '.$self->mode;
    push @arr,'Output: '.$self->{'_dev'}->print_config() if ($self->{'_dev'});
    return join (', ',@arr);
}



package RFC::ICPRelay;
our @ISA = qw(RFC::BaseRelay);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    $self->{'_type'} = 'ICPRelay';
    bless $self,$class;
    foreach my $key ('tty','address','channel','title','show_plot','use_cache','CRC','master_device','invert_master','disable_readstring')
    {
	$self->{'_'.$key} = $self->get_conf($key);
	$self->{'_'.$key} = $self->get_default($key) unless ($self->{'_'.$key});
    }
    $self->{'_ui_fn_names'} = ['query_settings'];
    $self->{'_ui_fn_desc'} = {
        'query_settings' => 'Get and store the settings which can be queried from the module',
    };
    $self->{'_tty'} = shift if (@_);
    $self->{'_address'} = shift if (@_);
    $self->{'_channel'} = shift if (@_);
    $self->{'_channel'} = $self->{'_default'}{'channel'} unless ($self->{'_channel'});
    $self->{'_address'} = $self->{'_default'}{'address'} unless ($self->{'_address'});
    $self->{'_tty'} = $self->{'_default'}{'tty'} unless ($self->{'_tty'});
    return $self->init();
}

sub init()
{
    my $self = shift;
    ### Load list of relays for output list ###
    my @list = ();
    foreach ($self->rig->avaliable_devices('relay'))
    {
        next unless ($_);
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    $self->{'_values_output_device'} = ['',@list];
    $self->{'_values_master_device'} = ['',@list];
    $self->{'_mdev'} = undef;
    if ($self->{'_master_device'})
    {
        my $dev = $self->rig->init_device('relay',$self->{'_master_device'});
        $self->die("Could not get a device instance for master device '".$self->{'_master_device'}."'!") unless ($dev);
        $self->die("A device can not be slave to an other slave device!") if ($dev->master);
        $self->{'_mdev'} = $dev;
        $dev->attatch_observer(\$self);
        $self->{'_readonly'} = 1; ### A slave device can not  be directly controlled, only indirectly ###
    }
    return $self;
}

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

sub query_settings
{
    my $self = shift;
    my $u = '';
    my @list = ();
    $self->rig->begin();
    eval {
        my $str = $self->config;
	CORE::die "Could not get configuration from module $self\n" unless ($str);
        $self->change_cv('config',$str);
        push @list,"Config: $str";
        if ($str && $str =~ /\!\w{6}(\w)\w/)
	{
            my $d = $1;
            if ($d & 4)
            {
                $self->change_cv('CRC','Yes');
            }
            else
            {
                $self->change_cv('CRC','No');
            }
        }
        $self->rig->commit();
    };
    if ($@)
    {
        $self->rig->rollback();
	push @list,'Error: '.$@;
    }
    return join("\n",@list);
}

sub config()
{
    my $self = shift;
    my $res;
    my $cmd = sprintf("\$%02d2",$self->{'_address'});
    if ($self->{'_CRC'} eq 'Yes')
    {
        my $c = 'icp_raw_crc';
        $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
        ### Try 2 times to get configuration ###
        unless (defined($res) && $res =~ /\w/)
        {
            select(undef,undef,undef,0.5);
            $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
        }
        $c = 'icp_raw';
        ### Try 2 times more without checksum to get configuration ###
        unless (defined($res) && $res =~ /\w/)
        {
            select(undef,undef,undef,0.5);
            $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
        }
        unless (defined($res) && $res =~ /\w/)
        {
            select(undef,undef,undef,0.5);
            $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
        }
    }
    else
    {
        my $c = 'icp_raw';
        $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
        ### Try 2 times to get configuration ###
        unless (defined($res) && $res =~ /\w/)
        {
            select(undef,undef,undef,0.5);
            $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
        }
        ### Try 2 times more with checksum to get configuration ###
        $c = 'icp_raw_crc';
        unless (defined($res) && $res =~ /\w/)
        {
            select(undef,undef,undef,0.5);
            $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
        }
        unless (defined($res) && $res =~ /\w/)
        {
            select(undef,undef,undef,0.5);
            $res = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
        }
    }
    chomp $res if (defined($res));
    return $res;
}


sub test()
{
    my $self = shift;
    my $res = undef;
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    my $cmd = 'multiplex';
    $cmd = 'multiplex_crc' if ($self->{'_CRC'} eq 'Yes');
    $res = SocketClient::serial_client($self->{'_tty'},$cmd,'read',$self->{'_address'});
    return 0 unless (defined($res) && $res =~ /\d+/ && $res !~ /error/i);
    my @dat = split(//,$res);
    return 0 unless (@dat > $self->{'_channel'});
    return 1;
}

sub test_string()
{
    my $self = shift;
    my $retval = undef;
    eval {
	$retval = "Status for $self: ".$self->read(@_);
    };
    if ($@)
    {
	return "Error: could not get status for $self, error: ".$@;
    }
    return $retval;
}


sub set($)
{
    my $self = shift;
    my $status = shift;
    my $cmd = 'RELAY';
    $cmd = 'RELAY_crc' if ($self->{'_CRC'} eq 'Yes');
    $self->writedebug("Setting status for $self to $status") if ($self->debug > 2);
    my $res = SocketClient::serial_client_raw($self->{'_tty'},$cmd,$self->{'_address'},$self->{'_channel'},$status);
    $self->writedebug("Response for $self: $res") if ($self->debug > 3);
    $self->notify('set',$status,@_);
    $self->proglog(ucfirst("$self set to $status"),@_);
    return $res;
}

sub set_noinfo($)
{
    my $self = shift;
    my $status = shift;
    $self->writedebug("Setting status for $self to $status") if ($self->debug > 2);
    my $cmd = 'RELAY';
    $cmd = 'RELAY_crc' if ($self->{'_CRC'} eq 'Yes');
    my $res = SocketClient::serial_client_raw($self->{'_tty'},$cmd,$self->{'_address'},$self->{'_channel'},$status);
    $self->writedebug("Response for $self: $res") if ($self->debug > 3);
    $self->notify('set_noinfo',$status);
    return $res;
}

sub read_nocache()
{
    my $self = shift;
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
	$data = RFC::Cache->new();
	$data->debug($self->debug()) if ($self->debug);
    }
    $self->check_cache($data);
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    my $cached = $data->get($tty,'icp',$addr,$self->{'_channel'});
    if ($cached)
    {
	$self->writedebug("Using existing data from relay on tty $tty address $addr") if ($self->debug > 3);
	$self->{'_last_read'} = Time::HiRes::time;
	return $cached;
    }
    else
    {
	$self->writedebug("Reading data from relay on tty $tty address $addr") if ($self->debug > 3);
	my $cmd = 'multiplex';
	$cmd = 'multiplex_crc' if ($self->{'_CRC'} eq 'Yes');
	my $res = SocketClient::serial_client($self->{'_tty'},$cmd,'read',$self->{'_address'});
	unless (defined($res))
	{
	    ### Retry once if no data ##
	    select(undef,undef,undef,0.1);
	    $res = SocketClient::serial_client($self->{'_tty'},$cmd,'read',$self->{'_address'});
	}
	if (defined($res) && $res !~ /error/i)
	{
	    chomp $res;
	    my @dat = split(//,$res);
	    for (my $x = 0; $x < @dat; $x++)
	    {
		$data->set($tty,'icp',$addr,$x,$dat[$x]);
	    }
	    $self->writedebug("Status for $self was ".$dat[$self->{'_channel'}]) if ($self->debug > 2);
	    my $str = time .' '.$self->name.' '.$dat[$self->{'_channel'}];
	    $self->rig->kanaldata($str)  unless ($self->readstring_ignore);
	    $self->set_cache($dat[$self->{'_channel'}]);
	    $self->{'_last_read'} = Time::HiRes::time;
	    return $dat[$self->{'_channel'}];
	}
	else
	{
	    $self->writedebug("Warning: No data returned from $self",1);
	    $data->set($tty,'icp',$addr,$self->{'_channel'},-1);
	    return -1;
	}
    }
}



package RFC::ICPDI;
our @ISA = qw(RFC::ICPRelay);

sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    my $section = shift;
    $self->{'_type'} = 'ICPDI';
    $self->{'_readonly'} = 1;
    $self->{'_mode'} = 'Readonly';
    $self->{'_setup_tags'} = ['mode','tty','address','channel','title','show_plot','use_cache','CRC'];
    $self->{'_desc'} = {
	'mode' => 'Device control mode',
	'tty' => 'Serial device for communication',
	'address' => 'Device address',
	'channel' => 'Channel number on device (Note is 0 based)',
	'title' => 'Optional title',
        'show_plot'=>'Determines if the current device data is to be shown in the daily data plots',
        'use_cache'=>'Determines if persisten caching of read values is allowed',
	'CRC' => 'Determines if checksum is to be used for serial communication',
    };
    $self->{'_default'} = {
	'mode' => 'Readonly',
	'tty' => 'ttyS0',
	'address' => 0,
	'channel' => 0,
        'show_plot'=>'Yes',
        'use_cache'=>'No',
	'CRC' => 'No'
    };
    $self->{'_values_mode'} = ['Readonly'];
    bless $self,$class;
    $self->{'_ui_fn_names'} = ['query_settings'];
    $self->{'_ui_fn_desc'} = {
        'query_settings' => 'Get and store the settings which can be queried from the module',
    };
    return $self;
}

sub set($)
{
    my $self = shift;
    $self->die(ucfirst("$self can not be used for output!"));
    return undef;
}

sub set_noinfo($)
{
    my $self = shift;
    $self->die(ucfirst("$self can not be used for output!"));
    return undef;
}

sub print_config()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,'TTY: '.$self->{'_tty'};
    push @arr,'Address: '.$self->{'_address'};
    push @arr,'channel: '.$self->{'_channel'};
    return join (', ',@arr);
}

return 1;
