
package RFC::Adapter;
#$Id: Adapter.pm,v 1.35 2018/04/03 06:44:26 sqko Exp $
######################################################
#
#
#       RFC::Adapter
#
#
# The RFC::Adapter class defines the behaviour of a group
# of special virtual devices. These devices all operator on 
# top of normal RFC::BaseDevice derived devices and operate
# according to the Adapter pattern (as defined by GoF).
#
# The adapter devices are intended to supply functionality
# which the native RFC devies do not themselves suppport.
# For instance most power supplies do not support slowly
# ramping voltage or current up to a fixed setpoint.
# 
# By using a RamprateAdapter this can be facilitated by 
# letting the adapter device supply a steadialy changing 
# setpoint to the power supply device.
#
# The rationale for using the Adapter pattern is the it makes 
# it possible to use multiple different adapters on any single 
# object (if the application of those adapters make any sense 
# that is).
#
# All RFC::Adapter derived classes has two distinct constructors.
# One with the normal 2 arguments as for normal RFC::BaseDevice
# instances:
#
#  my $id = RFC::Adapter->new($name,$rig);
#
# And one with an additional argument which must be the 
# RFC::BaseDevice derived instance to wrap:
#
#  my $id = RFC::Adapter->new($name,$rig,$dev);
#
# If the second constructor is used, the adapter device 
# does not need to have it's own configurationsection in 
# the rig's configuration file as it already knows the device 
# it is to wrap (for some adapter instances the configuration 
# may still be nescesarry for full functionality).
#
# All RFC::Adapter objects has the following member functions (in
# addition to those inherited from RFC::BaseDevice).
#
# $id->update()         Performs the internal state change nescesarry
#                       for the added functionality. 
# $id->load_state()     Loads any state information which must be 
#                       persistent between device invocations
# $id->store()          Saves persistent information.
#
# Common to the functions described above is that the default 
# adapter does not define any functionality for the functions
# (in effct they are pure virtual), and any nescesarry actions
# must be defined in the classes derived from RFC::Adapter
#
# To obtain one of the operational adapters call one of the 
# constructors as shown below:
#
#  my $id = RFC::RamprateAdapter->new($name,$rig);
#
#  my $id = RFC::RamprateAdapter->new($name,$rig,$dev);
#
#  my $id = RFC::ExponentialDecayAdapter->new($name,$rig);
#
#  my $id = RFC::ExponentialDecayAdapter->new($name,$rig,$dev);
#
# Notice that due to the way the RamprateAdapter is implemented, only 
# slow ramprates will be possible (changes taking minutes or hours to
# complete).
#
#
# A special ramprate adapeter is the TempControlAdapter
# This adapter fully emulates a RFC::TempControl device completely 
# with the special TempControl functions like get_atemp() etc (see TempControl.pm 
# for details). This enables virtual temperature controlers and also the 
# possibility to use RFCPID devices as normal (physical) temperature controlers.
#
######################################################

