package RFC::BaseDevice;
#$Id: BaseDevice.pm,v 1.129 2024/09/17 08:54:31 sqko Exp $


#############################################################################
#
#
#      RFC::BaseDevice
#
#
#  This module defines a number of common functions for all RFC devices.
#  Most of these functions are virtual in that respect that they are 
#  overwritten by the individual class definitions.
#
#  To obtain a device instancee call the constructor (in this case BaseDevice):
#  my $id = BaseDevice->new($name,$rig);
#  Where $name is an identifier string (preferably unique) and $rig is an
#  instance of the RFC::Rig class. This second argument is required for callback
#  functionality used in a number of the device operations (mainly $id->read, but
#  in some cases also by the derived device constructors and/or init functions).
#  Some device constructors may require additional arguments (refer the individual
#  class files for details). The rig object must at least honor the following 
#  member functions (refer RFC::Rig for details about the individual member functions):
#
#  get_cv(section,key)
#
#  change_config_value(section,key,newval)
#
#  list_types()
#
#  list_types_nofilter()
#
#  list_devices(type)
#
#  list_devices_control(type)
#  
#  avaliable_devices(type)
#
#  avaliable_devices_nofilter(type)
#
#  get_device(type,name)
#  
#  init_device(type,name)
#  
#  register_device(object)
#  
#  disable_warning_mails([opt set]);
#
#  warning_mail(type,msg,[opt subj])
#
#  unset_warning(type)
#  
#  proglog(string)
#
#  errorlog(string)
#
#  get_cache_time(type,name)
#
#  get_cache(type,name)
#
#  set_cache(type,name,value)
#
#  clear_cache(type,name)
#
#
#  All devices inheriting from RFC::Basedevice honors the folliwing member functions:
#
#  $id->type()           Returns the type of the instance (usually the class name)
#  $id->name()           Rreturns the name of the instance.
#  $id->UIname()         Rreturns the name of the instance to be used for user interface purposes.
#                        Note that unlike names returned by the name() function, names returned by 
#                        UIname() are NOT guaranteed to be unique even within device types!
#                        The default is that name() and UIname() return the same string.
#  $id->mode()           Returns the mode of the device (usually one of the follwing
#                        Readonly, Automatic or Manual).
#  $id->sectionname()    Returns the section name from which the device was initialised.
#  $id->init()           Initialises the device (not all devices require this).
#  $id->print_config()   Returns a string containing the setup information.
#  $id->print_setup()    Prints the contents of the current device data
#                        (software only).
#  $id->title()          Returns the title string for the device (if defined) or an 
#                        empty string.
#  $id->rig()            Returns a reference to the attatched rig instance.#
#  $id->proglog($[$$])   Appends the supplied string to the attatched rig's program log
#                        If a second argument is specified that is asumed to be the user name
#                        of the user originating the action/logentry.
#                        If a third argument is specified or disable_proglog is set, no logging
#                        is performed (usefull for i-V curves where lots of commands are given
#                        during the i-V curve and logging all of them would polute the program log. 
#  $id->disable_proglog([$])   Returns 1 if appending to the attatched rig's proglog is disabled.
#                              If an argument is supplied, sets the status instead.
#                              Default is 0 (proglog enabled).
#  $id->errorlog($)      Appends the suplied string to the attatched rig's errorlog.
#  $id->get_conf($)      Returns the configuration value for the specifiec key
#                        Uses the rig instance for the actual configuration manipulation
#                        If called in a list context,returns a list of values based on the
#                        raw configruation value split along commas (ignores spaces arrounds commas).
#  $id->load_conf()      Loads all confifguration values from the rig instance.
#                        Uses the list supplied by setup_tags_legacy() to get the
#                        keys for which values to inport.
#  $id->change_cv($$)    Changes the configuration value for the specifiec key to the new value
#                        (second argument)
#                        Uses the rig instance for the actual configuration manipulation
#  $id->get_default($)   Returns the default setting for the specified
#                        configuration tag.
#  $id->change_reload($) Returns 1 if changing the specified configuration tag should result 
#                        in a page leload (due to changes in the number and/or operation mode 
#                        of other tags as a result of a change of the current tag value).
#                        Default return value is 0;
#                        Only intended to be used for user interface programming.
#  $id->hide_tag($)      Returns 1 if the specified tag is disabled by the current 
#                        configuration of the device and thus should not be visible to the user.
#                        Default return value is 0;
#  $id->setup_tags()     Returns a list of setup tags which the divice
#                        understands. setup_tags() adds the common element 'comments' to the
#                        list defined by the individual device classes, and this element is
#                        intended to be used for a string containing commetns for the device.
#  $id->setup_tags_legacy()
#                        Same as setup_tags() except it includes potential deprecated setup tags
#                        for the device.
#  $id->tag_description($)  
#                        Returns the description string asociated with the specified
#                        tag.
#                        Hardcoded to return the string "Description for this device, not 
#                        used for other purpose. Do not use ',' in text as that character is 
#                        used as newline substitute." if the supplied tag is equal to 'comments'.  
#  $id->tag_type($)      Returns the type of the specified tag (Readonly or read-write)
#                        Default is read-write.
#  $id->radonly_value($) Returns the value of a specified (readonly) tag.
#                        Returns undef if the tag is not readonly.
#                        Note to developers: This function needs to be defined for all
#                        readonly tags for a given device type!
#  $id->get_tag_values($)
#                        Returns a list of possible values for a specific setup key.
#  $id->ui_fn_names()    Returns a list of function names which can be called from the device
#                        configuration page in the user interface
#                        Default is to return the empty list as most device types vould usually
#                        not have nay functions which it would make sense to call from the
#                        device setup user interface as the interface only allows maximum
#                        one argument to any function called from there (by using the prompt()
#                        javascript function).
#                        If the last line of the returned string from this function is the
#                        string 'RELOAD', then the setup page will be refreshed (as it is assumed
#                        that running this particular function will change the internal variables of 
#                        the device in question).
#  $id->ui_fn_args($)    Returns the number of arguments which must be supplied fo the function
#                        with the specified name. Is intended to be sued in conjunction
#                        with ui_fn_names() and only function names mentioned in that
#                        list will be valid arguments (returns undef if no match).
#                        Default value is 0, so if the function does not have any arguments
#                        it is not nescesary to specify a value in the '_ui_fn_args' hash
#  $id->ui_fn_description($)  
#                        Returns the description string asociated with the specified
#                        function name. All functions listed by ui_fn_names() must
#                        have a corresponding description in the '_ui_fn_desc' hash
#  $id->list_set_functions()
#                        Returns a list of possible function names which could trigger a 
#                        notify event (such as setflow for a gas or set_voltage for a PSU)
#                        Returns an empty list for pure input devices (default)
#  $id->readonly()       Returns true (1) if the device is a readonly device false (0)
#                        othervise. The default is for a device to be controlable, thus 
#                        false (0) is the default response. 
#  $id->set_readonly()   Sets a device readonly (only use with caution as can not be reversed).
#  $id->info_string()    Returns a string (potentially empty) containing  
#                        information which the user may need for device 
#                        configuration.
#  $id->persistent()     Returns 1 if the persistent_settings key is defined and is set to 'Yes'.
#                        Returns 0 otherwise.
#                        Some device types allow querying the physiccal device for some settings.
#                        This can be done each time at device initialisation (default) or stored
#                        on file. The advantage of storing those settings in the configuration 
#                        file is that device communication overhead is minimised.
#                        The disadvantage is that if those settings change, the RFCcontrol system
#                        will not know this and use the old (and now wrong) settings.
#                        If the persistent_settings key is set to yes, the settings are read from
#                        the configruation file (and have to be specified there). 
#  $id->query_settings() This function queries the device for the settings which can be aquired 
#                        directly from the physical device and stores them in the configuration
#                        file. For most device types this is a NOP.
#                        If defined for a device type, it should be executable from the device 
#                        configuration user interface.
#
#  All devices also has the following special functions for data access:
#
#  $id->read([$])        Returns the value of the instance, this is dependent on the
#                        type of device.
#                        If an argument is specified it must be an object of type
#                        RFC::Cache.
#                        If the device allows using cached values, the cache is first
#                        checked and if a value is found this is returned instead of the
#                        raw value. Notice that if improperly used, values too far in the
#                        past can be returned!
#                        The caching is done through the attatched RFC::Rig instance
#                        For some device types caching is not possible and a raw read is
#                        always returned.
#  $id->bool([$])        Returns the boolean value of the device. For devices which already returns
#                        a boolean value from read(), the the bool() function is merely an alias
#                        for read() whereas for devices returning non-bool values the default is
#                        to return 0 (false) if the value of read() is 0 or undefined and 1 (true)
#                        otherwise.
#  $id->value()          Returns the value of the device. This is obtained from the read()
#                        function if the value() function is called for the first time. 
#                        Any subsequent calls to value() will return the internally stored value.
#                        unless clear_cache() has been called in which case the read() function
#                        is called again. This function is intended to be used when arithmetic 
#                        opeartor overloading is used in orer to speed up calculations.
#  $id->setpoint()       Alias for read(). Can be overloaded for controlable devices to
#                        return the last given setpoint.
#  $id->has_ramp()       Returns 1 (true) if the deivce has a 'set_ramp' function (and thus is
#                        capable of ramping to a new setpoint). Default is to return 0 (false).
#  $id->read_nocache([$])
#                        Returns the value of the instance, this is dependent on the
#                        type of device.
#                        If an argument is specified it must be an object of type
#                        RFC::Cache.
#                        Unlike read() this function does not check persistent cache
#                        even if caching is allowed.
#  $id->last_read()      Returns the last time read_nocache was called.
#  $id->read_cache([$])  Returns the last read value. If an argument (time in seconds) is
#                        specified, this forces a new call to read() if the time since last
#                        call of read_nocache is larger than the specified difference.
#                        Any additional arguments is passed on to read().
#  $id->is_caching()     Returns true if caching is configured to be enabled for this device. 
#                        Returns false otherwise.
#  $id->set_cache($)     Sets the specified value in the persistent cache (this is done 
#                        through the attatched RFC::Rig instance, see specification there).
#  $id->clear_cache()    Resest the persistent cache (this is done through the attatched 
#                        RFC::Rig instance. It also clears the local cache used by the 
#                        value() function
#  $id->read_names()     Returns a list of valid read functions (most devices only returns
#                        a list with the 'read' function). 
#  $id->set_names()      Returns a list of valid functions which can be called on the deivce
#                        and which changes the internal state of the device.
#                        For instance a relay device only has the 'set' function and a
#                        gas device has the setflow function as well as the set command 
#                        (which is an alias for setflow in that case). 
#                        Some devices (such as simplechannel devices) do not have any and
#                        will return the empty list.
#  $id->read_named([$])  Returns the value of the specified function. If no function name
#                        is specifiecd, the read function is returned().
#                        Only function names listed in the response from read_names() are
#                        valid
#  $id->readstring([$])  Returns the value of the device, but with additional time 
#                        information.
#                        If an argument is specified it must be an object of type
#                        RFC::Cache.
#  $id->readstring_ignore()
#                        Sets or gets the variable determining if the readstring
#                        function simply returns undef or the real return string.
#                        This is useful if calculations require a lot of simple
#                        data values to calculate the desired variable and one whishes
#                        to awoid 'poluting' the data logging with the raw data values
#                        of the intermediate variables.
#                        If called without arguments, returns the value of the ignore 
#                        variable.
#                        1 disables readstring returning a string, 0 enables it again.
#                        Default is 0 (readstring enabled).
#  $id->readstring_furnace()
#                        Special version of readstring used by the RFCfurnace adon.
#                        If the readstring_furnace key is set, it returns the readstring
#                        value.
#  $id->get_time()       Returns the current time in format YYYY MM DD HH MM SS
#                        Output is in the form of an array.
#  $id->test()           Returns 1 or 0 depending on device status. BaseDevice always 
#                        returns 0 as it is meant to be overridden by the derived
#                        classes.
#  $id->test_full()      Returns 1 or 0 depending on device status. Usually an alias for
#                        $id->test() but may contain additional validation such as checking
#                        that the temperature is above absolute zero for temperature logging
#                        devices.
#  $id->test_string([$]) Returns the device status as a string (in some cases the status
#                        of devices used by the device is included). Intended to be
#                        overridden by derived classes.
#                        If the optional argument is specified it should be an instance of
#                        RFC::Cache (in some cases this will speed up execution as cached
#                        data can be used instead of having to read new values from hardware).
#  $id->monitor()        Returns the value(s) of the device. In most cases this function
#                        is just a wrapper for the read() member function, however in
#                        the case of devices with more than one interesting value to
#                        read (for instance for temperature controlers where one wants
#                        both the setpoint and the active setpoint) a string containing
#                        the values as well as descriptions are returned instead.
#  $id->monitor_rows()   Returns a string identifying how many data rows moitor() returns
#                        and which row numbers contain data (as opposed to identifier strings)
#                        Default is the string '2' for a normal device which only returns a
#                        single value and a time. For devices returning multiple values
#                        the string returned could be '3,5' for instance (as rows 2 and 4
#                        contain the strings describing the values in row 3 and 5 respectively).
#  $id->setup_template() Returns the html template name uset to setup/configure the device.
#
#  Both read and readstring accepts and additional argument. This argument must be
#  an object of type RFC::Cache (or any other object which has the the get() and set() 
#  interface specified the way RFC::Cache does) and if this is specified, the read and
#  readstring functions first looks in this cache to see if they can find
#  the requested data there. If so, the already existing data is returned and if not
#  the data is measured and stored in the cache as well as returned.
#  The advantage of this is that multiple relay instances can share a read
#  operation if they are on the same relay board (and the device has a bulk
#  read option as the ICP-Das modules all does).
#
#  To use this option the template below can be used:
#
#  my $data = RFC::Cache->new();
#  my $string = $id->readstring($data);
#
#  In this case a new empty cache is defined and it will then be populated by 
#  the readstring function.
#  any later calls to id->readstring($data) will thus reuse the stored data
#  (only for the same device or other devices using the same setup keys, refer the
#  documentation for RFC::Cache).
#
#  In order to test if the reference passed to readstring is of the correct type
#  the following function can be used:
#
#  $id->check_cache($)          Checks that the supplied argument is of type
#                               RFC::Cache and if not, logs a warning and replaces it
#                               with an object of the correct type.
# 
#  It is also possible to use the observer pattern whith objects which derives 
#  from this base class. To facilitate this, BaseDevice inherits from RFC::Observer.
#
#  RFC::BaseDevice also inplements the following member function which can be used when
#  overloading the observe() member function in derived classes:
#
#  $id->master()                Returns the master device for a slave device. This can be 
#                               used to ensure that a master can not at the samae time be a 
#                               slave (which to some degree protects against infinite
#                               recursions).
#
#
# All device classes inheriting from BaseDevice also implements the Visitor pattern.
# Thus all devices implements the Accept(RFC::Visitor) function.
#
# $id->Accept($)                Runs the VisitSimple or VisitComplex member function
#                               of the supplied visitor instance.
# $id->Clear_visitors()         Special function which clears the list of already 
#                               seen visitors
#
# the default Accept method derived from BaseDevise is to call the VisitSimple function.
# All complex devices (containing internal devices) should implement their own Accept method.
# As a RFC::Basedevice derived device may be used in more than one other device, the Accept
# method keeps track of which visitors has already visited it and only calls the VisitSimple/
# VisitComplex function once for each visitor.
# For long runing programs which may continue to create visitors, it may be nescesarry to call 
# Clear_visitor() on all devices to clear the list (The special RFC::VisitorClear visitor will 
# do this if passed to the Accept function of a RFC::Rig instance) 
#
# -- As it is possible (and indeed recommended) that device classes inheriting from \\ 
# RFC::BaseDevice conains other RFC::BaseDevice derived class instances, the BaseDevice and
# inherited classes implements the Composite pattern as this works well with the Visitor
# patern for traversing parts or the whole device structure.
#
# -- \subsection{Operator overloading}
#
# RFC::BaseDevice overloads the following arithmetic operators:
# + - * / and ** (exponentiation) as well as unary minus and the string operator ""
# and the concatanation (dot) operator.
# Thus it is possible to do:
#
# $dev = RFC::BaseDevice->new(@ARGS);
#
# $val = $dev + 6.5;
# 
# and get the expected result.
#
# Similarly it is possible to do: 
#
# print "Device: $dev is active"
#
# Note however, that simple assignment is NOT overloaded, thus using
# $val = $dev will NOT set $val to have the value of $dev->read().
# To get the value of a device use the read function directly or the slightly 
# cumbersome $val = $dev + 0 (not to mention the truly ugly $val = -(-$dev) 
# which uses unary minus, which IS overloaded).
# The advantage of the read function (apart from beeing easier to understand) is that 
# it can be passed a cache argument which the overloaded arithmetic functions can not
# and which in many cases can speed up runtime as the device can re-use already 
# measured values (refer the definition of the read function).
#
#############################################################################



