package RFC::Simple;
#$Id: Simple.pm,v 1.140 2020/09/03 12:33:03 sqko Exp $

#################################################################
#
#
#       RFC::Simple
#
# This class defines simple dataloging (readonly) channel setup
# To obtain an instance of this class call one of the constructors 
# like:
#
# $id = RFC::Simple->new($name,$rig)
#
# In case of an RFC::keithley or RFC::SimpleICP instance, it can 
# also be obtained by 
#
# $id = RFC::Keithley->new($name,$rig,$channel)
#
# or similarly for a RFC::SimpleICP instance.
#  
# The reason for the last option is to allow the instantiation 
# of a device without a separate setup section.
#
# The RFC::Simple module defines no new member functions.
# However all simplechannel devices have the configuration option
# of using a scaling factor (effectively a number which is multiplied
# with the raw physical value). For instance this enables a value
# to be reported in mV even though it is measured in Volt by setting
# the scaling factor to 1000. 
#
# The avaliable devices are:
#
# $id = RFC::SimpleExternal->new($name,$rig)
#
# $id = RFC::SimpleSocket->new($name,$rig)
#
# $id = RFC::SimpleSOAP->new($name,$rig)
#
# $id = RFC::Keithley->new($name,$rig)
#
# $id = RFC::KeithleyMOM->new($name,$rig)
#
# $id = RFC::SimpleICP->new($name,$rig)
#
# $id = RFC::SimpleICP7017->new($name,$rig)
#
# $id = RFC::SimpleICP7019->new($name,$rig)
#
# $id = RFC::SimpleModbus->new($name,$rig)
#
# $id = RFC::ModbusTCP->new($name,$rig)
#
# The SimpleExternal deivce is a vrapper device for a call to an external program.
# This allows access to read and log non-RFCcontrol programs providing a wrapper
# program or link to the program is placed in /usr/local/bin/celltest/external
# Any call to programs in this directory must print a number when executed.
# Additionally, programs in this directory may only contain letters and '.' in 
# the filename (this is to prevent the possibility for code injection).
# 
# Note however that any program placed in this directory can be called from any user
# who can log in to any of the rigs on the server, so take care that programs placed
# in this directory can not do anything that could damage anything (imagine what a 
# wrapper for 'rm -rf .*' could do.....)
#
# The SimpleExternal and SimpleSocket classes has a special option for reading
# the timestamp form the external program or system.
# If the returned value has a hash-mark in it, then the string after the hash mark
# is evaluated to see if it can be parsed to a timestamp.
# If so, the timestamp fo the measurement is set to this value instead of the local
# time the call was made (as is normal for most other devices). 
#
##################################################################

use strict;
use warnings;
use RFC::BaseDevice;
use RFC::Cache;
use Date::Parse;
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);
    bless $self,$class;
    $self->{'_readstring_furnace'} = 1;
    $self->{'_type'} = 'SimpleChannel';
    $self->{'_mode'} = 'Readonly';
    $self->{'_setup_tags'} = ['mode','channel','factor','title','show_plot','use_cache'];
    $self->{'_reload_tags'} = ['type','mode'];
    $self->{'_desc'} = {
	'mode' => 'Device control mode',
	'channel' => 'Channel number of input device',
	'factor' => 'Scaling factor',
	'title' => 'Optional title',
        'use_cache'=>'Determines if persisten caching of read values is allowed',
    };
    $self->{'_default'} = {
	'type' => 'Keithley',
        'mode' => 'Readonly',
        'channel' => 0,
        'factor' => 1,
        'show_plot'=>'Yes',
        'use_cache'=>'No',
    };
    $self->{'_values_mode'} = ['Readonly'];
    $self->{'_set_names'} = [];
    $self->{'_channel'} = undef;
    my $test = shift;
    $self->{'_channel'} = $test if ($test);
    $self->{'_section'} = 'channel_'.$self->name;
    $self->{'_title'} = $self->get_conf('title');
    $self->{'_readonly'} = 1;
    return $self;
}

sub read_nocache
{
    my $self = shift;
    $self->die($self->type." is a base class and does not impelemnt id->read_nocache(), only the derived classes does so!");
    return undef;
}

sub readstring
{
    my $self = shift;
    if ($self->is_caching())
    {
	return $self->SUPER::readstring(@_);
    }
    return undef if ($self->readstring_ignore);
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
	$data = RFC::Cache->new();
	$data->debug($self->debug) if ($self->debug);
    }
    $self->check_cache($data);
    my $val = $self->read($data);
    $val = -32768 unless defined($val);
    my $res = $data->get($self->type,$self->{'_channel'});
    if ($res)
    {
	my @rep = split(/\s+/,$res);
	$res = join(' ',$self->name,$rep[0],$rep[1],$val);
	$self->writedebug($res) if ($self->debug > 2);
	return $res;
    }
    else
    {
	my @t = $self->get_time();
	my $t = join(':',@t);
        $self->writedebug("No data could be read from device '".$self->name."' using dummy value!") if ($self->debug);
	my $res = join(' ',$self->name,$t,time,-32768);
	return $res;
    }
}

sub print_config()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Input type: '.$self->type;
    push @arr,'Channel: '.$self->{'_channel'};
    push @arr,'Factor: '.$self->{'_factor'};
    return join(', ',@arr);
}

package RFC::SimpleExternal;
our @ISA = qw(RFC::Simple);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig,@_);
    bless $self,$class;
    $self->{'_type'} = 'External';
    $self->{'_setup_tags'} = ['mode','program','factor','title','show_plot','use_cache'];
    $self->{'_default'} = {
	'type' => 'External',
        'mode' => 'Readonly',
	'program' => 'time.pl',
        'factor' => 1,
        'show_plot'=>'Yes',
        'use_cache'=>'No',
    };
    $self->{'_desc'} = {
	'mode' => 'Device control mode',
	'program' => "External program to call when a read request on this device is called.\nThe program must recide in /usr/local/bin/celltest/external/\nand must return a number when executed.\nThe filename must also contain only digits, letters and '.' (this restriction is in order to prevent code injection).\nThe program is called with a single argument: the rig number ('15' in case of rig15)\nwhich can either be ignored or used by the program to distinguish between different rigs when called.",
	'factor' => 'Scaling factor',
	'title' => 'Optional title',
        'use_cache'=>'Determines if persisten caching of read values is allowed',
    };
    bless $self,$class;
    $self->{'_time'} = 0;
    $self->load_conf();
    $self->{'_dir'} = '/usr/local/bin/celltest/external/';
    opendir DIR, $self->{'_dir'} or die "cant open dir ".$self->{'_dir'}." for reading";
    my @list = grep !/^\.\.?$/, readdir(DIR);
    closedir DIR;
    my @files = ();
    foreach my $f (@list)
    {
	my $fn = $self->{'_dir'}.$f;
	push @files,$f if (-x $fn);
    }
    $self->{'_values_program'} = [@files];
    my $p = $self->{'_program'};
    if ($p && $p =~ /([\w\.]+)/)
    {
	$p = $1;
    }
    else
    {
	$p = '';
    }
    $self->{'_program'} = $p;
    return $self;
}