use strict;
use warnings;
use RFC::BaseDevice;
use RFC::Header;
use RFC::Cache;
use SemaforeFile;
our @ISA = qw(RFC::BaseDevice);
our $AUTOLOAD;

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->{'_dev'} = shift if (@_);
    $self->{'_type'} = 'Default_adapter_device';
    $self->{'_setup_tags'} = ['class','mode','device_type','device','read_function','control_function'];
    $self->{'_setup_tags_readonly'} = ['mode'];
    $self->{'_readstring_ignore'} = 1;
    $self->{'_desc'} = {
        'mode' => 'Device control mode',
        'device_type' => 'Type of raw device',
        'device' => 'Raw device',
        'read_function' => 'Device function to use for read operations. This value will be used as the start value for the ramp operation',
        'control_function' => 'Device function to use for setpoint operations',
    };
    $self->{'_default'} = {
        'device_type' => 'simplechannel',
        'device' => '',
        'read_function' => 'read',
        'control_function' => 'set',
        'disable_readstring' => 'Yes',
    };
    $self->{'_values_class'} = [RFC::Device::list_Adapter()];
    $self->{'_values_disable_readstring'} = ['Yes'];
    $self->{'_values_device_type'} = ['',$self->rig->list_types_nofilter()];
    $self->{'_section'} = 'Adapter_'.$self->name;
    $self->load_conf();
    my @list = ();
    foreach ($self->rig->avaliable_devices($self->{'_device_type'}))
    {
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    $self->{'_values_device'} = ['',@list];
    $self->{'_values_read_function'} = ['read'];
    $self->{'_values_control_function'} = ['set'];
    if ($self->{'_device_type'} && $self->{'_device'} && !$self->{'_dev'})
    {
        ### get device if it already exist ###
        $self->{'_dev'} = $self->rig->get_device($self->{'_device_type'},$self->{'_device'});
    }
    if ($self->{'_dev'})
    {
	my @arr = $self->{'_dev'}->list_set_functions();
	$self->{'_set_fn_names'} = \@arr;
	my @arr2 = ('read');
	@arr2 = $self->{'_dev'}->read_names();
	$self->{'_values_read_function'} = \@arr2;
	my @arr3 = ('set');
	@arr3 = $self->{'_dev'}->list_set_functions();
	$self->{'_values_control_function'} = \@arr3;
	$self->{'_dev'}->set_readonly(); 
	foreach my $tag (@{$self->{'_overloadable_tags'}})
	{
	    ### Use object orgy to make sure that Adaptable tags gets passed on correctly ###
	    $self->{'_'.$tag} = $self->{'_dev'}->{'_'.$tag};
	}
    }
    $self->{'_file'} = SemaforeFile->new($userdir.'rig'.$self->rig->name.'/Adapter_'.$self->name,'/home/celltest/Adapter_rig'.$self->rig->name.'.lock');
    $self->{'_info_string'} = 'Adapter devices only works correctly if they are included (enabled)';
    $self->{'_has_init'} = 0;
    return $self;
};

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

sub Accept
{
    my $self = shift;
    my $visitor= shift;
    return undef if ($self->{'_seen_visitors'}{$visitor});
    $self->init() unless ($self->{'_dev'});
    $self->die("Error: Device '$self', not properly initialised!") unless ($self->{'_dev'});
    $self->{'_dev'}->Accept($visitor);
    $visitor->VisitComplex($self);
    $self->{'_seen_visitors'}{$visitor} = 1;
    return undef;
}


sub init
{
    my $self = shift;
    if (!$self->{'_dev'} && $self->{'_device_type'} && $self->{'_device'})
    {
        ### get device if it already exist                                          ###
        ### It may have been created after Adapter constructor ran and call of init() ###
        my $dev = $self->rig->get_device($self->{'_device_type'},$self->{'_device'});
        ### Initialise it if it doesn't ###
	unless ($dev)
	{
	    $dev = $self->rig->init_device($self->{'_device_type'},$self->{'_device'});
	    $dev->readstring_ignore(1) if ($dev);
	}
        $self->{'_dev'} = $dev if ($dev);
        $self->die("Could not initialise Adapter device of type '".$self->{'_device_type'}."' with name: '".$self->{'_device'}."'") unless ($self->{'_dev'});
    }
    if ($self->{'_dev'})
    {
        my @arr = $self->{'_dev'}->read_names();
        $self->{'_values_read_function'} = \@arr;
        my @arr2 = ();
        @arr2 = $self->{'_dev'}->list_set_functions();
        $self->{'_set_fn_names'} = \@arr2;
	my @arr3 = ('set');
	@arr3 = $self->{'_dev'}->list_set_functions();
	$self->{'_values_control_function'} = \@arr3;
        $self->{'_dev'}->debug($self->debug);
	$self->{'_dev'}->set_readonly(); 
	foreach my $tag (@{$self->{'_overloadable_tags'}})
	{
	    ### Use object orgy to make sure that Adaptable tags gets passed on correctly ###
	    $self->{'_'.$tag} = $self->{'_dev'}->{'_'.$tag};
	}
    }
    return $self->local_init();
}

sub store()
{
    #### Stub function intended for overloading for any impelmention dependent initialisations ###
    my $self = shift;
    return $self;
}