use strict;
use warnings;
our $AUTOLOAD;
use SocketClient qw();
use Class::Inspector;
use RFC::Cache;
use RFC::Observer;
use Debug;
use Time::HiRes;
our @ISA = qw(RFC::Observer);
use overload
    '+' => \&RFC_add,
    '*' => \&RFC_multiply,
    '-' => \&RFC_minus,
    '/' => \&RFC_divide,
    '**' => \&RFC_exp,
    'neg' => \&RFC_neg,
    '""' => \&RFC_to_string,
    '.' => \&RFC_concat,
    'fallback' => 1;


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->{'_name'} = shift;
    $self->{'_title'} = undef;
    $self->{'_rig'} = shift;
    $self->{'_type'} = '';
    $self->{'_has_ramp'} = 0;
    $self->{'_info_string'} = '';
    $self->{'_monitor_rows'} = '2';
    $self->{'_mdev'} = undef;
    $self->{'_mode'} = 'Manual';
    $self->{'_html_template'} = 'Default.tt';
    $self->{'_setup_tags'} = ['mode','show_plot','use_cache','title'];
    $self->{'_reload_tags'} = ['mode','type','class','device','device_type'];
    $self->{'_hide_tags'} = []; # List of tags which is disabled and shold not be shown #
    $self->{'_legacy_tags'} = [];  # List of setup tags which is returned for legacy mode.  #
                                   # If defined must include all tags, not merely the extra #
    $self->{'_ui_fn_names'} = []; # List of function names which can be called from the device setup UI
    $self->{'_ui_fn_args'} = {}; # Hash with number of args for function listed in _ui_fn_names 
    $self->{'_ui_fn_desc'} = {}; # UI function descriptions
    $self->{'_set_fn_names'} = []; # List of function names which can trigger a notify event
    $self->{'_setup_tags_readonly'} = [];
    $self->{'_default'} = {
	'show_plot'=>'Yes',
	'use_cache'=>'No',
	};
    $self->{'_readstring_ignore'} = 0;
    $self->{'_values_mode'} = ['Manual','Automatic'];
    $self->{'_values_show_plot'} = ['Yes','No'];
    $self->{'_values_use_cache'} = ['Yes','No'];
    $self->{'_values_persistent_settings'} = ['Yes','No'];
    $self->{'_values_disable_readstring'} = ['No','Yes'];
    $self->{'_section'} = '';
    $self->{'_readonly'} = 0;
    $self->{'_disable_proglog'} = 0;
    $self->{'_last_read'} = undef;
    $self->{'_read_names'} = ['read'];
    $self->{'_set_names'} = ['set'];
    $self->{'_seen_vistors'} = {};
    $self->{'_readstring_furnace'} = 0;
    $self->{'_desc'} = {
	'mode'=>'Device control mode',
	'show_plot'=>'Determines if the current device data is to be shown in the daily data plots. Should only be used for enabled devices',
	'use_cache'=>'Determines if persisten caching of read values is allowed',
	};
    $self->{'_overloadable_tags'} = ['has_ramp'];
    bless $self,$class;
    return $self;
}