sub readstring
{
    my $self = shift;
    if ($self->is_caching())
    {
        return $self->SUPER::readstring(@_);
    }
    return undef if ($self->readstring_ignore);
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug) if ($self->debug);
    }
    $self->check_cache($data);
    my $val = $self->read($data);
    $val = -32768 unless defined($val);
    my @t = $self->get_time();
    my $t = join(':',@t);
    my $res = join(' ',$self->name,$t,$self->get_utime(),$val);
    return $res;
}


sub test
{
    my $self = shift;
    my $fn = $self->{'_dir'}.$self->{'_program'};
    return 1 if (-e $fn && -x $fn);
    return 0;
}

sub get_utime
{
    my $self = shift;
    if ($self->{'_time'})
    {
	my $t = 0;
	eval {
            $t = Date::Parse::str2time($self->{'_time'});
	};
	if ($@)
	{
	    return time;
	}
	return $t;
    }
    else
    {
	return time;
    }
}

sub get_time
{
    my $self = shift;
    if ($self->{'_time'})
    {
	my @rt = ();
	eval {
            my $t = Date::Parse::str2time($self->{'_time'});
            my @t = localtime($t);
	    $t[5] += 1900;
	    $t[4]++;
	    my $time = sprintf("%04d %02d %02d %02d %02d %02d",$t[5],$t[4],$t[3],$t[2],$t[1],$t[0]);
	    @rt = split(/\s+/,$time);
	};
	if ($@)
	{
	    return $self->SUPER::get_time();
	}
	return @rt;
    }
    else
    {
	return $self->SUPER::get_time();
    }
}

sub read_nocache
{
    my $self = shift;
    my $fn = $self->{'_dir'}.$self->{'_program'}.' '.$self->rig->name;
    my $res = `$fn`;
    chomp $res;
    if (defined($res) && $res =~ /#/)
    {
	my ($d,$t) = split(/#/,$res);
	$res = $d;
	$self->{'_time'} = $t;
    }
    else
    {
	$self->{'_time'} = 0;
    }
    $res = $res * $self->{'_factor'};
    if ($self->{'_time'})
    {
	$self->set_cache($res,$self->{'_time'});	
    }
    else
    {
	$self->set_cache($res);	
    }
    return $res;
}

sub test_string
{
    my $self = shift;
    my $res = $self->read(@_);
    return "Simple channel ".$self->name.": $res\n";
}


package RFC::SimpleSocket;
use SocketClient;
our @ISA = qw(RFC::Simple);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig,@_);
    bless $self,$class;
    $self->{'_type'} = 'Socket';
    $self->{'_setup_tags'} = ['mode','host','port','command','arguments','factor','title','show_plot','use_cache'];
    $self->{'_default'} = {
	'type' => 'Socket',
	'host' => 'localhost',
	'port' => '2020',
	'command' => 'read',
	'arguments' => '',
        'mode' => 'Readonly',
        'factor' => 1,
        'show_plot'=>'Yes',
        'use_cache'=>'No',
    };
    $self->{'_desc'} = {
	'mode' => 'Device control mode',
	'host' => 'IP or hostname of server to contact',
	'port' => 'Port number',
	'command' => 'Command to execute by host',
	'arguments' => 'Optional arguments passed to server, separate by comma',  
	'factor' => 'Scaling factor',
	'title' => 'Optional title',
        'use_cache'=>'Determines if persisten caching of read values is allowed',
    };
    bless $self,$class;
    $self->{'_time'} = 0;
    $self->load_conf();
    $self->{'_info_string'} = 'By using socket calls to remote systems, the reliability of the RFCcontrol data logging system may be compromised by network errors or power outages for the remote system!';
    return $self;
}


sub test
{
    my $self = shift;
    return 1;
}

sub get_utime
{
    my $self = shift;
    if ($self->{'_time'})
    {
	my $t = 0;
	eval {
            $t = Date::Parse::str2time($self->{'_time'});
	};
	if ($@)
	{
	    return time;
	}
	return $t;
    }
    else
    {
	return time;
    }
}

sub get_time
{
    my $self = shift;
    if ($self->{'_time'})
    {
	my @rt = ();
	eval {
            my $t = Date::Parse::str2time($self->{'_time'});
            my @t = localtime($t);
	    $t[5] += 1900;
	    $t[4]++;
	    my $time = sprintf("%04d %02d %02d %02d %02d %02d",$t[5],$t[4],$t[3],$t[2],$t[1],$t[0]);
	    @rt = split(/\s+/,$time);
	};
	if ($@)
	{
	    return $self->SUPER::get_time();
	}
	return @rt;
    }
    else
    {
	return $self->SUPER::get_time();
    }
}

sub read_nocache
{
    my $self = shift;
    my @args = ();
    my $res = undef;
    @args = split(/\s*\,\s*/,$self->{'_arguments'}) if ($self->{'_arguments'});
    eval {
        $res = SocketClient::socket_client_raw($self->{'_host'},$self->{'_port'},$self->{'_command'},@args);
    };
    if ($@)
    {
        $self->writedebug("No data returned by remote host for simplechannel, retrying ".$self->name.', Error: '.$@);
    }
    unless (defined($res))
    {
        eval {
            $res = SocketClient::socket_client_raw($self->{'_host'},$self->{'_port'},$self->{'_command'},@args);
        };
        if ($@)
        {
            $self->writedebug("No data returned by remote host for simplechannel, giving up ".$self->name.', Error: '.$@);
        }
        unless (defined($res))
        {
            $res = -32768;
            $self->writedebug("Undefined data returned by remote host for simplechannel ".$self->name);
	}
    }
    chomp $res;
    if (defined($res) && $res =~ /#/)
    {
	my ($d,$t) = split(/#/,$res);
	$res = $d;
	$self->{'_time'} = $t;
    }
    else
    {
	$self->{'_time'} = 0;
    }
    $self->writedebug("Raw read from remote host for simplechannel ".$self->name.': '.$res) if ($self->debug);
    $res = $res * $self->{'_factor'};
    if ($self->{'_time'})
    {
	$self->set_cache($res,$self->{'_time'});	
    }
    else
    {
	$self->set_cache($res);	
    }
    return $res;
}

sub test_string
{
    my $self = shift;
    my @args = ();
    my $res;
    @args = split(/\s*\,\s*/,$self->{'_arguments'}) if ($self->{'_arguments'});
    eval {
	$res = SocketClient::socket_client($self->{'_host'},$self->{'_port'},$self->{'_command'},@args);
    };
    if ($@)
    {
	return "No data returned by remote host for simplechannel ".$self->name.', Error: '.$@;
    }
    unless (defined($res))
    {
	$res = "Undefined data returned by remote host"; 
    }
    $res = $res * $self->{'_factor'};
    return "Simple channel ".$self->name.": $res\n";
}

sub readstring
{
    my $self = shift;
    if ($self->is_caching())
    {
        return $self->SUPER::readstring(@_);
    }
    return undef if ($self->readstring_ignore);
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug) if ($self->debug);
    }
    $self->check_cache($data);
    my $val = $self->read($data);
    $val = -32768 unless defined($val);
    my @t = $self->get_time();
    my $t = join(':',@t);
    my $res = join(' ',$self->name,$t,$self->get_utime(),$val);
    return $res;
}