sub load_state()
{
    #### Stub function intended for overloading for any impelmention dependent initialisations ###
    my $self = shift;
    return $self;
}

sub update
{
    #### Stub function intended for overloading for any impelmention dependent initialisations ###
    my $self = shift;
    return $self;
}



sub local_init
{
    my $self = shift;
    #### Stub function intended for overloading for any impelmention dependent initialisations ###
    $self->{'_has_init'} = 1;
    return $self;
}

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

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

sub test_string
{
    my $self = shift;
    $self->init() unless ($self->{'_dev'});
    return $self->{'_dev'}->test_string(@_);
}

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

sub read
{
    my $self = shift;
    $self->init()  unless ($self->{'_dev'});
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug) if ($self->debug);
    }
    $self->check_cache($data);
    return $self->{'_dev'}->read($data);
}

sub readonly_value($)
{
    my $self = shift;
    my $tag = shift;
    return undef unless ($tag);
    ### allow call to get 'mode' for undefined devices ###
    return 'Na' if ($tag eq 'mode' && !$self->{'_dev'});
    $self->init();
    $self->writedebug("Executing readonly function $tag") if ($self->debug());
    return $self->device->mode() if ($tag eq 'mode');
    return $self->device->readonly_value($tag);
}

sub read_named
{
    my $self = shift;
    $self->init();
    if ($_[0] eq 'read')
    {
        shift;
        $self->writedebug("Executing read trough read_named") if ($self->debug());
        return $self->read(@_); 
    }
    $self->writedebug("Executing function ".$_[0]." with arguments: ".join(', ',@_[1,-1])) if ($self->debug());
    return $self->{'_dev'}->read_named(@_) if ($self->{'_dev'});
}

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

sub AUTOLOAD()
{
    ################################################################
    ### AUTOLOAD() , redirect all method calls not defined by    ###
    ### Basedevice to the underlying device                      ###
    ################################################################
    my $self = shift;
    $self->init() unless ($self->{'_dev'});
    {
        no strict "refs";
        $AUTOLOAD =~ /\:\:(\w+)$/;
	if ($1 eq $self->{'_control_function'})
	{
	    return $self->set(@_);
	}
        return $self->{'_dev'}->$1(@_);
    }
}

package RFC::RamprateAdapter;
our @ISA = qw(RFC::Adapter);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig,@_);
    $self->{'_type'} = 'Ramprate adapter';
    bless $self,$class;
    $self->{'_setup_tags'} = ['class','mode','device_type','device','read_function','control_function','minramp','maxramp'];
    $self->{'_desc'}{'minramp'} = 'Minimum allowed ramprate for device. Notice that seting the ramprate to 0 disables ramping entirely!';
    $self->{'_set_names'} = ['set_ramp','set'];
    $self->{'_default'}{'class'} = 'Ramprate';
    $self->{'_default'}{'minramp'} = 0;
    $self->{'_desc'}{'maxramp'} = 'Maximum alllowed ramprate for device';
    $self->{'_desc'}{'minramp'} = 'Minimum alllowed ramprate for device';
    $self->{'_has_ramp'} = 1;
    $self->{'_info_string'} = 'Adapter devices only works correctly if they are included (enabled). Ramprate adapter only works for slow ramprates (changes taking minutes or more!)';
    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.00','0.00','0.00','0');
        chmod 0666, $self->{'_file'}->filename;
        $self->{'_file'}->unlock;
    }
    $self->load_conf();
    ##################################################################################
    ### Class invariant: The file contains the state of the ramprate.
    ### It must contain 3 lines. The first is the ramprate in units/hour, the
    ### And the second is the initial value, the third is the setpoint and the 
    ### last is the time the ramp was started
    ### If the last line is empty or 0 no ramp is in progress
    ### If the ramprate is 0, no ramping is performed and setpoints are directly
    ### Applied to undrerlying device.
    ##################################################################################
    $self->load_state();
    return $self;
}

sub minramp()
{
    my $self = shift;
    my $min = 0;
    $min = $self->{'_minramp'} if (defined($self->{'_minramp'}) && $self->{'_minramp'});
    return $min;
}