# Visitor patern functions

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

sub Clear_visitors
{
    my $self = shift;
    $self->{'_seen_visitors'} = {};
    return undef;
}

# operator overloading functions #

sub RFC_concat
{
    my ($self, $other, $swap) = @_;
    my $str = $self->RFC_to_string;
    if ($swap)
    {
        return $other.$str;
    }
    else
    {
        return $str.$other;
    }
}

sub RFC_to_string
{
    my ($self, $other, $swap) = @_;
    return lc($self->{'_type'}).' '.$self->{'_name'};
}

sub RFC_neg
{
    my ($self, $other, $swap) = @_;
    return -$self->value();
}

sub RFC_add
{
    my ($self, $other, $swap) = @_;
    unless (ref($other) && ref($other) =~ /RFC::/)
    {
	return ($other+0) + $self->value();
    }
    return $other->value() + $self->value();
}

sub RFC_multiply
{
    my $self = shift;
    my $b = shift;
    unless (ref($b) && ref($b) =~ /RFC::/)
    {
	return ($b+0) * $self->value();
    }
    return $b->value() * $self->value();
}

sub RFC_minus
{
    my ($self, $other, $swap) = @_;
    unless (ref($other) && ref($other) =~ /RFC::/)
    {
	if ($swap)
	{
	    return ($other+0) - $self->value();
	}
	else
	{
	    return $self->value() - ($other+0);
	}
    }
    if ($swap)
    {
	return $other->value() - $self->value();
    }
    else
    {
	return $self->value() - $other->value();
    }
}