sub print_config()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Input type: '.$self->type;
    push @arr,'Host: '.$self->{'_host'};
    push @arr,'Port: '.$self->{'_port'};
    push @arr,'Command: '.$self->{'_command'};
    push @arr,'Arguments: '.$self->{'_arguments'} if ($self->{'_arguments'});
    push @arr,'Factor: '.$self->{'_factor'};
    return join(', ',@arr);
}

package RFC::SimpleSOAP;
use SOAP::Lite;
our @ISA = qw(RFC::Simple);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig,@_);
    bless $self,$class;
    $self->{'_type'} = 'SOAP';
    $self->{'_setup_tags'} = ['mode','wsdl','command','arguments','factor','title','show_plot','use_cache'];
    $self->{'_default'} = {
	'type' => 'SOAP',
	'wsdl' => '',
	'command' => 'read',
	'arguments' => '',
        'mode' => 'Readonly',
        'factor' => 1,
        'show_plot'=>'Yes',
        'use_cache'=>'No',
    };
    $self->{'_desc'} = {
	'mode' => 'Device control mode',
	'wsdl' => 'URL of the WSDL file describing the service',
	'command' => 'Command to execute by host',
	'arguments' => 'Optional arguments passed to server, separate by comma',  
	'factor' => 'Scaling factor',
	'title' => 'Optional title',
        'use_cache'=>'Determines if persisten caching of read values is allowed',
    };
    bless $self,$class;
    $self->load_conf();
    $self->{'_info_string'} = 'By using SOAP calls to remote systems, the reliability of the RFCcontrol data logging system may be compromised by network errors or power outages for the remote system!';
    return $self;
}

sub init
{
    my $self = shift;
    unless ($self->{'_soap'})
    {
	$self->{'_soap'} = SOAP::Lite->on_fault(\&RFC::SimpleSOAP::soapGetBad)->service($self->{'_wsdl'});
    }
    return $self;
}

sub test
{
    my $self = shift;
    $self->init();
    my $res;
    eval {
	my @args = ();
	@args = split(/\s*\,\s*/,$self->{'_arguments'}) if ($self->{'_arguments'});
	my $fn = $self->{'_command'};
	$res = $self->{'_soap'}->$fn(@args);
    };
    if ($@)
    {
	return 0;
    }
    unless (defined($res))
    {
	return 0;
    }
    return 1;
}

sub soapGetBad {
    my $soap = shift;
    my $res = shift;
    if( ref( $res ) ) {
        chomp( my $err = $res->faultstring );
        CORE::die $err;
    }
    else {
        chomp( my $err = $soap->transport->status );
	CORE::die $err;
    }
}

sub read_nocache
{
    my $self = shift;
    my $res = -32768;
    eval {
	my @args = ();
	@args = split(/\s*\,\s*/,$self->{'_arguments'}) if ($self->{'_arguments'});
	my $fn = $self->{'_command'};
	$res = $self->{'_soap'}->$fn(@args);
    };
    if ($@)
    {
	$self->writedebug("No data returned by remote host for simplechannel ".$self->name.', Error: '.$@);
    }
    unless (defined($res))
    {
	$res = -32768;
	$self->writedebug("Undefined data returned by remote host for simplechannel ".$self->name); 
    }
    chomp $res;
    $self->writedebug("Raw read from remote host for simplechannel ".$self->name.': '.$res) if ($self->debug); 
    return $res * $self->{'_factor'};
}

sub test_string
{
    my $self = shift;
    $self->init();
    my @args = ();
    my $res;
    @args = split(/\s*\,\s*/,$self->{'_arguments'}) if ($self->{'_arguments'});
    eval {
	my $fn = $self->{'_command'};
	$res = $self->{'_soap'}->$fn(@args);
    };
    if ($@)
    {
	return "No data returned by remote host for simplechannel ".$self->name.', Error: '.$@;
    }
    unless (defined($res))
    {
	$res = "Undefined data returned by remote host"; 
    }
    $res = $res * $self->{'_factor'};
    return "Simple channel ".$self->name.": $res\n";
}

sub readstring
{
    my $self = shift;
    if ($self->is_caching())
    {
        return $self->SUPER::readstring(@_);
    }
    return undef if ($self->readstring_ignore);
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug) if ($self->debug);
    }
    $self->check_cache($data);
    my $val = $self->read($data);
    $val = -32768 unless defined($val);
    my @t = $self->get_time();
    my $t = join(':',@t);
    my $res = join(' ',$self->name,$t,time,$val);
    return $res;
}


sub print_config()
{
    my $self = shift;
    $self->init();
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Input type: '.$self->type;
    push @arr,'WSDL: '.$self->{'_wsdl'};
    push @arr,'Command: '.$self->{'_command'};
    push @arr,'Arguments: '.$self->{'_arguments'} if ($self->{'_arguments'});
    push @arr,'Factor: '.$self->{'_factor'};
    return join(', ',@arr);
}