sub maxramp()
{
    my $self = shift;
    my $max = 1e100;
    $max = $self->{'_maxramp'} if (defined($self->{'_maxramp'}) && $self->{'_maxramp'});
    return $max;
}

sub check_ramp
{
    my $self = shift;
    my $ramp = shift;
    my $user = shift;
    if ($ramp > $self->maxramp())
    {
        $ramp = $self->maxramp();
        unless (@_)
        {
            if ($user)
            {
                $self->rig->errorlog("Warning: Temperature ramp for $self was to be set above maximum ($ramp C/hour)!",$user);
            }
            else
            {
                $self->rig->errorlog("Warning: Temperature ramp for $self was to be set above maximum ($ramp C/hour)!");
            }
        }
    }
    if ($ramp < $self->minramp())
    {
        $ramp = $self->minramp();
        unless (@_)
        {
            if ($user)
            {
                $self->rig->errorlog("Warning: Temperature ramp for $self was to be set below minimum ($ramp C/hour)!",$user);
            }
            else
            {
                $self->rig->errorlog("Warning: Temperature ramp for $self was to be set below minimum ($ramp C/hour)!");
            }
        }
    }
    return $ramp;
}

sub print_config()
{
    my $self = shift;
    $self->init() unless ($self->{'_dev'});
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,'Ramprate: '.$self->{'_ramp'};
    push @arr,'Setpoint: '.$self->{'_setpoint'};
    push @arr,$self->{'_dev'}->print_config();
    return join(', ',@arr);
}

sub test_string
{
    my $self = shift;
    $self->init() unless ($self->{'_dev'});
    my @arr = ($self);
    if ($self->{'_time'})
    {
	push @arr,'Ramping towards '.$self->{'_setpoint'}.' with a ramprate of '.$self->{'_ramp'};
    }
    else
    {
	push @arr,'Not ramping.';	
    }
    push @arr, $self->{'_dev'}->test_string(@_) if ($self->{'_dev'});
    return join("\n",@arr);
}

sub load_state
{
    my $self = shift;
    my @l = $self->{'_file'}->readlines();
    $self->{'_modtime'} = $self->{'_file'}->mtime();
    $self->{'_ramp'} = $l[0];
    $self->{'_initial'} = $l[1];
    $self->{'_setpoint'} = $l[2];
    $self->{'_time'} = $l[3];
    return $self;
}


sub local_init
{
    my $self = shift;
    $self->{'_has_ramp'} = 1;
    unless ($self->{'_has_init'})
    {
	$self->rig->register_device($self->{'_device_type'},$self);
	$self->{'_has_init'} = 1;
    }
    return $self;
}


sub store
{
    my $self = shift;
    $self->{'_file'}->writeline($self->{'_ramp'},$self->{'_initial'},$self->{'_setpoint'},$self->{'_time'});
    $self->{'_modtime'} = $self->{'_file'}->mtime();
    return $self;
}

sub setpoint
{
    my $self = shift;
    return $self->{'_setpoint'};
}

sub set
{
    my $self = shift;
    my $setpoint = shift;
    my $data = RFC::Cache->new();
    my $value = $self->{'_dev'}->read_named($self->{'_read_function'},$data);
    $self->{'_file'}->lock_ex();
    $self->load_state();
    $self->{'_setpoint'} = $setpoint;
    $self->{'_initial'} = $value;
    $self->{'_time'} = time;
    if (!$self->{'_ramp'})
    {
	$self->{'_time'} = 0;	
    }
    $self->store();
    $self->{'_file'}->unlock();
    if (!$self->{'_ramp'})
    {
	$self->{'_dev'}->set($self->{'_setpoint'});
    }
    $self->rig->proglog("Setting Setpoint for '$self' to ".$self->{'_setpoint'},@_);
    return $self->{'_setpoint'};
}

sub set_ramp
{
    my $self = shift;
    my $ramp = $self->check_ramp(@_);;
    $self->{'_file'}->lock_ex();
    $self->load_state();
    $self->{'_ramp'} = $ramp;   
    if (!$self->{'_ramp'})
    {
	$self->{'_time'} = 0;	
    }
    $self->store();
    $self->{'_file'}->unlock();
    $self->rig->proglog("Setting ramprate for '$self' to ".$self->{'_ramp'},@_);
    return $self->{'_ramp'};
}