sub RFC_divide
{
    my ($self, $other, $swap) = @_;
    unless (ref($other) && ref($other) =~ /RFC::/)
    {
	if ($swap)
	{
	    return ($other+0) / $self->value();
	}
	else
	{
	    return $self->value() / ($other+0);
	}
    }
    if ($swap)
    {
	return $other->value() / $self->value();
    }
    else
    {
	return $self->value() / $other->value();
    }
}

sub RFC_exp
{
    my ($self, $other, $swap) = @_;
    unless (ref($other) && ref($other) =~ /RFC::/)
    {
	if ($swap)
	{
	    return ($other+0) ** $self->value();
	}
	else
	{
	    return $self->value() ** ($other+0);
	}
    }
    if ($swap)
    {
	return $other->value() ** $self->value();
    }
    else
    {
	return $self->value() ** $other->value();
    }
}

# end operator overloading functions #

sub setup_template
{
    my $self = shift;
    return $self->{'_html_template'};
}

sub query_settings
{
    my $self = shift;
    return ('No settings to query for this device');
}


sub persistent
{
    my $self = shift;
    return 1 if ($self->{'_persistent_settings'} && $self->{'_persistent_settings'} =~ /yes/i);
    return 0;
}


sub ui_fn_description($)
{
    my $self = shift;
    my $fname = shift;
    my $desc = undef;
    foreach my $n ($self->ui_fn_names())
    {
	next unless ($n eq $fname);
	$desc = $self->{'_ui_fn_desc'}{$fname};
	last;
    }
    return $desc;
}  