package RFC::Keithley;
our @ISA = qw(RFC::Simple);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig,@_);
    bless $self,$class;
    $self->{'_type'} = 'Keithley';
    $self->{'_setup_tags'} = ['mode','communication','channel','measure_type','use_gpib_spline','factor','title','show_plot','use_cache'];
    $self->{'_reload_tags'} = ['class','type','mode','communication'];
    $self->{'_default'} = {
	'type' => 'Keithley',
        'mode' => 'Readonly',
	'communication' => 'GPIB',
        'channel' => '1:101',
        'factor' => 1,
        'show_plot'=>'Yes',
        'use_cache'=>'No',
	'tty' => 'ttyS0',
	'measure_type' => 'Default - gpibserver',
	'use_gpib_spline' => 'Yes',
    };
    $self->{'_desc'} = {
	'mode' => 'Device control mode',
	'communication' => 'Connunication mode',
	'channel' => 'Channel number of input device, format: X:YZZ, X gpib address, Y board number, ZZ channel number on board',
	'factor' => 'Scaling factor',
	'title' => 'Optional title',
        'use_cache'=>'Determines if persisten caching of read values is allowed',
	'tty' => 'Serial port',
	'use_gpib_spline' => 'Convert data using gpibserver spline table.',
	'measure_type' => 'Measure configuration string send to the keithley to set up measurement, fres being 4-point resistance measruements.',
    };
    $self->{'_values_communication'} = ['GPIB','Serial'];
    $self->{'_values_use_gpib_spline'} = ['Yes','No'];
    $self->{'_values_measure_type'} = ['Default - gpibserver','volt:dc','volt:ac','res','fres'];
    bless $self,$class;
    $self->load_conf();
    if ($self->{'_communication'} && $self->{'_communication'} =~ /serial/i)
    {
	$self->{'_default'}{'measure_type'} = 'volt:dc';
	$self->{'_values_measure_type'} = ['volt:dc','volt:ac','res','fres'];
	$self->{'_setup_tags'} = ['mode','communication','tty','channel','measure_type','factor','title','show_plot','use_cache'];
        $self->load_conf();
	$self->{'_channel'} =~ s/^\d:/0:/;
    }
    else
    {
	$self->{'_desc'}{'measure_type'} .= ' NB: Values other than Default is only valid for gpibserver version 2.13 or later or Linux_gpib_server version 1.2.1 or later!'; 
    }
    $self->{'_channel'} = shift if (@_);
    return $self;    
}

sub print_config()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Input type: '.$self->type;
    push @arr,'Communication: '.$self->{'communication'};
    push @arr,'TTY: '.$self->{'_tty'} if ($self->{'_communication'} && $self->{'_communication'} =~ /serial/i);
    push @arr,'Measure type: '.$self->{'_measure_type'};
    push @arr,'Channel: '.$self->{'_channel'};
    push @arr,'Factor: '.$self->{'_factor'};
    return join(', ',@arr);
}


sub readonly_value($)
{
    my $self = shift;
    my $tag = shift;
    return undef unless ($tag);
    return undef;
}

sub test()
{
    my $self = shift;
    my $ok = 0;
    my $mrep = '';
    if ($self->{'_communication'} && $self->{'_communication'} =~ /serial/i)
    {
	$mrep = SocketClient::serial_client_raw($self->{'_tty'},'Keithley','k',$self->{'_channel'},$self->{'_measure_type'});
    }
    else
    {
	if ($self->{'_measure_type'} && $self->{'_measure_type'} !~ /Default/i)
	{
	    $mrep = SocketClient::GPIB_client_raw('V',$self->{'_channel'},$self->{'_measure_type'});
	}
	else
	{
	    $mrep = SocketClient::GPIB_client_raw('K',$self->{'_channel'});
	}
    }
    chomp($mrep);
    if ($mrep =~ /([\w\s\.\:\+\-\;]+)/)
    {
	$mrep = $1;
	my @rep = split (/\s+/, $mrep );    # split svar op i enkeltdele, tid, vaerdi, etc
	if ($self->{'_channel'} eq $rep[2] && $mrep !~ /error/i)
	{
	    $ok = 1;
	}
    }
    return $ok;
}

sub read_nocache
{
    my $self = shift;
    my $res = $self->read_raw(@_);
    if (defined($res))
    {
	my $val = -32768;
	my @rep = split(/\s+/,$res);
	$self->writedebug("Channel ".$self->name." was read to $res") if ($self->debug > 1);
	$rep[-2] = $rep[-2]*$self->{'_factor'};
	$rep[-1] = $rep[-1]*$self->{'_factor'};
	my $str = join(' ',time,$self->name,join(' ',@rep));
	$self->rig->kanaldata($str) unless ($self->readstring_ignore);
	if ($self->{'_use_gpib_spline'} =~ /no/i)
	{
	    $val = $rep[-2];
	    $self->set_cache($rep[-2]);
	}
	else
	{
	    $val = $rep[-1];
	    $self->set_cache($rep[-1]);
	}
	$self->{'_last_read'} = Time::HiRes::time;
	return $val;
    }
    else
    {
	$self->writedebug("Channel ".$self->name." returned undefined on read!") if ($self->debug);
    }
    return undef;
}

sub test_string
{
    my $self = shift;
    my $res = $self->read_raw(@_);
    $res =~ s/[\s\t]*$//;
    my $val = -32768;
    if ($res)
    {
	my @l = split(/\s+/,$res);
	if ($self->{'_use_gpib_spline'} =~ /no/i)
	{
	    $val = $l[-2];
	}
	else
	{
	    $val = $l[-1];
	}
	$val = $val * $self->{'_factor'};
    }
    return "Simple channel ".$self->name,": value: $val, Raw read: $res\n";
}

sub read_raw
{
    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 $res = undef;
    my $cached = $data->get($self->type,$self->{'_channel'});
    if (defined($cached))
    {
	$self->writedebug("Using already measured value for ".$self->name) if ($self->debug > 3); 
	$res = $cached;
    }
    else
    {
	my $ok = 0;
	my $try = 5;
	$self->writedebug("Measuring value for ".$self->name) if ($self->debug > 3); 
	while (!$ok && $try--)
	{
	    my $mrep;
	    if ($self->{'_communication'} && $self->{'_communication'} =~ /serial/i)
	    {
		$mrep = SocketClient::serial_client_raw($self->{'_tty'},'Keithley','k',$self->{'_channel'},$self->{'_measure_type'});
	    }
	    else
	    {
		if ($self->{'_measure_type'} && $self->{'_measure_type'} !~ /Default/i)
		{
		    $mrep = SocketClient::GPIB_client_raw('V',$self->{'_channel'},$self->{'_measure_type'});
		}
		else
		{
		    $mrep = SocketClient::GPIB_client_raw('K',$self->{'_channel'});
		}
	    }
	    chomp($mrep) if defined($mrep);                   # fjern linieskift i slut af svar
	    $self->writedebug("Response: $mrep") if ($self->debug > 3);
	    next unless ($mrep);
	    $mrep =~ /([\w\s\.\:\+\-\;]+)/;
	    $mrep = $1;
	    my @rep = split (/\s+/, $mrep );    # split svar op i enkeltdele, tid, vaerdi, etc
	    if ($self->{'_channel'} eq $rep[2])
	    {
		$res = $mrep;
		$ok = 1;
	    }
	}
	$data->set($self->type,$self->{'_channel'},$res);
    }
    unless (defined($res))
    {
	$self->writedebug("No data found for channel ".$self->name);
	return undef;
    }
    chomp $res;
    return $res;
}