sub get_ramp
{
    my $self = shift;
    return $self->{'_ramp'};
}

sub update
{
    my $self = shift;
    $self->{'_file'}->lock_ex();
    $self->load_state() if ($self->{'_file'} && $self->{'_modtime'} != $self->{'_file'}->mtime());
    unless ($self->{'_time'})
    {
	$self->{'_file'}->unlock();
	return undef 
    }
    my $elapsed = (time - $self->{'_time'}) / 3600;
    my $n = $self->{'_control_function'};
    my $sp = undef;
    if (!$self->{'_ramp'} || (abs($self->{'_setpoint'} - $self->{'_initial'}) / abs($self->{'_ramp'})) < $elapsed)
    {
	$sp = $self->{'_setpoint'};
	$self->writedebug("Setting final setpoint for device to ".$self->{'_setpoint'}) if ($self->debug);
	$self->rig->proglog("Finished ramping to ".$self->{'_setpoint'}." for '$self'",@_);
	$self->{'_time'} = 0;
	$self->store();
    }
    else
    {
	$sp = $self->{'_initial'} + (($self->{'_setpoint'} - $self->{'_initial'}) <=> 0) * abs($self->{'_ramp'}) * $elapsed;
	$self->writedebug("Setting local setpoint for device to $sp") if ($self->debug);
    }
    $self->{'_file'}->unlock();
    $self->{'_dev'}->$n($sp);    
    return $sp;
}

package RFC::TempControlAdapter;
our @ISA = qw(RFC::RamprateAdapter);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig,@_);
    $self->{'_type'} = 'Temperature controler adapter';
    $self->{'_setup_tags'} = ['class','mode','device','minramp','maxramp','mintemp','maxtemp'];
    $self->{'_readstring_ignore'} = 0; ## Note do not exclude from readstring as opposed to ther adapters as this masquerade type! ###
    $self->{'_readstring_furnace'} = 1;
    bless $self,$class;
    my @list = ();
    foreach ($self->rig->avaliable_devices('PID'))
    {
        push @list,$_ unless ($_ eq $self->name()); ## Do not include self ##
    }
    $self->{'_control_function'} = 'set';
    $self->{'_default'}{'class'} = 'TempControl';
    $self->{'_default'}{'mintemp'} = -273;
    $self->{'_default'}{'maxtemp'} = 6000;
    $self->{'_desc'}{'maxtemp'} = 'Maximum alllowed temperature for device';
    $self->{'_desc'}{'mintemp'} = 'Minimum alllowed temperature for device';
    $self->{'_read_function'} = 'read';
    $self->{'_set_names'} = ['set_ramp','set_temp','set'];
    $self->{'_values_device'} = ['',@list];
    $self->{'_info_string'} = 'Adapter devices only works correctly if they are included (enabled). TempControl adapter only works for slow ramp rates (changes taking minutes or hours)';
    $self->load_conf();
    $self->load_state();
    $self->{'_has_ramp'} = 1;
    return $self;
}


sub mintemp()
{
    my $self = shift;
    my $min = -273; ## Well no need to break the universe...                                                                    
    $min = $self->{'_mintemp'} if (defined($self->{'_mintemp'}) && $self->{'_mintemp'});
    return $min;
}

sub maxtemp()
{
    my $self = shift;
    my $max = 6000; ## No need to go higher than the surface of the sun...                                                      
    $max = $self->{'_maxtemp'} if (defined($self->{'_maxtemp'}) && $self->{'_maxtemp'});
    return $max;
}


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,@_);
    $val = -32768 unless (defined($val) && $val =~ /\d/);
    my $aset = $self->get_atemp($data,@_);
    $aset = -32768 unless (defined($aset) && $aset =~ /\d/);
    my $pow = $self->get_output($data);
    $pow = -32768 unless (defined($pow) && $pow =~ /\d/);
    my @t = $self->get_time();
    my $t = join(':',@t);
    my $res = join(' ',$self->name.'_setpoint',$t,time,$val,$self->name.'_temp',$t,time,$aset,$self->name.'_output',$t,time,$pow);
    $self->writedebug($res) if ($self->debug > 1);
    return $res;
}