sub list_set_functions()
{
    my $self = shift;
    my @res = ();
    @res = @{$self->{'_set_fn_names'}} if ($self->{'_set_fn_names'});
    return @res;    
}

sub ui_fn_names()
{
    my $self = shift;
    my @res = ();
    @res = @{$self->{'_ui_fn_names'}} if ($self->{'_ui_fn_names'});
    return @res;    
}


sub ui_fn_args($)
{
    my $self = shift;
    my $fname = shift;
    my $args = undef;
    foreach my $n ($self->ui_fn_names())
    {
	next unless ($n eq $fname);
	if (exists($self->{'_ui_fn_args'}{$fname}))
	{
	    $args = $self->{'_ui_fn_args'}{$fname};
	}
	else
	{
	    $args = 0;
	}
	last;
    }
    return $args;
}

sub load_conf()
{
    my $self = shift;
    foreach my $tag ($self->setup_tags_legacy)
    {
        $self->{'_'.$tag} = $self->get_default($tag);
        my $conf = $self->get_conf($tag);
        $self->{'_'.$tag} = $conf if (defined($conf) && $conf =~ /\w/);
    }
}

sub get_conf($)
{
    my $self = shift;
    my $key = shift;
    return undef unless $self->rig;
    if (wantarray)
    {
	return ($self->{'_rig'}->get_cv($self->{'_section'},$key));
    }
    else
    {
	return $self->{'_rig'}->get_cv($self->{'_section'},$key);
    }
}