package RFC::KeithleyMOM;
our @ISA = qw(RFC::Simple);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    bless $self,$class;
    $self->{'_type'} = 'KeithleyMicroohmmeter';
    $self->{'_title'} = $self->get_conf('title');
    $self->{'_mode'} = 'Readonly';
    $self->{'_setup_tags'} = ['mode','communication','address','range','dry_circuit','relative','polarity','drive','factor','title','show_plot','use_cache'];
    $self->{'_reload_tags'} = ['class','mode','communication'];
    $self->{'_setup_tags_readonly'} = ['communication'];
    $self->{'_desc'} = {
	'communication' => 'Connunication mode',
	'mode' => 'Device control mode',
	'address' => 'GPIB address',
	'range' => 'Measurement range',
	'dry_circuit' => 'Use dry circuit measurement mode',
	'relative' => 'Use relative measruement mode',
	'plarity' => 'Select polarity for measurement',
	'drive' => 'Measurement drive mode',
	'title' => 'Optional title',
	'factor' => 'Scaling factor',
        'use_cache'=>'Determines if persisten caching of read values is allowed',
    };
    $self->{'_default'} = {
	'type' => 'Keithley580',
        'mode' => 'Readonly',
        'address' => 1,
        'factor' => 1,
	'range' => 0,
	'communication' => 'GPIB',
	'dry_circuit' => 0,
	'relative' => 0,
	'polarity' => 0,
	'drive' => 1,
        'show_plot'=>'Yes',
        'use_cache'=>'No',
    };
    $self->{'_values_range'} = ['Auto','200m','2','20','200','2k','20k','200k'];
    $self->{'_values_dry_circuit'} = ['None','Enabled'];
    $self->{'_values_relative'} = ['Off','On'];
    $self->{'_values_mode'} = ['Readonly'];
    $self->{'_values_polarity'} = ['Pol+','Pol-'];
    $self->{'_values_drive'} = ['Pulsed','DC'];
    foreach my $key ('address','use_cache')
    {
        $self->{'_'.$key} = $self->get_conf($key);
        $self->{'_'.$key} = $self->get_default($key) unless ($self->{'_'.$key});
    }
    foreach my $key ('range','dry_circuit','relative','polarity','drive','factor')
    {
        $self->{'_'.$key} = $self->get_tag_index($key,$self->get_conf($key));
        $self->{'_'.$key} = $self->get_default($key) unless (defined($self->{'_'.$key}));
    }
    return $self;
}

sub readonly_value($)
{
    my $self = shift;
    my $tag = shift;
    return undef unless ($tag);
    return 'GPIB' if ($tag eq 'communication');
    return undef;
}

sub print_config()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Input type: '.$self->type;
    push @arr,'Address: '.$self->{'_address'};
    push @arr,'Factor: '.$self->{'_factor'};
    my $cmd = 'D'.$self->{'_drive'}.'C'.$self->{'_dry_circuit'}.'R'.$self->{'_range'}.'P'.$self->{'_polarity'}.'Z'.$self->{'_relative'}.'T1X';
    push @arr,'Setupstring: '.$cmd;
    return join(', ',@arr);
}

sub test()
{
    my $self = shift;
    my $ok = 0;
    my $cmd = 'D'.$self->{'_drive'}.'C'.$self->{'_dry_circuit'}.'R'.$self->{'_range'}.'P'.$self->{'_polarity'}.'Z'.$self->{'_relative'}.'T1X';
    my $mrep = SocketClient::GPIB_client_raw('c',$self->{'_address'},$cmd);
    chomp($mrep) if (defined($mrep));
    if (defined($mrep) && $mrep =~ /(\d+)/)
    {
	$ok = 1;
    }
    return $ok;
}

sub get_tag_index()
{
    my $self = shift;
    my $tag = shift;
    my $value = shift;
    return undef unless defined($value);
    if (exists($self->{'_values_'.$tag}))
    {
	my @l = @{$self->{'_values_'.$tag}};
	for (my $x = 0; $x < @l; $x++)
	{
	    return $x if ($l[$x] eq $value)
	}
    }
    return undef;
}

sub readstring
{
    my $self = shift;
    return undef if ($self->readstring_ignore);
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
	$data = RFC::Cache->new();
	$data->debug($self->debug) if ($self->debug);
    }
    $self->check_cache($data);
    my $val = $self->read($data);
    my @t = $self->get_time();
    my $t = join(':',@t);
    my $res = join(' ',$self->name,$t,time,$val);
    $self->writedebug($res) if ($self->debug > 1);
    return $res;
}

sub read_nocache
{
    my $self = shift;
    my $res = $self->read_raw(@_);
    my $value = -32768;
    $res = '' unless defined($res);
    if ($res =~ /([\+\-\.\deE]+)[\s\t]*$/)
    {
	$value = $1+0;
    }
    $self->writedebug("Channel ".$self->name." was read to $value") if ($self->debug > 1);
    my $str = time.' '.$self->name.' '.$res;
    $self->rig->kanaldata($str) unless ($self->readstring_ignore);
    $self->set_cache($value * $self->{'_factor'});
    $self->{'_last_read'} = Time::HiRes::time;
    return $value * $self->{'_factor'};
}

sub read_raw
{
    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 $res = undef;
    my $cmd = 'D'.$self->{'_drive'}.'C'.$self->{'_dry_circuit'}.'R'.$self->{'_range'}.'P'.$self->{'_polarity'}.'Z'.$self->{'_relative'}.'T1X';
    my $cached = $data->get($self->type,$self->{'_address'},$cmd);
    if (defined($cached))
    {
	$self->writedebug("Using already measured value for ".$self->name) if ($self->debug > 3); 
	$res = $cached;
    }
    else
    {
	my $ok = 0;
	my $try = 5;
	$self->writedebug("Measuring value for ".$self->name) if ($self->debug > 3); 
	while (!$ok && $try--)
	{
	    my $mrep = SocketClient::GPIB_client_raw('c',$self->{'_address'},$cmd); # svar fra maaling fra keithley
	    $mrep = '' unless (defined($mrep));
	    chomp($mrep);   # fjern linieskift i slut af svar
	    $self->writedebug("Response: '$mrep'") if ($self->debug > 3);
	    next unless ($mrep);
	    if ($mrep =~ /([\w\s\.\:\+\-]+)/)
	    {
		$mrep = $1;
		$res = $mrep;
		$ok = 1;
	    }
	}
	if (defined($data))
	{
	    $data->set($self->type,$self->{'_address'},$cmd,$res);
	}
    }
    unless (defined($res))
    {
	$self->writedebug("No data found for channel ".$self->name);
	return undef;
    }
    chomp $res;
    if ($res =~ /([\+\-]*\d+[\d\.\+\-eE]+)/)
    {
	$res = $1;
    }
    return $res * $self->{'_factor'};
}

sub test_string
{
    my $self = shift;
    my $res = $self->read_raw(@_);
    return "Simple channel ".$self->name,": $res\n";
}