sub init
{
    my $self = shift;
    if (!$self->{'_dev'} && $self->{'_device_type'} && $self->{'_device'})
    {
        ### get device if it already exist                                          ###
        ### It may have been created after Adapter constructor ran and call of init() ###
        my $dev = $self->rig->get_device('PID',$self->{'_device'});
        ### Initialise it if it doesn't ###
	unless ($dev)
	{
	    $dev = $self->rig->init_device('PID',$self->{'_device'});
	}
        $self->{'_dev'} = $dev if ($dev);
        $self->die("Could not initialise Adapter device of type 'PID' with name: '".$self->{'_device'}."'") unless ($self->{'_dev'});
    }
    if ($self->{'_dev'})
    {
	$self->{'_dev'}->readstring_ignore(1);
        my @arr = $self->{'_dev'}->read_names();
        $self->{'_values_read_function'} = \@arr;
        my @arr2 = ();
        @arr2 = $self->{'_dev'}->list_set_functions();
        $self->{'_set_fn_names'} = \@arr2;
	my @arr3 = ('set');
	@arr3 = $self->{'_dev'}->list_set_functions();
	$self->{'_values_control_function'} = \@arr3;
        $self->{'_dev'}->debug($self->debug);
	$self->{'_dev'}->set_readonly(); 
	foreach my $tag (@{$self->{'_overloadable_tags'}})
	{
	    ### Use object orgy to make sure that Adaptable tags gets passed on correctly ###
	    $self->{'_'.$tag} = $self->{'_dev'}->{'_'.$tag};
	}
	$self->{'_has_ramp'} = 1;
    }
    return $self->local_init();
}

sub local_init
{
    my $self = shift;
    $self->{'_has_ramp'} = 1;
    unless ($self->{'_has_init'})
    {
	$self->rig->register_device('tempcontrol',$self);
	$self->{'_has_init'} = 1;
    }
    return $self;
}

sub get_atemp
{
    my $self = shift;
    $self->local_init();
    return $self->{'_dev'}->read(@_);
}

sub get_temp
{
    my $self = shift;
    return $self->setpoint();
}

sub get_output
{
    my $self = shift;
    return -32768;
}

sub set_temp
{
    my $self = shift;
    return $self->set(@_);
}



package RFC::ExponentialDecayAdapter;
our @ISA = qw(RFC::Adapter);

sub new()
{
    my $class = shift;
    my $name = shift;
    my $rig = shift;
    my $self = $class->SUPER::new($name,$rig,@_);
    $self->{'_type'} = 'Exponential decay adapter';
    bless $self,$class;
    $self->{'_setup_tags'} = ['class','mode','device_type','device','read_function','control_function','time_constant','cutoff'];
    $self->{'_desc'}{'minramp'} = 'Minimum allowed ramprate for device. Notice that seting the ramprate to 0 disables ramping entirely!';
    $self->{'_default'}{'time_constant'} = 10;
    $self->{'_default'}{'class'} = 'ExponentialDecay';
    $self->{'_desc'}{'time_constant'} = 'Time constant for decay in seconds';
    $self->{'_default'}{'cutoff'} = 0.01;
    $self->{'_desc'}{'cutoff'} = 'If the difference between the local setpoint and target setpoint is below this the decay is stopped and target setpoint is set';
    $self->{'_info_string'} = 'Adapter devices only works correctly if they are included (enabled). Exponential decay adapter only works for slow changes (time constant 5 seconds or more!)';
    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.00','0.00','0');
        chmod 0666, $self->{'_file'}->filename;
        $self->{'_file'}->unlock;
    }
    $self->load_conf();
    ##################################################################################
    ### Class invariant: The file contains the state of the ramprate.
    ### It must contain 3 lines. The first is the initial value, the second is the 
    ### setpoint and the last is the time the ramp was started
    ### If the last line is empty or 0 no ramp is in progress
    ### If the ramprate is 0, no ramping is performed and setpoints are directly
    ### Applied to undrerlying device.
    ##################################################################################
    $self->load_state();
    return $self;
}