sub change_cv($$)
{
    my $self = shift;
    my $key = shift;
    my $val = shift;
    return $self->{'_rig'}->change_config_value($self->{'_section'},$key,$val);
}


sub is_caching()
{
    my $self = shift;
    return 1 if ($self->{'_use_cache'} && $self->{'_use_cache'} eq 'Yes');
    return 0;
}

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

sub value()
{
    my $self = shift;
    $self->{'_value'} = $self->read() unless (defined($self->{'_value'}));
    return $self->{'_value'};
}

sub last_read
{
    my $self = shift;
    return $self->{'_last_read'} if (defined($self->{'_last_read'}));
    my $val = $self->rig->get_cache_time($self->type,$self->name); 
    return $val if (defined($val));
    return undef;
}

sub read_cache
{
    my $self = shift;
    if (@ARGV)
    {
	my $diff = shift;
	my $last_read = $self->last_read();
	my $time = Time::HiRes::time;
	return $self->read(@_) if ($diff && $last_read && ($time - $last_read) > $diff);
    }
    my $val = $self->rig->get_cache($self->type,$self->name); 
    $val = $self->read() unless defined($val);
    return $val;
}


sub read
{
    my $self = shift;
    if ($self->{'_use_cache'} && $self->{'_use_cache'} eq 'Yes')
    {
	my $val = $self->rig->get_cache($self->type,$self->name); 
	return $val if (defined($val));
    }
    return $self->read_nocache(@_);
}

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

sub has_ramp()
{
    my $self = shift;
    return $self->{'_has_ramp'};
}

sub set_cache
{
    my $self = shift;
    my $value = shift;
    $self->rig->set_cache($self->type,$self->name,$value,@_);
    return $value;
}

sub clear_cache()
{
    my $self = shift;
    $self->{'_value'} = undef;
    $self->rig->clear_cache($self->type,$self->name);
    return undef;
}

sub info_string()
{
    my $self = shift;
    return $self->{'_info_string'};    
}

sub read_names()
{
    my $self = shift;
    return @{$self->{'_read_names'}};
}

sub set_names()
{
    my $self = shift;
    return @{$self->{'_set_names'}};
}

sub check_cache
{
    my $self = shift;
    my $ref = $_[0];
    return if ($ref && ref($ref) eq 'RFC::Cache');
    $self->rig->errorlog('Warning, cache variable was not correct type, found: "'.ref($ref).'" expected RFC::Cache');
    $_[0] = RFC::Cache->new();
    return;
}