package RFC::SimpleICP;
our @ISA = qw(RFC::Simple);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    bless $self,$class;
    $self->{'_type'} = 'SimpleICP';
    $self->{'_setup_tags'} = ['mode','tty','address','channel','range','factor','title','show_plot','use_cache','CRC'];
    $self->{'_setup_tags_readonly'} = ['range'];
    $self->{'_desc'} = {
	'mode' => 'Device control mode',
	'tty' => 'Serial device for controling device (eg ttyS0)',
	'address' => 'Device address',
	'channel' => 'Channel number on device (Note 0-based)',
	'title' => 'Optional title',
	'factor' => 'Scaling factor',
        'use_cache'=>'Determines if persisten caching of read values is allowed',
	'CRC' => 'Determines if checksum is to be used for serial communication',
	'range' => 'Input type and range',
    };
    $self->{'_default'} = {
	'type' => 'ICP',
        'mode' => 'Readonly',
	'tty' => 'ttyS0',
	'address' => 1,
	'factor' => 1,
        'channel' => 0,
        'show_plot'=>'Yes',
        'use_cache'=>'No',
	'CRC'=>'No',
    };
    $self->{'_range'} = {
	'00' => '-15mV - +15mV',
	'01' => '-50mV - +50mV',
	'02' => '-100mV - 100mV',
	'03' => '-500mV - +500mV',
	'04' => '-1V - +1V',
	'05' => '-2.5V - +2.5V',
	'06' => '-20mA - +20mA (with 125 Ohm resistor)',
	'07' => '+4mA - 20mA',
	'08' => '-10V - +10V',
	'09' => '-5V - +5V',
	'0A' => '-1V - +1V',
	'0B' => '-500mV - +500mV',
	'0C' => '-150mV - 150mV',
	'0D' => '-20mA - +20mA (with 125 Ohm resistor)',
	'1A' => '0mA - +20mA',
	'1B' => '-150V - +150V',
	'1C' => '-50V - +50V',
	'0E' => 'J Type',
	'0F' => 'K Type',
	'10' => 'T Type',
	'11' => 'E Type',
	'12' => 'R Type',
	'13' => 'S Type',
	'14' => 'B Type',
	'15' => 'N Type',
	'16' => 'C Type',
	'17' => 'L Type',
	'18' => 'M Type',
	'19' => 'L Type DIN4310',
	'20' => 'Pt 100, -100 to 100C',
	'21' => 'Pt 100, 0 to 100C',
	'22' => 'Pt 100, 0 to 200C',
	'23' => 'Pt 100, 0 to 600C',
	'24' => 'Pt 100, -100 to 100C',
	'25' => 'Pt 100, 0 to 100C',
	'26' => 'Pt 100, 0 to 200C',
	'27' => 'Pt 100, 0 to 600C',
	'28' => 'Ni 120, -80 to 100C',
	'29' => 'Ni 120, 0 to 100C',
	'2A' => 'Pt 1000, -200 to 600C',
	'2B' => 'Cu 100, -20 to 150C',
	'2C' => 'Cu 100, 0 to 200C',
	'2D' => 'Cu 1000, -20 to 150C',
	'2F' => 'Pt 100, -200 to 200C',
	'80' => 'Pt 100, -200 to 600C',
	'81' => 'Pt 100, -200 to 200C',
	'60' => 'Precon -- ST-A3 -30 to 240F',
	'61' => 'u Fenwell, -50 to +150C',
	'62' => 'u Fenwell, 0 to +150C',
	'63' => 'YSI L Mix 100',
	'64' => 'YSI L Mix 300',
	'65' => 'YSI L Mix 1000',
	'66' => 'YSI B Mix 2252',
	'67' => 'YSI B Mix 3000',
	'68' => 'YSI B Mix 5000',
	'69' => 'YSI B Mix 6000',
	'6A' => 'YSI B Mix 10K',
	'6B' => 'YSI H Mix 10K',
	'6C' => 'YSI H Mix 30K',
	'70' => 'User defined, -50 to 150C',
	'71' => 'User defined, -50 to 150C',
	'72' => 'User defined, -50 to 150C',
	'73' => 'User defined, -50 to 150C',
	'74' => 'User defined, -50 to 150C',
	'75' => 'User defined, -50 to 150C',
	'76' => 'User defined, -50 to 150C',
	'77' => 'User defined, -50 to 150C',
    };
    foreach my $key ('tty','address','channel','factor','use_cache','CRC')
    {
        $self->{'_'.$key} = $self->get_conf($key);
        $self->{'_'.$key} = $self->get_default($key) unless ($self->{'_'.$key});
    }
    $self->{'_title'} = $self->get_conf('title');
    $self->{'_tty'} = shift if (@_);
    $self->{'_address'} = shift if (@_);
    $self->{'_channel'} = shift if (@_);
    $self->{'_values_CRC'} = ['No','Yes'];
    $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 get_range
{
    my $self = shift;
    my $str = $self->config;
    if ($str && $str =~ /\!\w{2}(\w{2})/)
    {
	my $key = $1;
	return $self->{'_range'}{uc($key)};
    }
    return 'Na';
}

sub readonly_value
{
    my $self = shift;
    my $tag = shift;
    return undef unless ($tag);
    return $self->get_range() if ($tag eq 'range');
    return undef;
}

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 print_config()
{
    my $self = shift;
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Input type: '.$self->type;
    push @arr,'tty: '.$self->{'_tty'};
    push @arr,'Address: '.$self->{'_address'};
    push @arr,'Channel: '.$self->{'_channel'};
    return join(', ',@arr);
}

sub test()
{
    my $self = shift;
    my $res = undef;
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    my $cmd = 'icptest';
    $cmd = 'icptest_crc' if ($self->{'_CRC'} eq 'Yes');
    my $mrep = SocketClient::serial_client_raw($tty,$cmd,$addr);
    unless ($mrep)
    {
	select(undef,undef,undef,0.2);
	$mrep = SocketClient::serial_client_raw($tty,$cmd,$addr);
    }
    return 1 if ($mrep && $mrep =~ /\!\d+/);
    return 0;
}