sub print_config()
{
    my $self = shift;
    $self->init() unless ($self->{'_dev'});
    my @arr = ();
    push @arr,'Name: '.$self->name;
    push @arr,'Type: '.$self->type;
    push @arr,'Time constant: '.$self->{'_time_constant'}.' s';
    push @arr,'Cutoff value: '.$self->{'_cutoff'};
    push @arr,'Setpoint: '.$self->{'_setpoint'};
    push @arr,$self->{'_dev'}->print_config();
    return join(', ',@arr);
}

sub test_string
{
    my $self = shift;
    $self->init() unless ($self->{'_dev'});
    my @arr = ($self);
    if ($self->{'_time'})
    {
	push @arr,'Decaying towards '.$self->{'_setpoint'}.' with a time constant of '.$self->{'_time_constant'};
    }
    else
    {
	push @arr,'Steady state.';
    }
    push @arr, $self->{'_dev'}->test_string(@_) if ($self->{'_dev'});
    return join("\n",@arr);
}

sub load_state
{
    my $self = shift;
    my @l = $self->{'_file'}->readlines();
    $self->{'_modtime'} = $self->{'_file'}->mtime();
    $self->{'_initial'} = $l[0];
    $self->{'_setpoint'} = $l[1];
    $self->{'_time'} = $l[2];
    return $self;
}

sub store
{
    my $self = shift;
    $self->{'_file'}->writeline($self->{'_initial'},$self->{'_setpoint'},$self->{'_time'});
    $self->{'_modtime'} = $self->{'_file'}->mtime();
    return $self;
}

sub setpoint
{
    my $self = shift;
    return $self->{'_setpoint'};
}

sub set
{
    my $self = shift;
    my $setpoint = shift;
    my $data = RFC::Cache->new();
    my $value = $self->{'_dev'}->read_named($self->{'_read_function'},$data);
    $self->{'_file'}->lock_ex();
    $self->{'_setpoint'} = $setpoint;
    $self->{'_initial'} = $value;
    $self->{'_time'} = time;
    $self->store();
    $self->{'_file'}->unlock();
    $self->rig->proglog("Setting Setpoint for '$self' to ".$self->{'_setpoint'},@_);
    return $self->{'_setpoint'};
}

sub update
{
    my $self = shift;
    $self->{'_file'}->lock_ex();
    $self->load_state() if ($self->{'_file'} && $self->{'_modtime'} != $self->{'_file'}->mtime());
    unless ($self->{'_time'})
    {
	$self->{'_file'}->unlock();
	return undef 
    }
    my $elapsed = time - $self->{'_time'};
    my $n = $self->{'_control_function'};
    my $amp = abs($self->{'_setpoint'} - $self->{'_initial'});
    my $val = $amp * exp( -$elapsed/$self->{'_time_constant'});
    my $sp = undef;
    if ($val < $self->{'_cutoff'})
    {
	$sp = $self->{'_setpoint'};
	$self->writedebug("Setting final setpoint for device to ".$self->{'_setpoint'}) if ($self->debug);
	$self->rig->proglog("Finished decaying to ".$self->{'_setpoint'}." for '$self'",@_);
	$self->{'_time'} = 0;
	$self->store();
    }
    else
    {
	$sp = $self->{'_initial'} + (($self->{'_setpoint'} - $self->{'_initial'}) <=> 0) * ($amp - $val);
	$self->writedebug("Setting local setpoint for device to $sp") if ($self->debug);
    }
    $self->{'_file'}->lock_un();
    $self->{'_dev'}->$n($sp);
    return $sp;
}

sub local_init
{
    my $self = shift;
    $self->{'_has_ramp'} = 0;
    unless ($self->{'_has_init'})
    {
	$self->rig->register_device($self->{'_device_type'},$self);
	$self->{'_has_init'} = 1;
    }
    return $self;
}


return 1;