sub read_named
{
    my $self = shift;
    unless (@_)
    {
	$self->writedebug("Using default read() on device $self as no function name was specified!") if ($self->debug);
	return $self->read(); 
    }
    my $name = shift;
    foreach my $n ($self->read_names())
    {
	next unless ($name eq $n);
	$self->writedebug("Reading specified function '$n' on device $self") if ($self->debug);
	return $self->$n(@_);
    }
    $self->writedebug("Using default read() on device $self as function name '$name' was not found in list of valid function names") if ($self->debug);
    return $self->read(@_);
}

sub tag_type($)
{
    my $self = shift;
    my $tag = shift;
    foreach (@{$self->{'_setup_tags_readonly'}})
    {
	return 'Readonly' if ($_ eq $tag);
    }
    return 'Read-write';
}

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

sub master()
{
    my $self = shift;
    ### Returns the master device (if this device is a slave device using observer pattern ###
    return $self->{'_mdev'};
}

sub readonly()
{
    my $self = shift;
    return $self->{'_readonly'};
}

sub set_readonly()
{
    my $self = shift;
    $self->{'_readonly'} = 1;
    return 1;
}

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

sub monitor_rows()
{
    my $self = shift;
    return $self->{'_monitor_rows'};
}

sub tag_description()
{
    my $self = shift;
    my $tag = shift;
    return '' unless (defined($tag));
    return $self->{'_desc'}{$tag} if (exists($self->{'_desc'}{$tag}));
    return "Description for this device. Do not use ',' in text as that character is used as newline substitute." if ($tag eq 'comments');
    return "Determines if readstring should always return the empty string (only relevant for enabled devices)" if ($tag eq 'disable_readstring');
    return "Determines if the current device data is to be shown in the normal daily data plots (graph will be shown in the 'all data' page). Only relevant for enabled devices" if ($tag eq 'show_plot');
    return '';
}

sub sectionname
{
    my $self = shift;
    if (@_)
    {
	$self->{'_section'} = shift;
    }
    return $self->{'_section'};
}

sub test()
{
    my $self = shift;
    return 0;
}

sub test_full()
{
    my $self = shift;
    return $self->test();
}

sub test_string()
{
    my $self = shift;
    return "Device $self Has not defined a test function, assuming device is ok!";
}

sub get_time()
{
    my $self = shift;
    my @t = localtime(time);
    $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]);
    @t = split(/\s+/,$time);
    return @t;
}


sub readstring_ignore
{
    my $self = shift;
    if (@_)
    {
	$self->{'_readstring_ignore'} = shift;
    }
    return 1 if (exists($self->{'_disable_readstring'}) && $self->{'_disable_readstring'} && $self->{'_disable_readstring'} =~ /yes/i);
    return $self->{'_readstring_ignore'};
}

sub title()
{
    my $self = shift;
    return $self->{'_title'} if (defined($self->{'_title'}));
    return '';
}

sub readstring_furnace
{
    my $self = shift;
    return undef unless ($self->{'_readstring_furnace'});
    return $self->readstring(@_);
}

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));
    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;
    $self->writedebug("reading status for $self") if ($self->debug > 2);
    $self->die($self->{'_type'}." is a base class and does not impelemnt id->read(), only the derived classes does so!");
    return undef;
}


sub init()
{
    my $self = shift;
}


sub errorlog
{
    my $self = shift;
    $self->{'_rig'}->errorlog(@_);
}

sub disable_proglog
{
    my $self = shift;
    if (@_)
    {
	$self->{'_disable_proglog'} = shift;
    }
    return $self->{'_disable_proglog'};
}

sub proglog
{
    my $self = shift;
    my $msg = shift;
    return if ($self->{'_disable_proglog'});
    if (@_)
    {
	my $user = shift;
	if ($user)
	{
	    $self->{'_rig'}->proglog($msg,$user) unless (@_);
	}
	else
	{
	    $self->{'_rig'}->proglog($msg);    
	}
    }
    else
    {
	$self->{'_rig'}->proglog($msg);
    }
    return;    
}

sub rig()
{
    my $self = shift;
    return $self->{'_rig'};
}

sub name()
{
    my $self = shift;
    return $self->{'_name'};
}

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

sub type
{
    my $self = shift;
    return $self->{'_type'};
}

sub mode
{
    my $self = shift;
    return $self->{'_mode'};
}

sub change_reload
{
    my $self = shift;
    my $tag = shift;
    if ($tag)
    {
	foreach my $i (@{$self->{'_reload_tags'}})
	{
	    return 1 if ($tag eq $i);
	}
    }
    return 0;
}

sub hide_tag
{
    my $self = shift;
    my $tag = shift;
    if ($tag)
    {
	foreach my $i (@{$self->{'_hide_tags'}})
	{
	    return 1 if ($tag eq $i);
	}
    }
    return 0;
}