sub test_string()
{
    my $self = shift;
    my $res = undef;
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    my $cmd = 'icpmultiread';
    $cmd = 'icpmultiread_crc' if ($self->{'_CRC'} eq 'Yes');
    my $mrep = SocketClient::serial_client_raw($tty,$cmd,$addr);
    unless ($mrep)
    {
	select(undef,undef,undef,0.2);
	$mrep = SocketClient::serial_client_raw($tty,$cmd,$addr);
    }
    return 0 unless ($mrep);
    my @r = split("\n",$mrep);
    $res = $r[$self->{'_channel'}] if ($self->{'_channel'} < @r);
    if ($self->{'_factor'})
    {
	$res = 'Raw read: '.$res.', Calculated value: '.($res * $self->{'_factor'});
    }	
    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 $res = undef;
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    my $cached = $data->get($tty,'icp',$addr,$self->{'_channel'});
    if ($cached)
    {
	$self->writedebug("Using already measured value for ".$self->name) if ($self->debug > 3); 
        $res = $cached;
    }
    else
    {
	$self->writedebug("Measuring value for ".$self->name." on tty $tty address $addr") if ($self->debug > 3);
	my $cmd = 'icpmultiread';
	$cmd = 'icpmultiread_crc' if ($self->{'_CRC'} eq 'Yes'); 
	my $mrep = SocketClient::serial_client_raw($tty,$cmd,$addr);
	my $try = 5;
	my $ok = 0;
	while (!$ok && $try--)
	{
	    last if ($mrep);
	    select(undef,undef,undef,0.8);
	    $self->writedebug("No response, retrying...") if ($self->debug > 3);
	    $mrep = SocketClient::serial_client_raw($tty,$cmd,$addr);
	}
	$self->writedebug("Response: $mrep") if ($self->debug > 3);
	if ($mrep)
	{
	    my @r = split("\n",$mrep);
	    $res = $r[$self->{'_channel'}] if ($self->{'_channel'} < @r);
	    for (my $x = 0; $x < @r; $x++)
	    {
		$data->set($tty,'icp',$addr,$x,$r[$x]);
	    }
	}
    }
    $self->die("No data returned from device!") unless (defined($res));
    $self->writedebug("Channel ".$self->name." was read to $res") if ($self->debug > 1);
    my $str = time.' '.$self->name.' '.$res;
    $self->rig->kanaldata($str) unless ($self->readstring_ignore);
    $self->set_cache($res * $self->{'_factor'});
    $self->{'_last_read'} = Time::HiRes::time;
    return $res * $self->{'_factor'};
}

sub readstring
{
    my $self = shift;
    return undef if ($self->readstring_ignore);
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
	$data = RFC::Cache->new();
	$data->debug($self->debug) if ($self->debug);
    }
    $self->check_cache($data);
    my $value = $self->read($data);
    $value = -32768 unless (defined($value) && $value =~ /\d/);
    my @t = $self->get_time();
    my $t = join(':',@t);
    my $res = join(' ',$self->name,$t,time,sprintf("%.6f",$value));
    $self->writedebug($res) if ($self->debug > 1);
    return $res;
}


package RFC::SimpleICP7017;
our @ISA = qw(RFC::SimpleICP);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    bless $self,$class;
    $self->{'_type'} = 'SimpleICP7017/18';
    return $self;    
}


sub test_string()
{
    my $self = shift;
    my $res = undef;
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    my $cmd = 'icp7017read';
    $cmd = 'icp7017read_crc' if ($self->{'_CRC'} eq 'Yes');
    my $mrep = SocketClient::serial_client_raw($tty,$cmd,$addr);
    unless ($mrep)
    {
	select(undef,undef,undef,0.2);
	$mrep = SocketClient::serial_client_raw($tty,$cmd,$addr);
    }
    return 0 unless ($mrep);
    my @r = split("\n",$mrep);
    $res = $r[$self->{'_channel'}] if ($self->{'_channel'} < @r);
    if ($self->{'_factor'})
    {
	$res = 'Raw read: '.$res.', Calculated value: '.($res * $self->{'_factor'});
    }	
    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 $res = undef;
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    my $cached = $data->get($tty,'icp',$addr,$self->{'_channel'});
    if ($cached)
    {
	$self->writedebug("Using already measured value for ".$self->name) if ($self->debug > 3); 
        $res = $cached;
    }
    else
    {
	$self->writedebug("Measuring value for ".$self->name." on tty $tty address $addr") if ($self->debug > 3);
	my $cmd = 'icp7017read';
	$cmd = 'icp7017read_crc' if ($self->{'_CRC'} eq 'Yes'); 
	my $mrep = SocketClient::serial_client_raw($tty,$cmd,$addr);
	my $try = 5;
	my $ok = 0;
	while (!$ok && $try--)
	{
	    last if ($mrep);
	    select(undef,undef,undef,0.3);
	    $self->writedebug("No response, retrying...") if ($self->debug > 3);
	    $mrep = SocketClient::serial_client_raw($tty,$cmd,$addr);
	}
	$self->writedebug("Response: $mrep") if ($self->debug > 3);
	if ($mrep)
	{
	    my @r = split("\n",$mrep);
	    $res = $r[$self->{'_channel'}] if ($self->{'_channel'} < @r);
	    for (my $x = 0; $x < @r; $x++)
	    {
		$data->set($tty,'icp',$addr,$x,$r[$x]);
	    }
	}
    }
    $self->die("No data returned from device!") unless ($res);
    $self->writedebug("Channel ".$self->name." was read to $res") if ($self->debug > 1);
    my $str = time.' '.$self->name.' '.$res;
    $self->rig->kanaldata($str) unless ($self->readstring_ignore);
    $self->set_cache($res * $self->{'_factor'});
    $self->{'_last_read'} = Time::HiRes::time;
    return $res * $self->{'_factor'};
}

package RFC::SimpleICP7017ZW;
our @ISA = qw(RFC::SimpleICP7017);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    bless $self,$class;
    $self->{'_type'} = 'SimpleICP7017ZW';
    return $self;    
}

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));
    if ($res && $res =~ /\!\w{6}(\w)\w/)
    {
	my $d = $1;
	## Get channel type ##
	my $type = undef;
	my $c = 'icp_raw';
	if ($d & 4)
	{
	    $c = 'icp_raw_crc';
	}
	my $cmd = sprintf("\@%02dS",$self->{'_address'});    
	my $r = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
	### Try 2 times to get configuration ###
	unless (defined($r) && $r =~ /\w/)
	{
	    select(undef,undef,undef,0.5);
	    $r = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
	}
	if ($r && $r =~ /\!\w\w(\d)/)
	{
	    my $dmode = $1;
	    $cmd = sprintf("\$%02d8C%01d",$self->{'_address'},$self->{'_channel'});
	    $cmd = sprintf("\$%02d8C%02X",$self->{'_address'},$self->{'_channel'}) if ($dmode);
	    $r = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
	    ### Try 2 times to get configuration ###
	    unless (defined($r) && $r =~ /\w/)
	    {
		select(undef,undef,undef,0.5);
		$r = SocketClient::serial_client_raw($self->{'_tty'},$c,$cmd);
	    }
	    if ($r && $r =~ /\!\w\wC\w\w?R(\w\w)/)
	    {
		$type = $1;
	    }
	}
	if ($type)
	{
	    ## Set correct type string
	    substr($res,3,2) = $type;
	}
    }    
    return $res;
}


package RFC::SimpleICP7019;
our @ISA = qw(RFC::SimpleICP7017);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig);
    bless $self,$class;
    $self->{'_type'} = 'SimpleICP7019/87019';
    return $self;    
}

sub get_range
{
    my $self = shift;
    my $str = $self->config;
    if ($str && $str =~ /\!\w{4}R(\w{2})/)
    {
	my $key = $1;
	return $self->{'_range'}{uc($key)};
    }
    return 'Na';
}

sub config()
{
    my $self = shift;
    my $res;
    my $cmd = sprintf("\$%02d8C%01d",$self->{'_address'},$self->{'_channel'});
    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;
}




package RFC::SimpleModbus;
our @ISA = qw(RFC::SimpleICP);

sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'SimpleModbus';
    $self->{'_title'} = $self->get_conf('title');
    $self->{'_desc'}{'channel'} = 'Modbus tag number for reading value';
    $self->{'_info_string'} = 'Device for reading Modbus registers over a serial interface';
    return $self;    
}

sub test()
{
    my $self = shift;
    my $res = undef;
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    $res = SocketClient::serial_client_raw($tty,'modbus','f',$addr,$self->{'_channel'});
    return 1 if (defined($res));
    return 0;
}

sub test_string()
{
    my $self = shift;
    my $res = undef;
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    return SocketClient::serial_client_raw($tty,'modbus','f',$addr,$self->{'_channel'});
}

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 $res = undef;
    my $addr = $self->{'_address'};
    my $tty = $self->{'_tty'};
    my $type = $self->type;
    my $cached = $data->get($tty,$type,$addr,$self->{'_channel'});
    if (defined($cached))
    {
	$self->writedebug("Using already measured value for ".$self->name) if ($self->debug > 3); 
        $res = $cached;
    }
    else
    {
	$self->writedebug("Measuring value for ".$self->name." on tty $tty address $addr") if ($self->debug > 3); 
	$res = SocketClient::serial_client_raw($tty,'modbus','f',$addr,$self->{'_channel'});
	my $try = 5;
	my $ok = 0;
	while (!$ok && $try--)
	{
	    last if (defined($res));
	    select(undef,undef,undef,0.3);
	    $self->writedebug("No response, retrying...") if ($self->debug > 3); 
	    $res = SocketClient::serial_client_raw($tty,'modbus','f',$addr,$self->{'_channel'});
	}
	$self->writedebug("Response: $res") if ($self->debug > 3);
	chomp $res if (defined($res));
	$data->set($tty,$type,$addr,$self->{'_channel'},$res) if (defined($res));
    }
    $self->die("No data returned from device!") unless (defined($res));
    $self->writedebug("Channel ".$self->name." was read to '$res'") if ($self->debug > 1);
    my $str = time.' '.$self->name.' '.$res;
    $self->rig->kanaldata($str) unless ($self->readstring_ignore);
    if (defined($res) && $res =~ /\d/)
    {
	$self->set_cache($res * $self->{'_factor'});
	$self->{'_last_read'} = Time::HiRes::time;
	return $res * $self->{'_factor'};
    }
    else
    {
	return -32768;
    }
}





package RFC::ModbusTCP;
use Device::Modbus::TCP::Client;
our @ISA = qw(RFC::SimpleICP);

sub new()
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    bless $self,$class;
    $self->{'_type'} = 'ModbusTCP';
    $self->{'_setup_tags'} = ['mode','IP','register','factor','title','show_plot','use_cache'];
    $self->{'_title'} = $self->get_conf('title');
    $self->{'_desc'}{'IP'} = 'IP address of module';
    $self->{'_default'}{'IP'} = '127.0.0.1';
    $self->{'_default'}{'register'} = '0';
    $self->{'_desc'}{'register'} = 'Modbus holding register for reading value';
    $self->{'_desc'}{'IP'} = 'IP address of module';
    $self->{'_ui_fn_names'} = [];
    $self->load_conf();
    $self->{'_client'} = Device::Modbus::TCP::Client->new( host => $self->{'_IP'});
    die "Could not create Modbus client!\n" unless ($self->{'_client'});
    $self->{'_info_string'} = 'Device for reading Modbus holding registers over TCP:IP';
    return $self;
}

sub test()
{
    my $self = shift;
    my $req = $self->{'_client'}->read_holding_registers(address=>$self->{'_register'},quantity => 1);
    $self->{'_client'}->send_request($req) || die "Send error: $!";
    my $response = $self->{'_client'}->receive_response;
    my $res = $response->values();
    return 1 if (defined($res) && ref($res) eq 'ARRAY' );
    return 0;
}

sub test_string()
{
    my $self = shift;
    my $req = $self->{'_client'}->read_holding_registers(address=>$self->{'_register'},quantity => 1);
    $self->{'_client'}->send_request($req) || die "Send error: $!";
    my $response = $self->{'_client'}->receive_response;
    my $res = $response->values();
    my @vals = @{$res};
    my $val = $vals[0];
    $val = $val * $self->{'_factor'};
    return $val;
}

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 $res = undef;
    my $addr = $self->{'_IP'};
    my $register = $self->{'_register'};
    my $type = $self->type;
    my $cached = $data->get($type,$addr,$register,$self->{'_register'});
    if (defined($cached))
    {
	$self->writedebug("Using already measured value for ".$self->name) if ($self->debug > 3); 
        $res = $cached;
    }
    else
    {
	$self->writedebug("Measuring value for ".$self->name." on address $addr register $register") if ($self->debug > 3); 
	my $req = $self->{'_client'}->read_holding_registers(address=>$self->{'_register'},quantity => 1);
	$self->{'_client'}->send_request($req) || die "Send error: $!";
	my $response = $self->{'_client'}->receive_response;
	my $resp = $response->values();
	my @vals = @{$resp};
	$res = $vals[0];
	my $try = 5;
	my $ok = 0;
	while (!$ok && $try--)
	{
	    last if (defined($res));
	    select(undef,undef,undef,0.3);
	    $self->writedebug("No response, retrying...") if ($self->debug > 3); 
	    my $req = $self->{'_client'}->read_holding_registers(address=>$self->{'_register'},quantity => 1);
	    $self->{'_client'}->send_request($req) || die "Send error: $!";
	    my $response = $self->{'_client'}->receive_response;
	    my $resp = $response->values();
	    my @vals = @{$resp};
	    $res = $vals[0];
	}
	$self->writedebug("Response: $res") if ($self->debug > 3);
	chomp $res if (defined($res));
	$data->set($type,$addr,$register,$self->{'_register'},$res) if (defined($res));
    }
    $self->die("No data returned from device!") unless (defined($res));
    $self->writedebug("Channel ".$self->name." was read to '$res'") if ($self->debug > 1);
    my $str = time.' '.$self->name.' '.$res;
    $self->rig->kanaldata($str) unless ($self->readstring_ignore);
    if (defined($res) && $res =~ /\d/)
    {
	$self->set_cache($res * $self->{'_factor'});
	$self->{'_last_read'} = Time::HiRes::time;
	return $res * $self->{'_factor'};
    }
    else
    {
	return -32768;
    }
}

return 1;