sub get_default
{
    ##############################################
    ### get_default()                          ###
    ### returns the default setting for the    ###
    ### tag specified, if no tag is specified  ###
    ### the complete default hash is returned  ###
    ##############################################
    my $self = shift;
    my $tag = shift;
    if ($tag)
    {
        return $self->{'_default'}{$tag} if (exists($self->{'_default'}{$tag}));
	return 'No' if ($tag eq 'disable_readstring');
	return 'Yes' if ($tag eq 'show_plot');
        return undef;
    }
    return %{$self->{'_default'}};
}

sub setup_tags()
{
    ###############################################
    ### setup_tags()                            ###
    ### Returns a list of acceptable setup tags ###
    ### Can be used by a application to easialy ###
    ### get the setup tags and values           ###
    ###############################################
    my $self = shift;
    my @res = ();
    @res = @{$self->{'_setup_tags'}} if ($self->{'_setup_tags'});
    push @res,'comments';
    push @res,'disable_readstring' unless (ref($self) =~ /Alert|Adapter/);
    return @res;
}


sub setup_tags_legacy()
{
    my $self = shift;
    my @res = ();
    @res = @{$self->{'_legacy_tags'}} if ($self->{'_legacy_tags'});
    return $self->setup_tags() unless (@res);
    push @res,'comments';
    push @res,'disable_readstring' unless (ref($self) =~ /Alert|Adapter/);
    return @res;
}

sub get_tag_values($)
{
    ##############################################
    ### get_tag_values($)                      ###
    ### returns a list of the possible values  ###
    ### the specified tag can have.            ###
    ### Returns undef if not defined which is  ###
    ### the case if the tag can be any value   ###
    ### (in the case of floating point values  ###
    ### for instance)                          ###
    ### This method (and the corresponding     ###
    ### values) are mainly to be used for UI   ###
    ### purposes                               ###
    ##############################################
    my $self = shift;
    my $tag = '_values_'.shift;
    return () unless (exists($self->{$tag}));
    my @res = ();
    @res = @{$self->{$tag}} if ($self->{$tag});
    return @res;
}

sub AUTOLOAD()
{
    ################################################################
    ### AUTOLOAD()                                               ###
    ### If caller ended here, undefiend subroutine call happened ###
    ################################################################
    my $self = shift;
    my $type = ref($self) or die ref($self)." is not an object!";
    $self->die("Unknown function call $AUTOLOAD attempted for $self!");
}

sub DESTROY()
{

}

sub print_setup()
{
    #############################################
    ### print_setup()                         ###
    ### utility function for debugging        ###
    ### purposes, prints the contents of the  ###
    ### device instance data fields $self->{} ###
    #############################################
    my $self = shift;
    my @arr = ('*******************************************');
    push @arr,'Device ID: '.$self->{'_type'};
    push @arr,'Member functions:';
    my $class = ref $self;
    $class =~ s/=.*//;
    my @methods = Class::Inspector->methods( $class, 'full', 'public' );
    foreach my $m (@methods)
    {
        if (ref($m) =~ /ARRAY/)
        {
            foreach (@{$m})
            {
                push @arr,"\t$_";
            }
            next;
        }
        push @arr,"\t$m";
    }
    push @arr,'';
    push @arr,'Instance data (Field,  Value):';
    foreach my $key (keys %{$self})
    {
        if (defined ($self->{$key}))
        {
            if (ref($self->{$key}) =~ /ARRAY/)
            {
                push @arr,"$key, Array with values:";
                push @arr,"\tIndex\tValue";
                my $x = 0;
                foreach (@{$self->{$key}})
                {
                    push @arr,"\t$x\t'$_'";
                    $x++;
                }
                push @arr,'';
                next;
            }
            if (ref($self->{$key}) =~ /HASH/)
            {
                push @arr,"$key, Asociative array with values:";
                push @arr,"\tKey\tValue";
                foreach my $k (keys %{$self->{$key}})
                {
                    push @arr,"\t'$k'\t'$self->{$key}{$k}'";
                }
                push @arr,'';
                next;
            }
            push @arr,$key.",\t'$self->{$key}'";
        }
        else
        {
            push @arr,$key.",\t\\N";
        }
    }
    push @arr,'';
    ### Obsevers ###
    push @arr,'Observers:';
    my $max = scalar(@{$self->{'_observers'}});
    my @response = ();
    for( my $x = 0; $x < $max; $x++)
    {
        my $d = $self->{'_observers'}[$x];
	my $i = $$d{'device'};
	push @arr,$$i;
    }
    push @arr,'';
    return join("\n",@arr);
}

sub print_config()
{
    my $self = shift;
    return $self->type;
}
