package RFC::Rig;
#$Id: Rig.pm,v 1.336 2023/12/08 06:08:02 sqko Exp $

###################################################################
#
#
#
#     Package RFC::Rig;
#
#
#
# This class manages the complete setup ofr a RFCcontroll rig
# To obtain an instance call the constructor:
#
# $id = RFC::Rig->new($rignr)
# $id = RFC::Rig->new($rignr,$debug_level)
# $id = RFC::Rig->new($rignr,$debug_level,'nocheck')
#
# Where $rignr is an integer.
#
# If the 'nocheck' parameter is specified, previously valid rigs can be instantiated.
# Note that this is only ever intended to be used for accessing historical data
# for decommisiioned rigs as trying to instantiate rigs which has never been created
# or get devices / access and/or change parameters in this case is undefined behaviour!
#
# RFC::Rig implements a type of singleton pattern in the way that only a single
# instance of each rig number can exist at any given time. 
# Thus two successive calls of new() with the same argument will 
# return the same object. However two calls to new() with different arguments
# will return two different individual objects.
#
# -- \subsection{Public member functions}
#
# Each Rig instance has the following public member functions:
#
# $id->lock_control()         Locks the semafore file asociated with 
#                             the rig instance control.
# $id->unlock_control()       Unlocks the semafore for rig control.
# $id->die($)                 Wraper for CORE::die, but dumps instance 
#                             setup.
# $id->config()               Returns the configuration object of the 
#                             current test (An ElchemeaConfig instance).
# $id->begin()                Initiates a transaction.
# $id->commit()               Commits a transaction.
# $id->rollback()             Roll back a transaction.
# $id->error()                Returns the errorstring (if any).
# $id->riglock()              Returns the SemaforeFile object for the rig 
#                             instance
# $id->mail_from()            Returns the address where return mails are 
#                             to be sent (in most cases this will be user@host
#                             But some mail systems require the from field
#                             to point to a verified mail domain which may
#                             be different than the RFCcontrol server.
# $id->set_warning($)         Sets the specified string in the mailwarinig 
#                             file used to make sure that only one errormail
#                             is sent for each warning condition.
# $id->check_warning($)       Checks if the specified type is already in the
#                             warning mail file.
# $id->unset_warning([$])     Removes the specified type from the warningmail
#                             file.
#                             If called without argument, all warnigns are removed.
# $id->disable_warning_mails([$])
#                             Sets or gets the setting which allows for 
#                             supressing sending warning emails to users
# $id->is_iv()                Returns true if the iv_in_progress file exists
# $id->iv_start()             Retruns 1 (true) if the iv_in_progress file does
#                             not exist, and creates it in the process.
# $id->iv_stop()              Removes the iv_in_progress file (effectively stopping
#                             any programs / iv's locked to the existence of 
#                             this file).
# $id->iv_in_progress()       Returns the SemaforeFile object representing the
#                             iv_in_progress file. Can be used for using the 
#                             file for storing and retrieving process parameters.
# $id->warning_mail($type,$s,[$subj],[opt emaillist])
#                             Sends a mail with content $s of type $type to 
#                             the recipients defined in the 'warning_mail' key
#                             in the 'main' section of the rig configuration.
#                             If no recipients are found the list defined in
#                             the 'errormails' key in the 'global' section of the 
#                             global configuration is used instead.
#                             Note that the mail is only sent if the $type
#                             is nor already defined in the warningmail file.
#                             If a third argument is supplied, this becomes the subject 
#                             of the mail, otherwise a default subject is used.
#                             If a fourth argument is given it is assumed to be a
#                             comma separated list of email addresses which are to be
#                             used instead of the global list.
# $id->kanaldata()            Sets and gets the logged data (in conjnction with 
#                             data logging. If arguments are passed, they are
#                             assumed to be in the form returned by the readstring
#                             member function of a BaseDevice class instance.
# $id->readstring([$])        Does a complete data logging by callng the readstring
#                             member function on all asociated BaseDevice instances
#                             (This includes derived classes). This function handles 
#                             gracefully if a device instance dies while measuring,
#                             in which case an error is logged and a dummy value is
#                             returned for that device instead of the real value.
#                             This is to ensure that datalogging will proceed as 
#                             much as possible.
#                             If an argument is passed to readstring, it must be an 
#                             instance of RFC::Cache.
#                             Notice, that readstring does NOT write any data to file,
#                             it only returns a text string containing all the data.
#                             (Saving data to file can be handled by the normal Perl file
#                             handling functions).
# $id->readstring_furnace()   Same as readstring, except it only logs temperature controlers,
#                             temperature loging devices and simplechannels. 
#                             Used by RFCfurnace.
# $id->list_sections()        Returns a list of configuration sections (names).
#                             If a argument is specified, only section names matching
#                             the specified string are returned.
# $id->config_section_exists($)  
#                             Returns true if the specified section exists in the 
#                             current confiuration.
# $id->config_key_exists($$)  Returns true if the specified section and key exists.
# $id->get_cv($$)             Returns the value asociated with the specified section
#                             and key (returns undef if no no matching section is 
#                             found or if no matching key is found in the specified 
#                             section (Arguments: section,key).
#                             If called in a list context, it returns an array which is the
#                             result of splitting the configuration value along any commas
#                             (Notice that the split ignores any spaces before and after commas).
# $id->get_cv_test($$$)       Same as above, but for specified test number (defaults to
#                             current test if no is specified).
#                             If called in a list context, it returns an array which is the
#                             result of splitting the configuration value along any commas
#                             (Notice that the split ignores any spaces before and after commas).
# $id->get_cv_list($$)        Same as get_cv($$) except it returns a list of elements,
#                             the list is the return value of get_cv($$) split up along any
#                             commas. If the configuration value does not exist or is empty
#                             get_cv_list($$) returns an empty list.
#                             Note that this function is deprecated from version 5.3.5 and
#                             onwards, Users should switch to using get_cv in a list context
#                             as this will now behave as get_cv_list
# $id->change_config_value($$$)
#                             Sets the value asociated with the specified section and
#                             key to the specified value (arguments: section,key,newvalue) 
# $id->modtime()              Returns the modification time for the configuration file
#                             fore the test specified (default is curent test).
# $id->set_debug($)           Sets the debug level for the Rig instance as well as all.
#                             device instances attatched to the rig instance.
#                             Implemented using the Visitor pattern.
# $id->debug()                Sets or gets the debug level for the rig instance itself
#                             (that is without setting it for all the device instances).
#                             If called without arguments returns the current debug 
#                             level.
# $id->init()                 Initialises (or reinitialises) the rig instance. This 
#                             member function loads all device instances which according
#                             to the configuration file needs to be attatched. On succes
#                             any call to error() returns an empty string, otherwise the string
#                             returned contains the name of the offending device which
#                             could not be initialised and caused init to fail / die.
#                             If the init() function is not called within an eval{} guard, it 
#                             simply dies with an error indicating what went wrong.
#                             The init() function is automatically called by the constructor
#                             (within an eval{} gurad).
# $id->test()                 Returns 1 (true) if init returned no errors, 0 otherwise.
# $id->webdir([$testnr])      Returns the current web directory path if called without argument.
#                             If an argument is specified (and it is a valid test number)
#                             the directory path for that directory is returned instead.
# $id->homedir()              Returns the home directory path for the rig.
# $id->hometest()             Returns the home test directory path for the rig.
# $id->get_sessionlog($)      Returns the testlog for the specified test (default is
#                             the current test if no test is specified).
# $id->get_userlog($)         Returns the userlog for the specified test (default is
#                             the current test if no test is specified).
# $id->get_errorlog($)        Returns the errorlog for the specified test (default is
#                             the current test if no test is specified).
# $id->name()                 Returns the Rig name (the integer passed to the RFC::Rig
#                             constructor).
# $id->type()                 Returns the string 'Rig';
# $id->session()              Returns the current test number.
# $id->proglog($[$])          Appends the specified string to the rig proglog for the
#                             currnet test. If an atdditional argument is specified it
#                             is assumed to be the username of the originating user and
#                             the string is appended with this information, if not a
#                             generic user identification is appended including terminal
#                             of origin (usually 'rigX' on /dev/pts/N). In addition an 
#                             entry is logged in the tracelog in this case.
# $id->userlog($[$])          Appends the specified string to the rig userlog for the
#                             currnet test. If an atdditional argument is specified it
#                             is assumed to be the username of the originating user and
#                             the string is appended with this information, if not a
#                             generic user identification is appended including terminal
#                             of origin (usually 'rigX' on /dev/pts/N). In addition an 
#                             entry is logged in the tracelog in this case.
# $id->disable_proglog([$])   Sets or gets the proglog_disabled attribute.
#                             if proglog_disabled is set to true, all calls to proglog simply
#                             return s withoug appending to the proglog.
#                             Default is 0 (flase, logging enabled), and this setting should
#                             only be carefully used.
# $id->errorlog($[$])         Appends the specified string to the rig errorlog for the
#                             currnet test similar to proglog. Note that all logged errors 
#                             are automatically appended to the proglog.
# $id->tracelog($)            Appends the specified string to the rig tracelog for the
#                             currnet test. The logged string includes complete stack 
#                             backtrace
# $id->print_setup()          Prints out the complete current setup including all member 
#                             functions and data fields (uses Class::Inspector).
#                             Overloads the print_setup() function in Debug.pm.
# $id->test_list()            Returns a list of all devices. The returnes list is a 
#                             array of hashes (with each hash containing id and name of
#                             a specific device).
# $id->print_config()         Prints out the rig configuration 
# $id->check_run()            Forces an error if the current user number does not match 
#                             the rig number (as determined by RFC::Main::get_user_number)
# $id->check_group()          Forces an error if the current user is not part of the RFCcontrol
#                             base group (the group the apache web server is also part of).
# $id->inc_test($$)           Increases the test number and reinitialises the rig instance.
#                             The aruments are the additional test information and the 
#                             name of the user initialising a net test.
# $id->remote_log($)          Appends the supplied string to the remote logbook. 
#                             The call is made by calling the url specified in the 
#                             'logbook_url' key in the main section of the main 
#                             configuration file appended with the supplied string 
#                             (which will be url-encoded). 
#                             Thus if the logbook_url contains 
#                             'https://foo.bar/cgi-bin/log.cgi?msg=' and the 
#                             function is called with the string 'test_msg' 
#                             the resulting url called will be:  
#                             'https://foo.bar/cgi-bin/log.cgi?msg=Test_msg'
#                             Please note that additional (fixed) parameters may be specified
#                             in the url string, they just have to be before the appended string
#                             using normal URL encoding (ampersands etc).
# $id->DESTROY()              Object destructor.
# 
# A special function is the DESTROY() member function. In most object oriented programming
# languages, the implementatiion ensures that the destructor is called in reverse order
# on an object and it's internal objects. Unfortunately the Perl GC does not guarantee this,
# as a result (and the often deeply nested object tree for a RFC:Rig instance), 
# if the rig's destructor is not called explicitly before program termination, the default 
# object cleanup may result in attempts to de-refer already destroyed objects durring global
# cleanup. In most cases this is a harmless error, but for some objects (PID's in particular),
# this will result in internal state not beeing saved (as the file object for saving the 
# state is already gone)
#
# RFC::Rig also implements the Visitor pattern by suppliying the Accept() method.
#
# $id->Accept($)      Runs the Accept() function for all devices with the supplied visitor as argument
#                     (behaves as a CompositeElement (GoF)).
#                     Also calls the VisitComplex() function on the visitor.
# $id->ClearVisitor() Special function which clears the list of already 
#                     seen visitors
# 
# Rhe RFC::Rig class also implements the Gof Composite pattern (together with the 
# RFC::BaseDevice derived classes) with RFC::Rig acting as a Gof Component class 
# as will as the Gof Composite class.
#
#
# Device management.
# Any RFC::Rig instance has a number of device instances asociated. Some of these
# devices are read only devices (datalogging) while others may be control devices.
#
# The types avaliable are:
# -- \begin{longtable}{l}
# -- simplechannel \\
# -- relay \\
# -- gas (the plural of this is gasses) \\
# -- gasgroup \\ 
# -- MFC (Mass flow controler) \\
# -- multiplex (plural multiplexers), used for gas multiplexing. \\
# -- water (water bublers) \\
# -- PSU (Power supplies, including electronic loads) \\
# -- templog (Temperature logging only, not control) \\
# -- tempcontrol (Temperature controller) \\
# -- analog (Analog output devices) \\
# -- filter (virtual device) \\
# -- logic (virtual device) \\
# -- math (virtual device) \\
# -- Alert (virtual device) \\
# -- Adapter (virtual device) \\
# -- PID (Virtual control device for PID control systems) \\
# -- \end{longtable}
#
# and a list of device types can be obtained by calling:
#
# $id->list_types();
#
# Each of these device types has different member functions, but common for all
# of them is that they must be derived from BaseDevice.pm (which defines the base.
# member functions on which RFC::Rig relies on). To get a device instance of a particular 
# type, call
#
# $id->get_device($type,$name);  
#
# The type must match one of the above defined types (otherwise the function merely
# return undef).
# If no device exist of the type and name specified, undefined is returned instead
# of a device instance, note that this function does NOT initialise or load new
# device instances, it merely returns references to already initialised / loaded 
# devices (This is usually handles by the class constructor/init function).
#
# It is also possible to use the init_device function:
#
# $id->init_device($type,$name);
# 
# This function tries to initialise/load the device if it does not already exist.
#
# It is possible to get lists of devices and avaliable devices (that is all possible
# devices of a type, irrespectively of it is loaded or not) as well as supported 
# device types by using the following functions:
#
# $id->list_types()            Returns a list of supported device types.
# $id->list_types_nofilter()   Returns a list of supported device types but excludes 
#                              filter types.
# $id->get_uiname($)           Returns a human readable string describing the
#                              specified device type (intended for use on the UI).
# $id->list_devices($)         Lists the devices of the specified type.
# $id->list_devices_subtype($$) 
#                              Lists the devices of the specified type and subtype.
# $id->list_devices_control($) Lists the enabled devices of the specified type which 
#                              is not readonly.
# $id->list_devices_control_subtype($$)
#                              Lists the enabled devices of the specified type and
#                              subtype which is not readonly.
# $id->list_names($)           Lists the devices of the specified type which will be
#                              explicitly initialised during rig initialisation.
#                              Note that this list does not include implicit devices
#                              or devices initialised as part of other devices!
# $id->list_names_tag($)       Returns the tag name used for controling the
#                              enabled status for the devices of the specified
#                              type (an enabled device gets explicitly initialised).
# $id->avaliable_devices($)    Lists the possible devices of the specified type.
# $id->avaliable_devices_nofilter($)
#                              Lists the possible devices of the specified type but 
#                              excludes filter devices which may masquerade.
# $id->device_sectionname($)   Returns the cofiguration section base name (identifier)
#                              for the device type in question. returns 'channel_' if
#                              called with the 'simplechannnel' argument for instance
#                              as the simple channel 'cell_voltage' is configured  in
#                              the 'channel_cell_voltage' section.
# $id->get_devce($$)           Returns a device instance of the specified type and name.
# $id->delete_device($$)       Removes a device instance of the specified type and name.
#                              Use with extreme caution as used wrongly may cause perl's 
#                              version of a NULL-pointer exception lateron!
# $id->register_device($$)     Attatches the specified device instance to the rig instance. 
#                              Note duplicate names not allowed. (results in an error).
#                              Argu,ents are: type,name.
# $id->set_cache($$$[$])       Saves a value for the specified device type and name.
#                              Arguments: Device type, Device name, Value [opt timestamp].
#                              If no timestamp is supplied the current time is used instead.
# $id->get_cache($$)           Gets the cached value for the specified device type and name.
#                              Returns undef if caching is not allowed or if no value was 
#                              found for the type and name specified.
# $id->get_cache_time($$)      Gets the cache time for the specified device type and name.
#                              Returns undef if caching is not allowed or if no value was 
#                              found for the type and name specified.
# $id->store_cache()           Stores the cached values in a file. Is called automatically
#                              by the RFC::Rig destructor.
# $id->load_cache()            Loads the stored cache values.
# $id->clear_cache([$$])       Clears the persistent cache.
#                              If optional parameters are passed, only the cache for that composite key
#                              (type and name) is cleared.
# $id->allow_cache([$])        Sets or gets if persistent caching is to be allowed.
#                              Default is to not allow caching. If caching is disallowed
#                              All calls to get_cache() will return undef;
#                              Notice that only if the 'allow_caching' key in the 'IV_control'
#                              is set to 'Yes' is caching allowed to be turned on
#                              (That is, bu setting 'allow_caching' to no disables all 
#                              persistent caching durring iV curves irrespective of device 
#                              configuration).
# $id->list_caching()          Returns a list of devices for which caching is enabled.
#                              Notice that filter devicec can never be caching.
#
# For all of the above functions the specified type must match one of the types returned
# by $id->list_types() or the functions returns undef.
#
#
# A number of control functions are also defined. They each operate on one 
# of the device instances (depending on type). 
# 
# $id->set_temp($)            Sets the specified temperature setpoint for the specified
#                             device name (if no device name is specified and only one.
#                             temperatue control device is initialised, that device is 
#                             used).
# $id->set_ramp($)            Same as above, but for temperature ramprate (C/hour). 
# $id->current($)             Sets the specified DC curent for the specified PSU
#                             (If no PSU name is specified and only one PSU devce is
#                             initialised, that one is used).
# $id->voltage($)             Same as above, but for the DC voltage.
#
# -- \subsection{Private member functions}
#
# Each RFC::Rig instance also has the following private member functions. 
#
# Perl does not enforce public / private declerations however, so the functions are avaliable.
# The private member functions is not intended for normal use, only for advanced use by system 
# maintainers! 
#
# $id->load_session_nr()      Loads the session number from the session number file.
# $id->create_dirs()          Checks the current session and creates the directories
#                             asociated with the test if nescesarry.
# $id->last_read()            Dummy function returning current time
#
# Each device type has four handling functins described for the simplechannel class
# below. The four types of handling functions for device type TYPE are:
#
# -- \begin{longtable}{l}
# --  $id->TYPEs(); \\
# --  $id->TYPE(); \\
# --  $id->init_TYPE(); \\
# --  $id->avaliable_TYPEs(); \\
# --  $id->register_TYPE($); \\
# -- \end{longtable}
#
# $id->simplechannels()       Returns a list of the current simplechannels.
# $id->simplechannel($)       Returns the Simplechannel class instance with the 
#                             specified name (if it exists, undef otherwise).
# $id->init_simplechannel($)  Attempts to initialise a new simplechannel device
#                             with the specified name, returns the device instance created.
#                             Forces an error if the nescesarry configuration
#                             section is not found in the configuration file.
# $id->avaliable_simplechannels()
#                             Returns a list of possible simplechannels (including 
#                             disabled simplechannels).
# $id->register_simplechannel($)
#                             Attatches the specified Simplechanel device instance 
#                             to the rig instance. Note duplicate names not allowed.
#                             (results in an error).
#
# Eeach type also has a constructor wraper function asociated with it which
# is a member function of the rig instance:
# 
# -- \begin{longtable}{l}
# -- $id->new_AnalogOut($) \\
# -- $id->new_RELAY($) \\
# -- $id->new_SimpleChannel($) \\
# -- $id->new_PSU($) \\
# -- $id->new_Multiplexer($) \\
# -- $id->new_MFC($) \\
# -- $id->new_TEMP($) \\
# -- $id->new_GAS($) \\
# -- $id->new_Water($) \\
# -- $id->new_Templog($) \\
# -- $id->new_GasGroup($) \\
# -- $id->new_filter($) \\
# -- $id->new_Logic($) \\
# -- $id->new_Math($) \\
# -- $id->new_PID($) \\
# -- $id->new_Alert($) \\
# -- $id->new_Adapter($) \\
# -- \end{longtable}
#
# The new_device functions are wrapper functions for the various Device.pm 
# factory functions. They are used by $rig->init() as well as to obtain an 
# device node for a not enabled device (For testing purposes when installing 
# a ned hwardware/logical device)                      
#
###################################################################

use strict;
use warnings;
use RFC::Header;
use RFC::Main qw();
use RFC::Device;
use RFC::Visitor;
use ElchemeaConfig;
use SemaforeFile;
use Debug;
use File::Touch;
use POSIX qw();
our @ISA = qw(RFC::Observer);
use Fcntl qw(:DEFAULT :flock);
use Class::Inspector;
use File::Copy;
use LWP::UserAgent;
use URI::Escape;
use Sys::Hostname qw(hostname);

use overload
    '""' => \&Rig_to_string,
    '.' => \&Rig_concat,
    'bool' => sub {return 1;},
    'fallback' => 1;

my %insth = ();

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 $n = shift;
    if ($n =~ /(\d+)/)
    {
	$n = $1;
    }
    else
    {
	die "$n is not a valid rig name (only integers allowed)\n";
    }
    my $nstr = 'Rig '.$n;
    ## Insure singleton for a given rig number (only one RFC::Rig instance for each rig ##
    foreach my $key (keys %RFC::Rig::insth)
    {
	next unless ($key eq $nstr); 
	my $self = $RFC::Rig::insth{$key};
	$self->writedebug("Returning existing instance of $self") if ($self->debug);
	return $self;
    }
    my $self = $class->SUPER::new();
    $self->{'_name'} = $n;
    bless $self,$class;
    $self->{'_session'} = 0;
    $self->{'_oldsession'} = undef;
    $self->{'_config_old'} = [];
    $self->{'_config'} = undef;
    $self->{'_configlock'} = '/home/celltest/RFCRig_'.$self->{'_name'}.'_config.lock';
    $self->{'_userlog'} = undef;
    $self->{'_proglog'} = undef;
    $self->{'_webtest'} = undef;
    $self->{'_hometest'} = undef;
    $self->{'_riglock'} = '/home/celltest/RFCRig_'.$self->{'_name'}.'.lock';
    $self->{'_tracelock'} = '/home/celltest/RFCRig_'.$self->{'_name'}.'_trace.lock';
    $self->{'_controllock'} = '/home/celltest/RFCRig_'.$self->{'_name'}.'_control.lock';
    $self->{'_info'} = undef;
    $self->{'_trace'} = undef;
    $self->{'_kanaldata'} = [];
    unless (-e $self->{'_riglock'})
    {
	sysopen(FH, $self->{'_riglock'}, O_WRONLY | O_CREAT) or CORE::die "Error: Could not open $self->{'_riglock'} $!";
        chmod 0666, $self->{'_riglock'};
        CORE::close FH;
    }
    unless (-e $self->{'_controllock'})
    {
	sysopen(FH, $self->{'_controllock'}, O_WRONLY | O_CREAT) or CORE::die "Error: Could not open $self->{'_controllock'} $!";
        chmod 0666, $self->{'_controllock'};
        CORE::close FH;
    }
    my $fn = $self->{'_controllock'};
    sysopen($self->{'_lock_control'}, $fn, O_WRONLY | O_CREAT) or $self->die("Error: Could not open lockfile '$fn' $!");
    $self->{'_error'} = '';
    $self->{'_kanaldata'} = [];
    $self->{'_TEMPLOG'} = {};
    $self->{'_TEMPCONTROL'} = {};
    $self->{'_GAS'} = {};
    $self->{'_GASGROUP'} = {};
    $self->{'_MFC'} = {};
    $self->{'_WATER'} = {};
    $self->{'_SIMPLE'} = {};
    $self->{'_RELAY'} = {};
    $self->{'_PSU'} = {};
    $self->{'_MULTI'} = {};
    $self->{'_AOUT'} = {};
    $self->{'_FILTER'} = {};
    $self->{'_PID'} = {};
    $self->{'_LOGIC'} = {};
    $self->{'_MATH'} = {};
    $self->{'_ALERT'} = {};
    $self->{'_ADAPTER'} = {};
    $self->{'_transaction'} = 0;
    $self->{'_types'} = ['simplechannel','relay','templog','tempcontrol','MFC','water','gas','gasgroup','PSU','analog','multiplex','filter','PID','logic','math','Alert','Adapter'];
    $self->{'_types_nofilter'} = ['simplechannel','relay','templog','tempcontrol','MFC','water','gas','gasgroup','PSU','analog','multiplex','PID','logic','math','Alert'];
    $self->{'_uinames'} = {
	'simplechannel' => 'Simple channel',
	'relay' => 'Control relay',
	'templog' => 'Temperature log',
	'tempcontrol' => 'Temperature control',
	'MFC' => 'Mass flow controler',
	'water' => 'Water bubbler',
	'gas' => 'Gas',
	'gasgroup' => 'Gas group',
	'PSU' => 'DC power supply',
	'analog' => 'Analog output',
	'multiplex' => 'Gas multiplexer',
	'filter' => 'Filter device (virtual)',
	'logic' => 'Logic device (virtual)',
	'math' => 'Arithmetic device (virtual)',
	'Alert' => 'Alert device (virtual)',
	'Adapter' => 'Adapter device (virtual)',
	'PID' => 'Feedback regulators (virtual)',
    };
    $self->{'_sectionnames'} = {
	'simplechannel' => 'channel_',
	'relay' => 'relay_',
	'templog' => 'temp_',
	'tempcontrol' => 'TControl_',
	'MFC' => 'controler_',
	'water' => 'water_',
	'gas' => 'gas_',
	'gasgroup' => 'gas_group_',
	'PSU' => 'PSU_',
	'analog' => 'analog_out_',
	'multiplex' => 'gas_multiplexer_',
	'filter' => 'filter_',
	'logic' => 'Logic_',
	'math' => 'Math_',
	'Alert' => 'Alert_',
	'Adapter' => 'Adapter_',
	'PID' => 'PID_',
    };
    unless (-e $self->{'_configlock'})
    {
	sysopen(FH, $self->{'_configlock'}, O_WRONLY | O_CREAT) or CORE::die "Error: Could not open $self->{'_configlock'} $!";
        chmod 0666, $self->{'_configlock'};
        CORE::close FH;
    }
    if (@_)
    {
	$self->debug(shift);
    }
    ### Add check for valid rig numbers ###
    $self->die("$self does not exist!") unless (@_ || RFC::Main::check_rig_nr($self->name));
    $self->{'_iv_in_progress'} = SemaforeFile->new($RFC::Header::publicdir.'rig'.$self->name.'/iv_in_progress',$self->{'_configlock'});
    my $cache_fn = $self->homedir.'/cache';
    unless (-e $cache_fn)
    {
	touch($cache_fn);
	chmod 0666,$cache_fn;
    }
    $self->{'_cache_file'} = SemaforeFile->new($cache_fn,$self->{'_configlock'});
    $self->{'_cache'} = {};
    $self->{'_cache_modified'} = 0;
    $self->{'_disable_proglog'} = 0;
    $self->{'_allow_cache'} = 0;
    $self->{'_disable_warning_mails'} = 0;
    eval {
	$self->init;
    };
    if ($@)
    {
	my $errstr = 'Init failed: '.$@;
	chomp $errstr;
	$errstr .= ', Last attempted device initialisation was: '.$self->{'_error'};
	$self->{'_error'} = $errstr;
	warn $errstr,"\n";
    }
    $RFC::Rig::insth{$self->Rig_to_string} = $self;
    return $self;
}

return 1;


sub remote_log($)
{
    my $self = shift;
    my $msg = shift;
    my $url = $self->get_cv('main','logbook_url');
    return undef unless ($url && defined($msg));
    $msg = uri_escape($msg);
    my $ua = LWP::UserAgent->new();
    $ua->timeout(60);
    my $query = $url.$msg;
    my $request = new HTTP::Request('GET',$query);
    my $response = $ua->request($request);
    if ($response->is_success)
    {
        return $response->content;
    }
    else
    {
        $self->errorlog("Error contacting $url: ".$response->status_line);
        return 0;
    }
}


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

sub Rig_to_string
{
    my $self = shift;
    return 'Rig '.$self->{'_name'};
}

sub list_caching
{
    my $self = shift;
    my @list = ();
    foreach my $type ($self->list_types_nofilter)
    {
	foreach my $name ($self->avaliable_devices($type))
	{
	    my $dev = $self->get_device($type,$name);
	    push @list,$dev if ($dev && $dev->is_caching());
	}
    }
    return @list;
}

sub allow_cache
{
    my $self = shift;
    if (@_)
    {
	my $test = $self->get_cv('IV_control','allow_caching');
	if ($test && $test =~ /yes/i)
	{
	    $self->{'_allow_cache'} = shift;
	}
    }
    return $self->{'_allow_cache'};
}

sub store_cache()
{
    my $self = shift;
    return undef unless ($self->{'_cache_modified'});
    my @list = ();
    $self->writedebug("Storing persistent cache on disk") if ($self->debug);
    foreach my $key (keys %{$self->{'_cache'}})
    {
	push @list,$key.'='.$self->{'_cache'}{$key} if (defined($self->{'_cache'}{$key}));
    }
    $self->{'_cache_file'}->writeline(@list) if ($self->{'_cache_file'});
    $self->{'_cache_modified'} = 0;
    return undef;
}

sub clear_cache()
{
    my $self = shift;
    if (@_)
    {
	my $class = shift;
	my $name = shift;
	my $key = $class.':'.$name;
	$self->writedebug("Clearing cache value for device '$name' of type '$class'") if ($self->debug);
	delete $self->{'_cache'}{$key};
	$self->{'_cache_modified'} = 1;
	return undef;
    }
    $self->writedebug("Clering persistent cache") if ($self->debug);
    $self->{'_cache_file'}->writeline('');
    $self->{'_cache'} = {};
    $self->{'_cache_modified'} = 0;
    return undef;
}

sub load_cache()
{
    my $self = shift;
    $self->{'_cache'} = {};
    $self->writedebug("Loading persistent cache from disk") if ($self->debug);
    foreach my $line ($self->{'_cache_file'}->readlines())
    {
	next unless ($line);
	my ($key,$val) = split(/\=/,$line);
	$self->{'_cache'}{$key} = $val;
    }
    return undef;
}

sub set_cache
{
    my $self = shift;
    my $class = shift;
    my $name = shift;
    my $value = shift;
    my $time = Time::HiRes::time();
    $time = shift if (@_);
    my $key = $class.':'.$name;
    unless (defined($value))
    {
	$self->writedebug("Attempting to store a undefined value in the cache detected, aborting") if ($self->debug());
	return undef;
    }
    $self->load_cache() unless (%{$self->{'_cache'}});
    $self->writedebug("Setting cache value '$value' for device '$name' of type '$class'") if ($self->debug);
    $self->{'_cache'}{$key} = $value.':'.$time;
    $self->{'_cache_modified'} = 1;
    return $value;
}

sub get_cache($$)
{
    my $self = shift;
    return undef unless ($self->{'_allow_cache'});
    my $class = shift;
    my $name = shift;
    my $key = $class.':'.$name;
    $self->load_cache() unless (%{$self->{'_cache'}});
    $self->writedebug("retrieving cache value for device '$name' of type '$class'") if ($self->debug);
    my $str = $self->{'_cache'}{$key};
    return $str unless ($str && $str =~ /:/);
    my ($val,$time) = split(/:/,$str);
    return $val;
}

sub get_cache_time($$)
{
    my $self = shift;
    my $class = shift;
    my $name = shift;
    my $key = $class.':'.$name;
    $self->load_cache() unless (%{$self->{'_cache'}});
    $self->writedebug("retrieving data cache time for device '$name' of type '$class'") if ($self->debug);
    my $str = $self->{'_cache'}{$key};
    return undef unless ($str && $str =~ /:/);
    my ($val,$time) = split(/:/,$str);
    return $time;
}

sub last_read
{
    my $self = shift;
    return time;
}

sub iv_in_progress()
{
    my $self = shift;
    return $self->{'_iv_in_progress'};
}

sub mail_from()
{
    my $self = shift;
    my $host = RFC::Main::get_cv('global','mailhost');
    $host = hostname() unless ($host);
    my $usernumber = $<;
    my $username = RFC::Main::get_user_name($usernumber);
    my $user = $self->get_cv('main','mailuser');
    my $hn = hostname();
    my @l = split(/\./,$hn);
    my $global_user = RFC::Main::get_cv('global','mailuser');
    $username = $global_user.'_rig'.$self->name.'_on_'.$l[0] if ($global_user);
    $username = $user if ($user);
    $username = 'RFCcontrol' unless ($username);
    return $username.'@'.$host;
}

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


sub is_iv()
{
    my $self = shift;
    return $self->{'_iv_in_progress'}->exist;
}

sub iv_start()
{
    my $self = shift;
    my $status = 0;
    $self->{'_iv_in_progress'}->lock_ex;
    unless ($self->{'_iv_in_progress'}->exist)
    {
	$self->{'_iv_in_progress'}->writeline('');
	$status = 1;
    }
    $self->{'_iv_in_progress'}->lock_un;
    return $status;
}

sub iv_stop()
{
    my $self = shift;
    $self->{'_iv_in_progress'}->lock_ex;
    unlink $self->{'_iv_in_progress'}->filename if ($self->{'_iv_in_progress'}->exist);
    $self->{'_iv_in_progress'}->lock_un;
}

sub writedebug
{
    my $self = shift;
    eval {
	$self->tracelog(@_);
    };
    if ($@)
    {
	my $str = $@;
	chomp $str;
	my $mess = join("\n",@_);
	warn "Error: '$str' on atempt to write '$mess' to tracelog!\n";
    }
    return $self->SUPER::writedebug(@_);
}

sub homedir()
{
    my $self = shift;
    return $userdir.'rig'.$self->name.'/';
}

sub hometest()
{
    my $self = shift;
    return $self->homedir.$self->name.'test'.$self->session.'/';
}

sub webdir()
{
    my $self = shift;
    my $test = shift;
    $test = $self->session unless (defined($test) && $test >= 0 && $test < $self->session);
    return $publicdir.'rig'.$self->name.'/'.$self->name.'test'.$test.'/';
}


sub lock_control()
{
    my $self = shift;
    flock($self->{'_lock_control'},LOCK_EX);
}

sub unlock_control()
{
    my $self = shift;
    flock($self->{'_lock_control'},LOCK_UN);
}

sub die($)
{
    my $self = shift;
    my $str = shift;
    if ($self->debug)
    {
	CORE::warn("\n\n Object trace\n\n");
	CORE::warn($self->print_setup."\n");
	foreach my $key ('_MULTI','_MFC','_RELAY','_SIMPLE','_WATER','_GAS','_TEMPLOG','_GASGROUP','_PSU','_AOUT','_TEMPCONTROL','_FILTER','_PID','_LOGIC','_ALERT','_ADAPTER')
	{
	    CORE::warn('****** '.$key.' ******'."\n");
	    foreach my $k (keys %{$self->{$key}})
	    {
		CORE::warn($self->{$key}{$k}->print_setup."\n");
	    }
	}
    }
    $self->SUPER::die($str);

}

sub config()
{
    my $self = shift;
    return $self->{'_config'};
}

sub begin()
{
    my $self = shift;
    if ($self->{'_transaction'})
    {
	$self->die("A new transaction can not be initiated while inside anoter transaction!");
    }
    $self->{'_config'}->begin();
    $self->{'_transaction'} = 1;
}

sub commit()
{
    my $self = shift;
    unless ($self->{'_transaction'})
    {
	$self->writedebug("Error: Attempting to commit outside a transaction!",1);
    }
    my $res = $self->{'_config'}->commit();
    $self->die($self->{'_config'}->error()) unless ($res);
    $self->{'_transaction'} = 0;
}

sub rollback()
{
    my $self = shift;
    unless ($self->{'_transaction'})
    {
	$self->writedebug("Error: Attempting to rolback outside a transaction!",1);
    }
    $self->{'_config'}->rollback();
    $self->{'_transaction'} = 0;
}

sub error()
{
    my $self = shift;
    return $self->{'_error'};
}

sub riglock()
{
    my $self = shift;
    return $self->{'_riglock'};
}

sub check_warning($)
{
    my $self = shift;
    my $type = shift;
    my $l = $self->{'_maillock'}->lock_sh_nb;
    my $count = 0;
    while (!$l && $count++ < 3)
    {
	sleep(1);
	$l = $self->{'_maillock'}->lock_sh_nb;
    }
    if ($l)
    {
	my @list = $self->{'_maillock'}->readlines;
	foreach (@list)
	{
	    next unless ($_ eq $type);
	    $self->{'_maillock'}->lock_un;
	    return 1;
	}
    }
    else
    {
	$self->writedebug("Warning! Could not lock '".$self->{'_maillock'}->filename."'",1);
	return undef;
    }
    $self->{'_maillock'}->lock_un;
    return 0;
}

sub set_warning($)
{
    my $self = shift;
    my $type = shift;
    return 0 if ($self->check_warning($type));
    my $l = $self->{'_maillock'}->lock_ex_nb;
    if ($l)
    {
	$self->{'_maillock'}->append($type);
	$self->{'_maillock'}->lock_un;
	return 1;
    }
    else
    {
	$self->writedebug("Warning! Could not exclusively lock '".$self->{'_maillock'}->filename."'",1);
	return 0;
    }
    return 0;
}

sub warning_mail($$)
{
    my $self = shift;
    my $type = shift;
    my $message = shift;
    my $subj = shift;
    chomp $message;
    return 0 unless ($self->set_warning($type));
    $self->errorlog($message,'warning_system');
    my $str = $self->get_cv('main','warning_mails');
    $str = RFC::Main::get_cv('global','system_mail_users') unless ($str);
    $str = RFC::Main::get_cv('global','errormails') unless ($str);
    $str = shift if (@_);
    $self->writedebug("Sending warning message '$message' to '$str'") if ($self->debug);
    if ($str)
    {
	foreach (split(/\s*\,\s*/,$str))
	{
	    if ($subj)
	    {
		&RFC::Main::mail($_,$message,$subj,$self->mail_from) unless ($self->disable_warning_mails());
	    }
	    else
	    {
		&RFC::Main::mail($_,$message,'Warning from '.$self,$self->mail_from) unless ($self->disable_warning_mails());
	    }
	}
    }
    ## Test if RFCfurnace is installed and a furnace run is active and email user as well ##
    my $runfile = $RFC::Header::publicdir.'rig'.$self->name().'/current_program.txt';
    if (-e $runfile)
    {
	eval {
	    my $nrfile = $RFC::Header::publicdir.'rig'.$self->name().'/furnace_run_nr.txt';
	    open FMYIN,'<',$nrfile or CORE::die "Could not open file '$nrfile' for reading $!"; 
	    my $runnr = <FMYIN>;
	    close FMYIN;
	    chomp $runnr;
	    if ($runnr =~ /(\d+)/)
	    {
		$runnr = $1;
	    }
	    else
	    {
		$runnr = 0;
	    }
	    my $file = $RFC::Header::publicdir.'rig'.$self->name().'/furnace_runs/'.$runnr.'/Proglog.txt';
	    if (-e $file)
	    {
		open FMYIN,'<',$file or CORE::die "Could not open file '$file' for reading $!";
		my $line = <FMYIN>;
		close FMYIN;
		if ($line && $line =~ /\'(\w+)\'/)
		{
		    my $rid = $1;
		    my $email = RFC::Main::passwd_client('email',$rid);
		    &RFC::Main::mail($email,$message,'Warning from '.$self,$self->mail_from) unless ($self->disable_warning_mails());
		}
	    }
	};
	if ($@)
	{
	    warn $@;
	}
    }
    return 1;
}

sub unset_warning($)
{
    my $self = shift;
    my $type = shift;
    unless ($type)
    {
	my $l = $self->{'_maillock'}->lock_ex_nb;
	if ($l)
	{
	    $self->{'_maillock'}->writeline();
	}
	else
	{
	    $self->writedebug("Warning! Could not exclusively lock '".$self->{'_maillock'}->filename."'",1);
	    return 0;	
	}
    }
    return 0 unless ($self->check_warning($type));
    my $ok = 0;
    my $l = $self->{'_maillock'}->lock_ex_nb;
    if ($l)
    {
	my @list = $self->{'_maillock'}->readlines;
	my @res = ();
	foreach (@list)
	{
	    unless ($_ eq $type)
	    {
		push @res,$_;
		next;
	    }
	    $ok = 1;
	}
	$self->{'_maillock'}->writeline(@res);
	$self->{'_maillock'}->lock_un;
	return $ok;
    }
    else
    {
	$self->writedebug("Warning! Could not exclusively lock '".$self->{'_maillock'}->filename."'",1);
	return 0;	
    }
}

sub kanaldata
{
    my $self = shift;
    if (@_)
    {
	while (@_)
	{
	    my $str = shift;
	    push @{$self->{'_kanaldata'}},$str;
	}
	return undef;
    }
    my %h = ();
    #### Remove duplicates ###
    foreach my $k (@{$self->{'_kanaldata'}})
    {
	my @l = split(/\s+/,$k);
	$h{$l[1]} = $k;
    }
    my @out = ();
    foreach my $k (sort {$a cmp $b} keys %h)
    {
	push @out,$h{$k};
    }
    return join("\t",@out);
}


sub Accept
{
    my $self = shift;
    my $visitor = shift;
    return undef if ($self->{'_seen_visitors'}{$visitor});
    $visitor->VisitComplex($self);
    foreach my $key ('_MULTI','_MFC','_RELAY','_SIMPLE','_WATER','_GAS','_TEMPLOG','_GASGROUP','_PSU','_AOUT','_TEMPCONTROL','_FILTER','_PID','_LOGIC','_ALERT','_MATH','_ADAPTER')
    {
	foreach my $k (keys %{$self->{$key}})
	{
	    $self->{$key}{$k}->Accept($visitor);
	}
    }
    $self->{'_seen_visitors'}{$visitor} = 1;
    return undef;
}

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

sub readstring()
{
    my $self = shift;
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug) if ($self->debug);
    }
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $logall = 0;
    my $test = $self->get_cv('main','logall');
    $logall = 1 if ($test && $test =~ /yes/i );
    my @arr = ();
    my $ver_in_front = $self->get_cv('main','version_in_front');
    my $vfront = 0;
    $vfront = 1 if ($ver_in_front && $ver_in_front =~ /yes/i);
    my $dummydev = RFC::BaseDevice->new('dummy',$self);
    my @t = $dummydev->get_time();
    my $t = join(':',@t);
    push @arr,join(' ','VERSION',$t,time,$RFC::Header::VERSION) if ($vfront);
    ### Notice. do not include filters, logic or math devices as they are included in the other class type lists already! ###
    ### Also exclude alert devices as the underlying device in those should already be handles                            ###
    foreach my $key ('_WATER','_TEMPLOG','_GAS','_SIMPLE','_RELAY','_GASGROUP','_AOUT','_TEMPCONTROL','_PSU','_MFC','_MULTI','_PID')
    {
	foreach my $k (sort {$a cmp $b} keys %{$self->{$key}})
	{
	    my $ignore = $self->{$key}{$k}->readstring_ignore;
	    $self->{$key}{$k}->readstring_ignore(0) if ($logall);
	    eval {
		my $str = $self->{$key}{$k}->readstring($data);
		push @arr,$str if defined($str);
	    };
	    if ($@)
	    {
		chomp $@;
		&RFC::Main::errorlog($@.' on readstring for device "'.$k.'" of type "'.$key."\" on $self");
		#### Create dummy value if device dies ###
		my $name = $self->{$key}{$k}->name;
		my @t = $dummydev->get_time;
		my $t = join(':',@t);
		my $str = join(' ',$name,$t,time,-32768);
		push @arr,$str;
		### Log errorstring in kanaldata
		$str = time . ' '. $name .' '.$@;
		$self->kanaldata($str);
	    }
	    $self->{$key}{$k}->readstring_ignore($ignore) if ($logall);
	}
    }
    push @arr,join(' ','VERSION',$t,time,$RFC::Header::VERSION) unless ($vfront);
    $self->writedebug("\n".$data->stat()) if ($self->debug > 3);
    return join(' ',@arr);
}

sub readstring_furnace()
{
    my $self = shift;
    my $data = undef;
    if (@_)
    {
        $data = $_[0];
    }
    else
    {
        $data = RFC::Cache->new();
        $data->debug($self->debug) if ($self->debug);
    }
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $logall = 0;
    my $test = $self->get_cv('main','logall');
    $logall = 1 if ($test && $test =~ /yes/i );
    my @arr = ();
    my $dummydev = RFC::BaseDevice->new('dummy',$self);
    ### Only include templog, simplechannel and tempcontrol devices ###
    foreach my $key ('_WATER','_TEMPLOG','_GAS','_SIMPLE','_RELAY','_GASGROUP','_AOUT','_TEMPCONTROL','_PSU','_MFC','_MULTI','_PID')
    {
	foreach my $k (sort {$a cmp $b} keys %{$self->{$key}})
	{
	    my $ignore = $self->{$key}{$k}->readstring_ignore;
	    $self->{$key}{$k}->readstring_ignore(0) if ($logall);
	    eval {
		my $str = $self->{$key}{$k}->readstring_furnace($data);
		if (defined($str))
		{
		    my @list = split(/\s+/,$str);
		    for (my $x = 0; $x < @list; $x += 4)
		    {
			$list[$x] = $key.'_'.$list[$x];
		    }
		    push @arr,join(' ',@list);
		}
	    };
	    if ($@)
	    {
		chomp $@;
		&RFC::Main::errorlog($@.' on readstring for device "'.$k.'" of type "'.$key."\" on $self");
		#### Create dummy value if device dies ###
		my $name = $self->{$key}{$k}->name;
		my @t = $dummydev->get_time;
		my $t = join(':',@t);
		my $str = join(' ',$key.'_'.$name,$t,time,-32768);
		push @arr,$str;
		### Log errorstring in kanaldata
		$str = time . ' '. $name .' '.$@;
		$self->kanaldata($str);
	    }
	    $self->{$key}{$k}->readstring_ignore($ignore) if ($logall);
	}
    }
    $self->writedebug("\n".$data->stat()) if ($self->debug > 3);
    return join(' ',@arr);
}


sub list_sections
{
    my $self = shift;
    my @list = $self->{'_config'}->get_sections();
    if (@_)
    {
	my $name = shift;
	my @l = ();
	foreach my $item (@list)
	{
	    if ($item =~ /^$name(\w+)/)
	    {
		push @l,$1;
	    }
	}
	@list = @l;
    }
    return () unless (@list);
    return sort {$a cmp $b} @list;
}


sub avail_filter_type($)
{
    my $self = shift;
    my $type = shift;
    return () unless ($type);
    my @list = ();
    foreach my $name ($self->list_sections('filter'))
    {
	my $c = $self->get_cv('filter'.$name,'class');
	my $t = $self->get_cv('filter'.$name,'device_type');
	if ($c && $c eq 'Typecast')
	{
	    $t = $self->get_cv('filter'.$name,'output_type');
	    $t = 'gas' unless ($t);
	}
	elsif ($c && $c eq 'Constant')
	{
	    $t = $self->get_cv('filter'.$name,'output_type');
	    $t = 'gas' unless ($t);
	}
	else
	{
	    $t = 'simplechannel' unless ($t);
	}
	my $n = $name;
	$n =~ s/^_//;
	if ($type eq $t)
	{
	    push @list,$n;
	    next;
	}
	push @list,$n if ($type eq 'relay' && $c && $c eq 'Schmidttrigger');
    }
    return @list;
}

sub Adapters()
{
    my $self = shift;
    return keys %{$self->{'_ADAPTER'}};
}

sub Adapter($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_ADAPTER'}{$name} if (exists($self->{'_ADAPTER'}{$name}));
    return undef;
}

sub avaliable_Adapters()
{
    my $self = shift;
    my @list = $self->avail_filter_type('Adapter');
    push @list,$self->list_sections('Adapter_');
    return @list;
}

sub avaliable_Adapters_nofilter()
{
    my $self = shift;
    my @list = ();
    push @list,$self->list_sections('Adapter_');
    return @list;
}

sub register_Adapter($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->Logics)
    {
	$self->die('Error: Duplicate Adapter '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_ADAPTER'}{$device->name} = $device;
    return $device;
}

sub Maths()
{
    my $self = shift;
    return keys %{$self->{'_MATH'}};
}

sub Math($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_MATH'}{$name} if (exists($self->{'_MATH'}{$name}));
    return undef;
}

sub avaliable_Maths()
{
    my $self = shift;
    my @list = $self->avail_filter_type('math');
    push @list,$self->list_sections('Math_');
    return @list;
}

sub avaliable_Maths_nofilter()
{
    my $self = shift;
    my @list = ();
    push @list,$self->list_sections('Math_');
    return @list;
}

sub register_Math($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->Logics)
    {
	$self->die('Error: Duplicate arithmetic '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_MATH'}{$device->name} = $device;
    return $device;
}

sub Logics()
{
    my $self = shift;
    return keys %{$self->{'_LOGIC'}};
}

sub Logic($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_LOGIC'}{$name} if (exists($self->{'_LOGIC'}{$name}));
    return undef;
}

sub avaliable_Logics()
{
    my $self = shift;
    my @list = $self->avail_filter_type('logic');
    push @list,$self->list_sections('Logic_');
    return @list;
}

sub avaliable_Logics_nofilter()
{
    my $self = shift;
    my @list = ();
    push @list,$self->list_sections('Logic_');
    return @list;
}

sub register_Logic($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->Logics)
    {
	$self->die('Error: Duplicate Logic '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_LOGIC'}{$device->name} = $device;
    return $device;
}

sub Alerts()
{
    my $self = shift;
    return keys %{$self->{'_ALERT'}};
}

sub Alert($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_ALERT'}{$name} if (exists($self->{'_ALERT'}{$name}));
    return undef;
}

sub avaliable_Alerts()
{
    my $self = shift;
    my @list = $self->avail_filter_type('Alert');
    push @list,$self->list_sections('Alert_');
    return @list;
}

sub avaliable_Alerts_nofilter()
{
    my $self = shift;
    my @list = ();
    push @list,$self->list_sections('Alert_');
    return @list;
}

sub register_Alert($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->Alerts)
    {
	$self->die('Error: Duplicate Alert '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_ALERT'}{$device->name} = $device;
    return $device;
}

sub PIDs()
{
    my $self = shift;
    return keys %{$self->{'_PID'}};
}

sub PID($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_PID'}{$name} if (exists($self->{'_PID'}{$name}));
    return undef;
}

sub avaliable_PIDs()
{
    my $self = shift;
    my @list = $self->avail_filter_type('PID');
    push @list,$self->list_sections('PID_');
    return @list;
}

sub avaliable_PIDs_nofilter()
{
    my $self = shift;
    my @list = ();
    push @list,$self->list_sections('PID_');
    return @list;
}

sub register_PID($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->PIDs)
    {
	$self->die('Error: Duplicate PID '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_PID'}{$device->name} = $device;
    return $device;
}

sub simplechannels()
{
    my $self = shift;
    return keys %{$self->{'_SIMPLE'}};
}

sub simplechannel($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_SIMPLE'}{$name} if (exists($self->{'_SIMPLE'}{$name}));
    return undef;
}

sub avaliable_simplechannels()
{
    my $self = shift;
    my @list = $self->avail_filter_type('simplechannel');
    push @list,$self->list_sections('channel_');
    return @list;
}

sub avaliable_simplechannels_nofilter()
{
    my $self = shift;
    my @list = ();
    push @list,$self->list_sections('channel_');
    return @list;
}

sub register_simplechannel($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->simplechannels)
    {
	$self->die('Error: Duplicate simplechannel '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_SIMPLE'}{$device->name} = $device;
    return $device;
}

sub filters()
{
    my $self = shift;
    return keys %{$self->{'_FILTER'}};
}

sub filter()
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_FILTER'}{$name} if (exists($self->{'_FILTER'}{$name}));
    return undef;
}

sub avaliable_filters()
{
    my $self = shift;
    return $self->list_sections('filter_');
}

sub register_filter($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->filters)
    {
	$self->die('Error: Duplicate filter '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_FILTER'}{$device->name} = $device;
    return $device;
}

sub relays()
{
    my $self = shift;
    return keys %{$self->{'_RELAY'}};
}

sub relay($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_RELAY'}{$name} if (exists($self->{'_RELAY'}{$name}));
    return undef;
}

sub avaliable_relays()
{
    my $self = shift;
    my @list = $self->avail_filter_type('relay');
    push @list, $self->list_sections('relay_');
    return @list;
}

sub avaliable_relays_nofilter()
{
    my $self = shift;
    return $self->list_sections('relay_');
}

sub register_relay($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->relays)
    {
	$self->die('Error: Duplicate relay '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_RELAY'}{$device->name} = $device;
    return $device;
}

sub gasses()
{
    my $self = shift;
    return keys %{$self->{'_GAS'}};
}

sub gas($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_GAS'}{$name} if (exists($self->{'_GAS'}{$name}));
    ### Also include gas groups in gasses ###
    return $self->{'_GASGROUP'}{$name} if (exists($self->{'_GASGROUP'}{$name}));    
    return undef;
}

sub avaliable_gasses()
{
    my $self = shift;
    my @list = $self->list_sections('gas_');
    my @l = $self->avail_filter_type('gas');
    foreach (@list)
    {
	next if (/group_/);
	next if (/multiplexer_/);
	push @l,$_;
    }
    push @l,$self->avaliable_gasgroups();
    return @l;
}

sub avaliable_gasses_nofilter()
{
    my $self = shift;
    my @list = $self->list_sections('gas_');
    my @l = ();
    foreach (@list)
    {
	next if (/group_/);
	next if (/multiplexer_/);
	push @l,$_;
    }
    return @l;
}

sub register_gas($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->gasses)
    {
	$self->die('Error: Duplicate gas '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_GAS'}{$device->name} = $device;
    return $device;
}

sub gasgroups()
{
    my $self = shift;
    return keys %{$self->{'_GASGROUP'}};
}

sub gasgroup($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_GASGROUP'}{$name} if (exists($self->{'_GASGROUP'}{$name}));
    return undef;
}

sub avaliable_gasgroups()
{
    my $self = shift;
    my @list = $self->avail_filter_type('gas_group');
    push @list, $self->list_sections('gas_group_');
    return @list;
}

sub avaliable_gasgroups_nofilter()
{
    my $self = shift;
    return $self->list_sections('gas_group_');
}

sub register_gasgroup($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->gasgroups)
    {
	$self->die('Error: Duplicate gas group '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_GASGROUP'}{$device->name} = $device;
    return $device;
}

sub MFCs()
{
    my $self = shift;
    return keys %{$self->{'_MFC'}};
}

sub MFC($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_MFC'}{$name} if (exists($self->{'_MFC'}{$name}));
    return undef;
}

sub avaliable_MFCs()
{
    my $self = shift;
    my @list = $self->avail_filter_type('MFC');
    push @list, $self->list_sections('controler_');
    return @list;
}

sub avaliable_MFCs_nofilter()
{
    my $self = shift;
    return $self->list_sections('controler_');
}

sub register_MFC($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->MFCs)
    {
	$self->die('Error: Duplicate MFC '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_MFC'}{$device->name} = $device;
    return $device
}

sub multiplexers()
{
    my $self = shift;
    return keys %{$self->{'_MULTI'}};
}

sub multiplex($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_MULTI'}{$name} if (exists($self->{'_MULTI'}{$name}));
    return undef;
}

sub avaliable_multiplexers()
{
    my $self = shift;
    my @list = $self->avail_filter_type('multiplex');
    push @list, $self->list_sections('gas_multiplexer_');
    return @list;
}

sub avaliable_multiplexers_nofilter()
{
    my $self = shift;
    return $self->list_sections('gas_multiplexer_');
}

sub register_multiplex($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->multiplexers)
    {
	$self->die('Error: Duplicate gas multiplexer '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_MULTI'}{$device->name} = $device;
    return $device
}

sub waters()
{
    my $self = shift;
    return keys %{$self->{'_WATER'}};
}

sub water($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_WATER'}{$name} if (exists($self->{'_WATER'}{$name}));
    return undef;
}

sub avaliable_waters()
{
    my $self = shift;
    my @list = $self->avail_filter_type('water');
    push @list, $self->list_sections('water_');
    return @list;
}

sub avaliable_waters_nofilter()
{
    my $self = shift;
    return $self->list_sections('water_');
}

sub register_water($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->waters)
    {
	$self->die('Error: Duplicate water bubler '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_WATER'}{$device->name} = $device;
    return $device;
}

sub PSUs()
{
    my $self = shift;
    return keys %{$self->{'_PSU'}};
}

sub PSU($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_PSU'}{$name} if (exists($self->{'_PSU'}{$name}));
    return undef;
}

sub avaliable_PSUs()
{
    my $self = shift;
    my @list = $self->avail_filter_type('PSU');
    push @list, $self->list_sections('PSU_');
    return @list;
}

sub avaliable_PSUs_nofilter()
{
    my $self = shift;
    return $self->list_sections('PSU_');
}

sub register_PSU($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->PSUs)
    {
	$self->die('Error: Duplicate PSU '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_PSU'}{$device->name} = $device;
    return $device;
}

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

sub templogs()
{
    my $self = shift;
    return $self->temps();
}

sub avaliable_templogs()
{
    my $self = shift;
    return $self->avaliable_temps();
}

sub avaliable_templogs_nofilter()
{
    my $self = shift;
    return $self->avaliable_temps_nofilter();
}

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

sub temps()
{
    my $self = shift;
    return keys %{$self->{'_TEMPLOG'}};
}


sub temp($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_TEMPLOG'}{$name} if (exists($self->{'_TEMPLOG'}{$name}));
    return undef;
}

sub avaliable_temps()
{
    my $self = shift;
    my @list = $self->avail_filter_type('templog');
    push @list, $self->list_sections('temp_');
    return @list;
}

sub avaliable_temps_nofilter()
{
    my $self = shift;
    return $self->list_sections('temp_');
}

sub register_temp($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->temps)
    {
	$self->die('Error: Duplicate temperature device '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_TEMPLOG'}{$device->name} = $device;
    return $device;
}

sub tempcontrols()
{
    my $self = shift;
    return keys %{$self->{'_TEMPCONTROL'}};
}

sub tempcontrol($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_TEMPCONTROL'}{$name} if (exists($self->{'_TEMPCONTROL'}{$name}));
    return undef;
}

sub avaliable_tempcontrols()
{
    my $self = shift;
    my @list = $self->avail_filter_type('tempcontrol');
    push @list, $self->list_sections('TControl_');
    return @list;
}

sub avaliable_tempcontrols_nofilter()
{
    my $self = shift;
    return $self->list_sections('TControl_');
}

sub register_tempcontrol($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->tempcontrols)
    {
	$self->die('Error: Duplicate temperature controler '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_TEMPCONTROL'}{$device->name} = $device;
    return $device;
}

sub analog($)
{
    my $self = shift;
    my $name = shift;
    return undef unless defined($name);
    return $self->{'_AOUT'}{$name} if (exists($self->{'_AOUT'}{$name}));
    return undef;
}

sub analogs()
{
    my $self = shift;
    return keys %{$self->{'_AOUT'}};
}

sub avaliable_analogs()
{
    my $self = shift;
    my @list = $self->avail_filter_type('analog');
    push @list, $self->list_sections('analog_out_');
    return @list;
}

sub avaliable_analogs_nofilter()
{
    my $self = shift;
    return $self->list_sections('analog_out_');
}

sub register_analog($)
{
    my $self = shift;
    my $device = shift;
    foreach ($self->analogs)
    {
	$self->die('Error: Duplicate analog output '.$device->name." attempted!\n") if ($device->name eq $_);
    }
    $self->{'_AOUT'}{$device->name} = $device;
    return $device;
}



sub modtime($)
{
    my $self = shift;
    my $session = $self->session;
    if (@_)
    {
	$session = shift if (@_);
	return $self->{'_config_old'}[$session]->modtime;	
    }
    else
    {
	return $self->{'_config'}->modtime();
    }
}

sub set_debug
{
    my $self = shift;
    my $level = shift;
    my $v = RFC::DebugVisitor->new($level);
    $self->Accept($v);
    return $v->result();
}

sub debug()
{
    my $self = shift;
    $self->SUPER::debug(@_);
    if (@_)
    {
        #### Pass on debug level to all objects honoring this ###
        foreach my $i (@{$self->{'_config_old'}})
        {
            $i->debug($self->{'_debug'}) if ($i && ref($i));
        }
        $self->{'_config'}->debug($self->{'_debug'}) if $self->{'_config'};
        $self->{'_info'}->debug($self->{'_debug'}) if $self->{'_info'};
        $self->{'_trace'}->debug($self->{'_debug'}) if $self->{'_trace'};
        $self->{'_maillock'}->debug($self->{'_debug'}) if $self->{'_maillock'};
        $self->{'_userlog'}->debug($self->{'_debug'}) if $self->{'_userlog'};
	$self->{'_proglog'}->debug($self->{'_debug'}) if $self->{'_proglog'};
    }
    return $self->{'_debug'};
}

sub info
{
    my $self = shift;
    if (@_)
    {
	my $l = $self->{'_info'}->lock_ex_nb();
	unless ($l)
	{
	    sleep(1);
	    $l = $self->{'_info'}->lock_ex_nb();
	}
	if ($l)
	{
	    $self->{'_info'}->append(@_);
	    $self->{'_info'}->lock_un();
	}
	else
	{
	    warn "Could not lock info file for writing! Message '".join("\n",@_)."' Could not be appended!\n";
	}
    }
    my $res = '';
    my $l = $self->{'_info'}->lock_sh_nb();
    unless ($l)
    {
	sleep(1);
	$l = $self->{'_info'}->lock_sh_nb();
    }
    if ($l)
    {
	$res = join("\n",$self->{'_info'}->readlines);
	$self->{'_info'}->lock_un();
    }
    return $res;
}

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

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

sub device_sectionname($)
{
    my $self = shift;
    my $type = shift;
    return undef unless ($type);
    return $self->{'_sectionnames'}{$type} if (exists($self->{'_sectionnames'}{$type}));
    return undef;
}

sub get_list_config($$)
{
    ### Deprecated, do not use ###
    my $self = shift;
    my $section = shift;
    my $key = shift;
    return ($self->get_cv($section,$key));
}

sub get_uiname($)
{
    my $self = shift;
    my $type = shift;
    return '' unless ($type);
    return $self->{'_uinames'}{$type} if (exists($self->{'_uinames'}{$type}));
    return '';
}

sub list_names($)
{
    my $self = shift;
    my $type = shift;
    return undef unless ($type);
    return ($self->get_cv('main','simple_channel_names')) if ($type eq 'simplechannel');
    return ($self->get_cv('main','relay_names')) if ($type eq 'relay');
    return ($self->get_cv('main','temp_names')) if ($type eq 'templog');
    return ($self->get_cv('main','temperature_control_names')) if ($type eq 'tempcontrol');
    return ($self->get_cv('main','automatic_flowcontrolers')) if ($type eq 'MFC');
    return ($self->get_cv('main','water_names')) if ($type eq 'water');
    return ($self->get_cv('main','gas_names')) if ($type eq 'gas');
    return ($self->get_cv('main','gas_group_names')) if ($type eq 'gasgroup');
    return ($self->get_cv('main','PSU_names')) if ($type eq 'PSU');
    return ($self->get_cv('main','analog_controlers')) if ($type eq 'analog');
    return ($self->get_cv('main','gas_multiplexers')) if ($type eq 'multiplex');
    return ($self->get_cv('main','filter_names')) if ($type eq 'filter');
    return ($self->get_cv('main','logic_names')) if ($type eq 'logic');
    return ($self->get_cv('main','math_names')) if ($type eq 'math');
    return ($self->get_cv('main','PID_names')) if ($type eq 'PID');
    return ($self->get_cv('main','Alert_names')) if ($type eq 'Alert');
    return ($self->get_cv('main','Adapter_names')) if ($type eq 'Adapter');
    return ();
}

sub list_names_tag($)
{
    my $self = shift;
    my $type = shift;
    return undef unless ($type);
    return 'simple_channel_names' if ($type eq 'simplechannel');
    return 'relay_names' if ($type eq 'relay');
    return 'temp_names' if ($type eq 'templog');
    return 'temperature_control_names' if ($type eq 'tempcontrol');
    return 'automatic_flowcontrolers' if ($type eq 'MFC');
    return 'water_names' if ($type eq 'water');
    return 'gas_names' if ($type eq 'gas');
    return 'gas_group_names' if ($type eq 'gasgroup');
    return 'PSU_names' if ($type eq 'PSU');
    return 'analog_controlers' if ($type eq 'analog');
    return 'gas_multiplexers' if ($type eq 'multiplex');
    return 'filter_names' if ($type eq 'filter');
    return 'logic_names' if ($type eq 'logic');
    return 'math_names' if ($type eq 'math');
    return 'PID_names' if ($type eq 'PID');
    return 'Alert_names' if ($type eq 'Alert');
    return 'Adapter_names' if ($type eq 'Adapter');
    return undef;
}


sub delete_device($$)
{
    my $self = shift;
    my $type = shift;
    my $name = shift;
    my $dev = $self->get_device($type,$name);
    return undef unless ($dev);
    my $ref = ref($dev);
    foreach my $key ('_MULTI','_MFC','_RELAY','_SIMPLE','_WATER','_GAS','_TEMPLOG','_GASGROUP','_PSU','_AOUT','_TEMPCONTROL','_FILTER','_PID','_LOGIC','_ALERT','_MATH','_ADAPTER')
    {
	foreach my $k (keys %{$self->{$key}})
	{
	    delete($self->{$key}{$k}) if ($self->{$key}{$k} && ref($self->{$key}{$k}) eq $ref);
	}
    };
    return undef;
}

sub get_device($$)
{ 
    my $self = shift;
    my $type = shift;
    my $name = shift;
    return undef unless ($type && $name);
    return $self->simplechannel($name) if ($type eq 'simplechannel');
    return $self->relay($name) if ($type eq 'relay');
    return $self->temp($name) if ($type eq 'templog');
    return $self->tempcontrol($name) if ($type eq 'tempcontrol');
    return $self->MFC($name) if ($type eq 'MFC');
    return $self->water($name) if ($type eq 'water');
    return $self->gas($name) if ($type eq 'gas');
    return $self->gasgroup($name) if ($type eq 'gasgroup');
    return $self->PSU($name) if ($type eq 'PSU');
    return $self->analog($name) if ($type eq 'analog');
    return $self->multiplex($name) if ($type eq 'multiplex');
    return $self->filter($name) if ($type eq 'filter');
    return $self->Logic($name) if ($type eq 'logic');
    return $self->Math($name) if ($type eq 'math');
    return $self->PID($name) if ($type eq 'PID');
    return $self->Alert($name) if ($type eq 'Alert');
    return $self->Adapter($name) if ($type eq 'Adapter');
    return undef;
}

sub register_device($$)
{
    my $self = shift;
    my $type = shift;
    my $name = shift;
    return undef unless ($type && $name);
    return $self->register_simplechannel($name) if ($type eq 'simplechannel');
    return $self->register_relay($name) if ($type eq 'relay');
    return $self->register_temp($name) if ($type eq 'templog');
    return $self->register_tempcontrol($name) if ($type eq 'tempcontrol');
    return $self->register_MFC($name) if ($type eq 'MFC');
    return $self->register_water($name) if ($type eq 'water');
    return $self->register_gas($name) if ($type eq 'gas');
    return $self->register_gasgroup($name) if ($type eq 'gasgroup');
    return $self->register_PSU($name) if ($type eq 'PSU');
    return $self->register_analog($name) if ($type eq 'analog');
    return $self->register_multiplex($name) if ($type eq 'multiplex');
    return $self->register_filter($name) if ($type eq 'filter');
    return $self->register_Logic($name) if ($type eq 'logic');
    return $self->register_Math($name) if ($type eq 'math');
    return $self->register_PID($name) if ($type eq 'PID');
    return $self->register_Alert($name) if ($type eq 'Alert');
    return $self->register_Adapter($name) if ($type eq 'Adapter');
    return undef;
}

sub get_device_control($$)
{
    my $self = shift;
    my $type = shift;
    my $name = shift;
    return undef unless ($type && $name);
    my $dev = $self->get_device($type,$name);
    return $dev if ($dev && !$dev->readonly && !$dev->readstring_ignore);
    return undef;
}

sub list_devices($)
{
    my $self = shift;
    my $type = shift;
    return undef unless ($type);
    return $self->simplechannels() if ($type eq 'simplechannel');
    return $self->relays() if ($type eq 'relay');
    return $self->temps() if ($type eq 'templog');
    return $self->tempcontrols() if ($type eq 'tempcontrol');
    return $self->MFCs() if ($type eq 'MFC');
    return $self->waters() if ($type eq 'water');
    return $self->gasses() if ($type eq 'gas');
    return $self->gasgroups() if ($type eq 'gasgroup');
    return $self->PSUs() if ($type eq 'PSU');
    return $self->analogs() if ($type eq 'analog');
    return $self->multiplexers() if ($type eq 'multiplex');
    return $self->filters() if ($type eq 'filter');
    return $self->Logics() if ($type eq 'logic');
    return $self->Maths() if ($type eq 'math');
    return $self->PIDs() if ($type eq 'PID');
    return $self->Alerts() if ($type eq 'Alert');
    return $self->Adapters() if ($type eq 'Adapter');
    return undef;
}

sub list_devices_subtype($$)
{
    my $self = shift;
    my $type = shift;
    my $subtype = shift;
    return undef unless ($type && $subtype);
    my @list = ();
    foreach my $d ($self->list_devices($type))
    {
	my $dev = $self->get_deivce($type,$d);
	next unless ($dev && $dev->type eq $subtype);
	push @list,$d;
    }
    return @list;
}


sub list_devices_control($)
{
    my $self = shift;
    my $type = shift;
    return undef unless ($type);
    my @list = $self->list_devices($type);
    my @res = ();
    foreach my $n (@list)
    {
	my $dev = $self->get_device($type,$n);
	if ($dev && !$dev->readonly)
	{
	    push @res,$n;
	    next;
	}
	if ($dev && ref($dev) =~ /Adapter/ && !$dev->readonly)
	{
	    push @res,$n;
	    next;	    
	}
	push @res,$n if ($type eq 'tempcontrol' && $n eq 'temperature');
	push @res,$n if ($type eq 'PSU' && $n eq 'current');
	push @res,$n if ($type eq 'multiplex');
    }
    return @res;
}

sub list_devices_control_subtype($$)
{
    my $self = shift;
    my $type = shift;
    my $subtype = shift;
    return undef unless ($type && $subtype);
    my @list = ();
    foreach my $d ($self->list_devices_control($type))
    {
	my $dev = $self->get_deivce($type,$d);
	next unless ($dev && $dev->type eq $subtype);
	push @list,$d;
    }
    return @list;
}


sub avaliable_devices($)
{
    my $self = shift;
    my $type = shift;
    return undef unless ($type);
    return $self->avaliable_simplechannels() if ($type eq 'simplechannel');
    return $self->avaliable_relays() if ($type eq 'relay');
    return $self->avaliable_temps() if ($type eq 'templog');
    if ($type eq 'tempcontrol')
    {
	my @list = $self->avaliable_tempcontrols();
	return @list if (@list);
	return 'temperature' if ($self->config->section_exists('temperature'));
    }
    return $self->avaliable_MFCs() if ($type eq 'MFC');
    return $self->avaliable_waters() if ($type eq 'water');
    return $self->avaliable_gasses() if ($type eq 'gas');
    return $self->avaliable_gasgroups() if ($type eq 'gasgroup');
    if ($type eq 'PSU')
    {
	my @list = $self->avaliable_PSUs();
	return @list if (@list);
	return 'current' if ($self->config->section_exists('current'));
    }
    return $self->avaliable_analogs() if ($type eq 'analog');
    return $self->avaliable_multiplexers() if ($type eq 'multiplex');
    return $self->avaliable_filters() if ($type eq 'filter');
    return $self->avaliable_Logics() if ($type eq 'logic');
    return $self->avaliable_Maths() if ($type eq 'math');
    return $self->avaliable_PIDs() if ($type eq 'PID');
    return $self->avaliable_Alerts() if ($type eq 'Alert');
    return $self->avaliable_Adapters() if ($type eq 'Adapter');
    return undef;
}


sub avaliable_devices_nofilter($)
{
    my $self = shift;
    my $type = shift;
    return undef unless ($type);
    return $self->avaliable_simplechannels_nofilter() if ($type eq 'simplechannel');
    return $self->avaliable_relays_nofilter() if ($type eq 'relay');
    return $self->avaliable_temps_nofilter() if ($type eq 'templog');
    if ($type eq 'tempcontrol')
    {
	my @list = $self->avaliable_tempcontrols_nofilter();
	return @list if (@list);
	return 'temperature' if ($self->config->section_exists('temperature'));
    }
    return $self->avaliable_MFCs_nofilter() if ($type eq 'MFC');
    return $self->avaliable_waters_nofilter() if ($type eq 'water');
    return $self->avaliable_gasses_nofilter() if ($type eq 'gas');
    return $self->avaliable_gasgroups_nofilter() if ($type eq 'gasgroup');
    if ($type eq 'PSU')
    {
	my @list = $self->avaliable_PSUs_nofilter();
	return @list if (@list);
	return 'current' if ($self->config->section_exists('current'));
    }
    return $self->avaliable_analogs_nofilter() if ($type eq 'analog');
    return $self->avaliable_multiplexers_nofilter() if ($type eq 'multiplex');
    return $self->avaliable_filters() if ($type eq 'filter');
    return $self->avaliable_Logics() if ($type eq 'logic');
    return $self->avaliable_Maths() if ($type eq 'math');
    return $self->avaliable_PIDs() if ($type eq 'PID');
    return $self->avaliable_Alerts() if ($type eq 'Alert');
    return $self->avaliable_Adapters() if ($type eq 'Adapter');
    return undef;
}

sub DESTROY
{
    my $self = shift;
    $self->store_cache();
    if ($self->{'_backup'})
    {
	$self->writedebug("Implicitly issuing rollback for incomplete transaction",1);
	$self->rollback;
    }
    ## Below part is needed to force all fiel handles to be closed.....                   ###
    ## needed to make sure that data are stored in devices! (Perl WTF garbage collector!) ### 
    foreach my $key ('_MULTI','_MFC','_RELAY','_SIMPLE','_WATER','_GAS','_TEMPLOG','_GASGROUP','_PSU','_AOUT','_TEMPCONTROL','_FILTER','_PID','_LOGIC','_ALERT','_MATH','_ADAPTER')
    {
	### Force destructors in child devices to awoid the Perl garbage collector to mess things up.... ###
	foreach my $k (keys %{$self->{$key}})
	{
	    $self->{$key}{$k}->DESTROY() if ($self->{$key}{$k});
	}
    }
    for my $x (0..$self->session)
    {
	$self->{'_config_old'}[$x]->DESTROY if ($self->{'_config_old'}[$x] && ref($self->{'_config_old'}[$x]));
    }
    foreach my $item ('_maillock','_info','_trace','_proglog','_userlog','_errlog','_cache_file','_iv_in_progress','_config')
    {
	$self->{$item}->DESTROY if ($self->{$item});
    }
    CORE::close($self->{'_lock_control'});
    return;
}


sub init()
{
    my $self = shift;
    $self->{'_kanaldata'} = [];
    $self->{'_TEMPLOG'} = {};
    $self->{'_TEMPCONTROL'} = {};
    $self->{'_GAS'} = {};
    $self->{'_GASGROUP'} = {};
    $self->{'_MFC'} = {};
    $self->{'_WATER'} = {};
    $self->{'_SIMPLE'} = {};
    $self->{'_RELAY'} = {};
    $self->{'_PSU'} = {};
    $self->{'_MULTI'} = {};
    $self->{'_AOUT'} = {};
    $self->{'_FILTER'} = {};
    $self->{'_PID'} = {};
    $self->{'_LOGIC'} = {};
    $self->{'_MATH'} = {};
    $self->{'_ALERT'} = {};
    $self->{'_ADAPTER'} = {};
    $self->{'_error'} = '';
    $self->load_session_nr;
    $self->create_dirs;
    my $file = '/home/celltest/Gas_rig'.$self->name.'.lock';
    unless (-e $file)
    {
	sysopen(FH, $file, O_WRONLY | O_CREAT) or CORE::die "Error: Could not open $file $!";
        chmod 0666, $file;
	CORE::close FH;
    }
    unless (defined($self->{'_oldsession'}) && $self->session == $self->{'_oldsession'})
    {
	$self->die("Initialisation attempted for new session inside a transaction!") if ($self->{'_transaction'});
	$self->{'_config'} = ElchemeaConfig->new($publicdir.'rig'.$self->name.'/configfile',$self->{'_configlock'}); 
	$self->{'_config'}->debug($self->{'_debug'});
	$self->{'_config_old'} = undef;
	for my $x (0..$self->session)
	{
	    my $fn = $publicdir.'rig'.$self->name.'/'.$self->name.'test'.$x.'/configfile';
	    if (-e $fn)
	    {
		### Only store filename and delay ElchemeaConfig initialisation to the config is actually needed ###
		### As in most cases old config values are normally only needed for reporting purposes and not   ###
		### for normal data aquisition or process control                                                ###
		### This sppeds rig initialisation up ad awoid having a number of unnescesarry open file handles ###
		### (As each ElchemeaConfig instance opens the lock file for locking tests as part of the        ###
		### constructor                                                                                  ###
		$self->{'_config_old'}[$x] = $publicdir.'rig'.$self->name.'/'.$self->name.'test'.$x.'/configfile';
	    }
	    else
	    {
		## Use current configuration if no old one found ###
		$self->{'_config_old'}[$x] = $self->{'_config'};
	    }
	}
    }
    $file = $self->homedir.'/maillock.txt';
    unless (-e $file)
    {
	sysopen(FH, $file, O_WRONLY | O_CREAT) or CORE::die "Error: Could not open $file $!";
        chmod 0666, $file;
	CORE::close FH;
    }    
    $self->{'_maillock'} = SemaforeFile->new($file,$self->{'_riglock'});
    $self->{'_hometest'} = $userdir.'rig'.$self->name.'/'.$self->name.'test'.$self->session.'/';
    $self->{'_maillock'}->debug($self->{'_debug'});
    $file = $self->{'_webtest'}.'info.txt';
    unless (-e $file)
    {
	sysopen(FH, $file, O_WRONLY | O_CREAT) or CORE::die "Error: Could not open $file $!";
        chmod 0666, $file;
	CORE::close FH;
    }
    $self->{'_info'} = SemaforeFile->new($file,$self->{'_riglock'});
    $self->{'_info'}->debug($self->{'_debug'});
    $self->{'_trace'} = SemaforeFile->new($self->{'_webtest'}.'tracelog.txt',$self->{'_tracelock'});
    $self->{'_trace'}->debug($self->{'_debug'});
    $self->writedebug("Initialising user '$self->{'_name'}' configuration") if ($self->debug);
    $self->{'_proglog'} = SemaforeFile->new($self->{'_webtest'}.'proglog',$self->{'_riglock'});
    $self->{'_proglog'}->debug($self->{'_debug'});
    $self->{'_userlog'} = SemaforeFile->new($self->{'_webtest'}.'userlog',$self->{'_tracelock'});
    $self->{'_userlog'}->debug($self->{'_debug'});
    $self->{'_errlog'} = SemaforeFile->new($self->{'_webtest'}.'errorlog',$self->{'_tracelock'});
    $self->{'_errlog'}->debug($self->{'_debug'});
    $self->{'_modtime'} = $self->modtime();
    my $ignore = $self->get_cv('main','disable_warning_mails');
    if ($ignore && $ignore =~ /yes/i)
    {
	$self->disable_warning_mails(1);
    }
    ### Initialise all filter devices      ####
    foreach my $name ($self->get_cv('main','filter_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'filter device '.$name;
	$self->init_filter($name);
    }
    ### Initialise all filter logic      ####
    foreach my $name ($self->get_cv('main','logic_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'logic device '.$name;
	$self->init_logic($name);
    }
    ### Initialise all math logic      ####
    foreach my $name ($self->get_cv('main','math_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'math device '.$name;
	$self->init_math($name);
    }
    ### Start by initialise simple devices ####
    foreach my $name ($self->get_cv('main','analog_controlers'))
    {
	next unless ($name);
	$self->{'_error'} = 'Analog output '.$name;
	if ($self->{'_AOUT'}{$name})
	{
	    $self->{'_AOUT'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_analog($name);
	}
    }
    foreach my $name ($self->get_cv('main','relay_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'Relay '.$name;
	if ($self->{'_RELAY'}{$name})
	{
	    $self->{'_RELAY'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_relay($name);
	}
    }
    foreach my $name ($self->get_cv('main','simple_channel_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'Simple channel '.$name;
	if ($self->{'_SIMPLE'}{$name})
	{
	    $self->{'_SIMPLE'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_simplechannel($name);
	}
    }
    foreach my $name ($self->get_cv('main','PSU_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'PSU '.$name;
	### Skip initialisation for already initialised devices ###
	if ($self->{'_PSU'}{$name})
	{
	    $self->{'_PSU'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_PSU($name);
	}
    }
    #### Assign a single default Delta SM-15-100 if no PSU lables found for backwards compatibility ###
    ## Only included for backwards compatibility, and in that case readstring_ignore has to be set  ###
    unless (($self->get_cv('main','PSU_names')))
    {
	$self->{'_error'} = 'PSU current ';
	if ($self->{'_config'}->section_exists('current'))
	{
	    unless (exists($self->{'_PSU'}{'current'}))
	    {
		my $dev = $self->new_PSU('current','DefaultDelta'); 
		$self->register_PSU($dev);
		$dev->readstring_ignore(1) if ($dev);
	    }
	}
    }
    ### Then initialise complex devices which may include simple devices implicitly or explictly ###
    foreach my $name ($self->get_cv('main','gas_multiplexers'))
    {
	next unless ($name);
	$self->{'_error'} = 'Multiplex '.$name;
	if ($self->{'_MULTI'}{$name})
	{
	    $self->{'_MULTI'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_multiplex($name);
	}
    }
    foreach my $name ($self->get_cv('main','automatic_flowcontrolers'))
    {
	next unless ($name);
	$self->{'_error'} = 'MFC '.$name;
	if ($self->{'_MFC'}{$name})
	{
	    $self->{'_MFC'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_MFC($name);
	}
    }
    foreach my $name ($self->get_cv('main','temperature_control_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'Temperature controler '.$name;
	if ($self->{'_TEMPCONTROL'}{$name})
	{
	    $self->{'_TEMPCONTROL'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_tempcontrol($name);
	}
    }
    ## Assign a single temperature controler using section 'temperature' if no labels found ###
    ## Only included for backwards compatibility, and in that case readstring_ignore has to ###
    ## be set                                                                               ###
    unless (($self->get_cv('main','temperature_control_names')))
    {
	$self->{'_error'} = 'Temperature controler temperature ';
	if ($self->{'_config'}->section_exists('temperature'))
	{
	    my $dev = RFC::Device::new_TEMP($self,'temperature');
            $self->register_tempcontrol($dev);
	    $dev->readstring_ignore(1);
	}
    }
    foreach my $name ($self->get_cv('main','gas_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'Gas '.$name;
	### Skip initialisation for already initialised devices ###
	if ($self->{'_GAS'}{$name})
	{
	    $self->{'_GAS'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_gas($name);
	}
    }
    foreach my $name ($self->get_cv('main','temp_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'Temperature log '.$name;
	if ($self->{'_TEMPLOG'}{$name})
	{
	    $self->{'_REMPLOG'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_temp($name);
	}
    }
    foreach my $name ($self->get_cv('main','water_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'Water '.$name;
	if ($self->{'_WATER'}{$name})
	{
	    $self->{'_WATER'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_water($name);
	}
    }
    foreach my $name ($self->get_cv('main','gas_group_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'Gas group '.$name;
	if ($self->{'_GASGROUP'}{$name})
	{
	    $self->{'_GASGROUP'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_gasgroup($name);
	}
    }
    foreach my $name ($self->get_cv('main','PID_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'PID '.$name;
	if ($self->{'_PID'}{$name})
	{
	    $self->{'_PID'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_PID($name);
	}
    }
    foreach my $name ($self->get_cv('main','Alert_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'Alert '.$name;
	if ($self->{'_ALERT'}{$name})
	{
	    $self->{'_ALERT'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_Alert($name);
	}
    }
    foreach my $name ($self->get_cv('main','Adapter_names'))
    {
	next unless ($name);
	$self->{'_error'} = 'Adapter '.$name;
	if ($self->{'_ADAPTER'}{$name})
	{
	    $self->{'_ADAPTER'}{$name}->readstring_ignore(0);
	}
	else
	{
	    $self->init_Adapter($name);
	}
    }
    ### Run init() on all adapter devices      ####
    foreach my $name (keys %{$self->{'_ADAPTER'}})
    {
	$self->{'_error'} = 'Filter device init: '.$name;
	$self->{'_ADAPTER'}{$name}->init();
    }
    ### Run init() on all filter devices      ####
    foreach my $name (keys %{$self->{'_FILTER'}})
    {
	$self->{'_error'} = 'Filter device init: '.$name;
	$self->{'_FILTER'}{$name}->init();
    }
    ### Run init() on all logic devices      ####
    foreach my $name (keys %{$self->{'_LOGIC'}})
    {
	$self->{'_error'} = 'Logic device init: '.$name;
	$self->{'_LOGIC'}{$name}->init();
    }
    ### Run init() on all math devices      ####
    foreach my $name (keys %{$self->{'_MATH'}})
    {
	$self->{'_error'} = 'Math device init: '.$name;
	$self->{'_MATH'}{$name}->init();
    }
    $self->{'_modtime'} = $self->modtime();
    ### Reset errorstring as last operation ###
    $self->{'_error'} = '';
    $self->{'_oldsession'} = $self->session;
    return $self;
}

sub test
{
    my $self = shift;
    return 0 if ($self->{'_error'});
    return 1;
}

sub init_Adapter($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_Adapter!\n" unless (defined($name));
    CORE::die "No information found for Adapter '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('Adapter_'.$name));
    $self->register_Adapter($self->new_Adapter($name));
    return $self->Adapter($name)
}

sub init_Alert($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_Alert!\n" unless (defined($name));
    CORE::die "No information found for Alert '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('Alert_'.$name));
    $self->register_Alert($self->new_Alert($name));
    return $self->Alert($name)
}

sub init_PID($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_PID!\n" unless (defined($name));
    CORE::die "No information found for PID '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('PID_'.$name));
    $self->register_PID($self->new_PID($name));
    return $self->PID($name)
}

sub init_analog($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_analog!\n" unless (defined($name));
    CORE::die "No information found for analog output '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('analog_out_'.$name));
    $self->register_analog($self->new_AnalogOut($name));
    return $self->analog($name)
}

sub init_filter()
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_filter!\n" unless (defined($name));
    CORE::die "No information found for filter device '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('filter_'.$name));
    $self->register_filter($self->new_filter($name));
    return $self->filter($name);
}

sub init_math()
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_math!\n" unless (defined($name));
    CORE::die "No information found for math device '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('Math_'.$name));
    $self->register_Math($self->new_Math($name));
    return $self->Math($name);
}

sub init_logic()
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_logic!\n" unless (defined($name));
    CORE::die "No information found for logic device '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('Logic_'.$name));
    $self->register_Logic($self->new_Logic($name));
    return $self->Logic($name);
}

sub init_relay($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_relay!\n" unless (defined($name));
    CORE::die "No information found for relay '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('relay_'.$name));
    $self->register_relay($self->new_RELAY($name));
    return $self->relay($name);
}

sub init_simplechannel($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_simplechannel!\n" unless (defined($name));
    CORE::die "No information found for simple channel '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('channel_'.$name));
    $self->register_simplechannel($self->new_SimpleChannel($name));
    return $self->simplechannel($name);
}

sub init_PSU($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_PSU!\n" unless (defined($name));
    CORE::die "No information found for PSU '$name'".' for rig '.$self->name,"\n" unless ($self->{'_config'}->section_exists('PSU_'.$name));
    $self->register_PSU($self->new_PSU($name));
    return $self->PSU($name);
}

sub init_multiplex($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_multiplex!\n" unless (defined($name));
    CORE::die "No information found for gas multiplexer '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('gas_multiplexer_'.$name));
    $self->register_multiplex($self->new_Multiplexer($name));
    return $self->multiplex($name);
}

sub init_MFC($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_MFC!\n" unless (defined($name));
    CORE::die "No information found for MFC '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('controler_'.$name));
    $self->register_MFC($self->new_MFC($name));
    return $self->MFC($name);
}

sub init_tempcontrol($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_tempcontrol!\n" unless (defined($name));
    CORE::die "No information found for temperature controler '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('TControl_'.$name));
    $self->register_tempcontrol($self->new_TEMP($name));
    return $self->tempcontrol($name);
}


sub init_gas($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_gas!\n" unless (defined($name));
    CORE::die "No information found for gas '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('gas_'.$name));
    $self->register_gas($self->new_GAS($name));
    return $self->gas($name);
}

sub init_water($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_water!\n" unless (defined($name));
    CORE::die "No information found for water '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('water_'.$name));
    $self->register_water($self->new_Water($name));
    return $self->water($name);
}

sub init_temp($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_temp!\n" unless (defined($name));
    CORE::die "No information found for temperature log '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('temp_'.$name));
    $self->register_temp($self->new_Templog($name));
    return $self->temp($name);
}

sub init_gasgroup($)
{
    my $self = shift;
    my $name = shift;
    CORE::die "No name defined for init_gasgroup!\n" unless (defined($name));
    CORE::die "No information found for gas group '$name'".' for rig '.$self->name."\n" unless ($self->{'_config'}->section_exists('gas_group_'.$name));
    $self->register_gasgroup($self->new_GasGroup($name));
    return $self->gasgroup($name);
}

sub init_device($$)
{
    my $self = shift;
    my $type = shift;
    my $name = shift;
    return undef unless ($type && $name);
    my $dev = $self->get_device($type,$name);
    return $dev if ($dev);
    ### Find if requested device is of filter type which may masquerade as normal type ###
    foreach my $n ($self->avail_filter_type($type))
    {
	next unless ($n eq $name);
	$dev = $self->init_filter($name);
	last;
    }
    return $dev if ($dev);
    ### Allocate device normally ###
    return $self->init_simplechannel($name) if ($type eq 'simplechannel');
    return $self->init_relay($name) if ($type eq 'relay');
    return $self->init_temp($name) if ($type eq 'templog');
    return $self->init_tempcontrol($name) if ($type eq 'tempcontrol');
    return $self->init_MFC($name) if ($type eq 'MFC');
    return $self->init_water($name) if ($type eq 'water');
    return $self->init_gas($name) if ($type eq 'gas');
    return $self->init_gasgroup($name) if ($type eq 'gasgroup');
    return $self->init_PSU($name) if ($type eq 'PSU');
    return $self->init_analog($name) if ($type eq 'analog');
    return $self->init_multiplex($name) if ($type eq 'multiplex');
    return $self->init_filter($name) if ($type eq 'filter');
    return $self->init_logic($name) if ($type eq 'logic');
    return $self->init_math($name) if ($type eq 'math');
    return $self->init_PID($name) if ($type eq 'PID');
    return $self->init_Alert($name) if ($type eq 'Alert');
    return $self->init_Adapter($name) if ($type eq 'Adapter');
    return undef;
}

#### The new_Device functions are wrapper functions for the various Device.pm factory functions ###
#### They are used by $rig->init() as well as to obtain an device node for a not enabled device ###
#### (For testing purposes when installing a ned hwardware/logical device)                      ###

sub new_AnalogOut($)
{
    my $self = shift;
    my $name = shift;
    my $type = $self->get_cv('analog_out_'.$name,'type');
    return RFC::Device::new_AnalogOut($self,$name,$type);
}

sub new_PID($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_PID($self,$name);
}

sub new_Adapter($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_Adapter($self,$name);
}

sub new_Alert($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_Alert($self,$name);
}

sub new_filter($)
{
    my $self = shift;
    my $name = shift;
    my $type = $self->get_cv('filter_'.$name,'class');
    $type = 'input_spline' unless ($type);
    return RFC::Device::new_filter($self,$name,$type);
}

sub new_Logic($)
{
    my $self = shift;
    my $name = shift;
    my $type = $self->get_cv('Logic_'.$name,'class');
    $type = 'AND' unless ($type);
    return RFC::Device::new_Logic($self,$name,$type);
}

sub new_Math($)
{
    my $self = shift;
    my $name = shift;
    my $type = $self->get_cv('Math_'.$name,'class');
    $type = 'Add' unless ($type);
    return RFC::Device::new_Math($self,$name,$type);
}

sub new_RELAY($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_RELAY($self,$name);
}

sub new_SimpleChannel($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_SimpleChannel($self,$name);
}

sub new_PSU($)
{
    my $self = shift;
    my $name = shift;
    my $type = $self->get_cv('PSU_'.$name,'type');
    ### Assume default Delta SM15-100 ###
    $type = 'SM_15_100' unless ($type);
    $type = shift if (@_);
    return RFC::Device::new_PSU($self,$name,$type);
}

sub new_Multiplexer($)
{
    my $self = shift;
    my $name = shift;
    my $type = $self->get_cv('gas_multiplexer_'.$name,'type');
    $type = 'ICP' unless ($type);
    return RFC::Device::new_Multiplexer($self,$name,$type);
}

sub new_MFC($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_MFC($self,$name);
}

sub new_TEMP($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_TEMP($self,$name);
}

sub new_GAS($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_GAS($self,$name);
}

sub new_Water($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_Water($self,$name);
}

sub new_Templog($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_Templog($self,$name);
}

sub new_GasGroup($)
{
    my $self = shift;
    my $name = shift;
    return RFC::Device::new_GasGroup($self,$name);
}


#### End Device.pm wrapper functions ###

sub set_temp($)
{
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $temp = shift;
    my $res = undef;
    eval {
	$self->die("No temperature controler found!") unless ($self->tempcontrols);
	my $name;
	if (@_)
	{
	    $name = shift;
	    $self->die("Temperature controler '$name' not found!") unless exists($self->{'_TEMPCONTROL'}{$name});
	}
	else
	{	
	    $self->die("Ambigious temperature controler for setting temp, more than one controler found but no name specified!\n") if ($self->tempcontrols > 1);
	    my @list = $self->tempcontrols;
	    $name = $list[0];
	}
	$res = $self->{'_TEMPCONTROL'}{$name}->set_temp($temp,'dummy','nolog');
	$self->proglog("Temperature for controler $name set to $temp C",@_);
    };
    if ($@)
    {
	$self->proglog("Error setting temperature: $@",@_);
    }
    return $res;
}

sub set_ramp($)
{
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $ramp = shift;
    my $res = undef;
    eval {
	$self->die("No temperatue controler found!") unless ($self->tempcontrols);
	my $name;
	if (@_)
	{
	    $name = shift;
	    $self->die("Temperature controler '$name' not found!") unless exists($self->{'_TEMPCONTROL'}{$name});
	}
	else
	{	
	    $self->die("Ambigious temperature controler for setting temp, more than one controler found but no name specified!\n") if ($self->tempcontrols > 1);
	    my @list = $self->tempcontrols;
	    $name = $list[0];
	}
	$res = $self->{'_TEMPCONTROL'}{$name}->set_ramp($ramp,'dummy','nolog');
	$self->proglog("Temperature ramp for controler '$name' set to $ramp C/hour",@_);
    };
    if ($@)
    {
	$self->proglog("Error setting ramprate: $@",@_);
    }
    return $res;
}

sub current($)
{
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $current = shift;
    eval {
	$self->die("No PSU found!") unless ($self->PSUs);
	my $name;
	if (@_)
	{
	    $name = shift;
	    $self->die("PSU '$name' not found!") unless exists($self->{'_PSU'}{$name});
	}
	else
	{
	    $self->die("Ambigious PSU for setting current, more than one PSU found but no name specified!\n") if ($self->PSUs > 1);
	    my @list = $self->PSUs;
	    $name = $list[0];
	}
	$self->{'_PSU'}{$name}->current($current,@_);
    };
    if ($@)
    {
	$self->proglog("Error setting current: $@",@_);
    }    
}

sub voltage($)
{
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $volt = shift;
    eval {
	$self->die("No PSU found!") unless ($self->PSUs);
	my $name;
	if (@_)
	{
	    $name = shift;
	    $self->die("PSU '$name' not found!") unless exists($self->{'_PSU'}{$name});
	}
	else
	{
	    $self->die("Ambigious PSU for setting current, more than one PSU found but no name specified!\n") if ($self->PSUs > 1);
	    my @list = $self->PSUs;
	    $name = $list[0];
	}
	$self->{'_PSU'}{$name}->voltage($volt,@_);
    };
    if ($@)
    {
	$self->proglog("Error setting voltage: $@",@_);
    }    
}



sub get_userlog()
{
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $session = shift;
    $session = $self->session unless ($session);
    $self->die("Test '$session' does not exist on rig ".$self->name."! (valid values are 0 to ".$self->session.')') if ($session < 0 || $session > $self->session);
    if ($session == $self->session)
    {
        return join("\n",$self->{'_userlog'}->readlines) if ($self->{'_userlog'}->exist);
    }
    else
    {
	my $webtest = $publicdir.'rig'.$self->name.'/'.$self->name.'test'.$session.'/';
        my $file = SemaforeFile->new($webtest.'userlog',$self->{'_riglock'});
	my $l = $file->lock_sh_nb;
	unless ($l)
	{
	    sleep(1);
	    $l = $file->lock_sh_nb;
	}
	if ($l)
	{
	    my $str = join("\n",$file->readlines) if ($file->exist);
	    $file->lock_un;
	    return $str;
	}
	else
	{
	    warn "Could not lock session log file for reading!\n";
	    return '';
	}
	$file->DESTROY();
    }
    return '';
}



sub get_sessionlog()
{
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $session = shift;
    $session = $self->session unless ($session);
    $self->die("Test '$session' does not exist on rig ".$self->name."! (valid values are 0 to ".$self->session.')') if ($session < 0 || $session > $self->session);
    if ($session == $self->session)
    {
        return join("\n",$self->{'_proglog'}->readlines) if ($self->{'_proglog'}->exist);
    }
    else
    {
	my $webtest = $publicdir.'rig'.$self->name.'/'.$self->name.'test'.$session.'/';
        my $file = SemaforeFile->new($webtest.'proglog',$self->{'_riglock'});
	my $l = $file->lock_sh_nb;
	unless ($l)
	{
	    sleep(1);
	    $l = $file->lock_sh_nb;
	}
	if ($l)
	{
	    my $str = join("\n",$file->readlines) if ($file->exist);
	    $file->lock_un;
	    return $str;
	}
	else
	{
	    warn "Could not lock session log file for reading!\n";
	    return '';
	}
	$file->DESTROY();
    }
    return '';
}

sub get_errorlog()
{
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $session = shift;
    $session = $self->session unless ($session);
    $self->die("Test '$session' does not exist on rig ".$self->name."! (valid values are 0 to ".$self->session.')') if ($session < 0 || $session > $self->session);
    if ($session == $self->session)
    {
	my $l = $self->{'_errlog'}->lock_sh_nb;
	unless ($l)
	{
	    sleep(1);
	    $l = $self->{'_errlog'}->lock_sh_nb;
	}
	if ($l)
	{
	    my $str = join("\n",$self->{'_errlog'}->readlines) if ($self->{'_errlog'}->exist);
	    $self->{'_errlog'}->lock_un;
	    return $str;
	}
	else
	{
	    warn "Could not lock errorlog file for reading!\n";
	    return '';	    
	}
    }
    else
    {
	my $webtest = $publicdir.'rig'.$self->name.'/'.$self->name.'test'.$session.'/';
	my $file = SemaforeFile->new($webtest.'errorlog',$self->{'_riglock'});
	my $l = $file->lock_sh_nb;
	unless ($l)
	{
	    sleep(1);
	    $l = $file->lock_sh_nb;
	}
	if ($l)
	{
	    my $str = join("\n",$file->readlines) if ($file->exist);
	    $file->lock_un;
	    return $str;
	}
	else
	{
	    warn "Could not lock errorlog file for session $session for reading!\n";
	    return '';
	}
    }
    return '';
}

sub config_key_exists($$)
{
    my $self = shift;
    my $section = shift;
    my $key = shift;
    return $self->{'_config'}->exists($section,$key);
}

sub config_section_exists($$)
{
    my $self = shift;
    my $section = shift;
    return $self->{'_config'}->section_exists($section);
}

sub change_config_value($$$)
{
    my $self = shift;
    return $self->{'_config'}->change_config_value(@_);
}

sub get_cv($$)
{
    my $self = shift;
    my $section = shift;
    my $key = shift;
    if (wantarray)
    {
	$self->writedebug("Returning list instead of scalar as get_cv called in list context") if ($self->debug() > 3);
	return ($self->{'_config'}->get_config_value($section,$key));
    }
    return $self->{'_config'}->get_config_value($section,$key);
}

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

sub get_cv_test($$$)
{
    my $self = shift;
    my $section = shift;
    my $key = shift;
    my $session = shift;
    $session = $self->session unless (defined($session));
    $self->die("Test '$session' does not exist on rig ".$self->name."! (valid values are 0 to ".$self->session.')') if ($session < 0 || $session > $self->session);
    unless ($self->{'_config_old'}[$session] && ref($self->{'_config_old'}[$session]))
    {
	$self->writedebug("Initialising configuration file for test $session") if ($self->debug);
	my $fn = $self->{'_config_old'}[$session];
	$self->{'_config_old'}[$session] = ElchemeaConfig->new($fn,$self->{'_configlock'});
	$self->{'_config_old'}[$session]->debug($self->{'_debug'}) if ($self->{'_config_old'}[$session] && ref($self->{'_config_old'}[$session]));
    }
    if (wantarray)
    {
	$self->writedebug("Returning list instead of scalar as get_cv_test is called in list context") if ($self->debug() > 3);
	return ($self->{'_config_old'}[$session]->get_config_value($section,$key));
    }
    return $self->{'_config_old'}[$session]->get_config_value($section,$key);
}

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

sub type()
{
    my $self = shift;
    return 'Rig';
}

sub session()
{
    my $self = shift;
    return $self->{'_session'};
}

sub errorlog
{
    my $self = shift;
    $self->proglog(@_);
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $string = shift;
    chomp $string;
    my $do_trace = 0;
    my $s;
    my $l = $self->{'_errlog'}->lock_ex_nb();
    unless ($l)
    {
	sleep(1);
	$l = $self->{'_errlog'}->lock_ex_nb();
    }
    if ($l)
    {
	unless ($self->{'_errlog'}->exist)
	{
	    $self->writedebug("Writing to new errorlog for test ".$self->session." for rig '".$self->name."'") if ($self->debug);
	    $self->{'_errlog'}->writeline();
	    chmod 0666,$self->{'_errlog'}->filename;
	}
	if (@_)
	{
	    my $user = shift;
	    ### Assume second argument is user name and append ' by user' ###
	    $string .= " by user '$user'";
	}
	else
	{
	    $do_trace = 1;
	    my $tty = POSIX::ttyname(1);
	    my $user = RFC::Main::get_user_name($<);
	    foreach ($tty,$user)
	    {
		$_ = '' unless (defined($_));
	    }
	    $string .= " by user '$user' on $tty";
	}
	### Opens the logfile #####
	my $time = localtime;
	$s = $time.' : '.$string;
	$self->{'_errlog'}->append($s);
	$self->{'_errlog'}->unlock;
	$self->tracelog($string) if ($do_trace || $self->debug);
	return 1;
    }
    else
    {
	warn "Could not lock errorlog file for writing! Message '$s' Could not be appended!\n";
	return 0;	
    }
}

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

sub proglog
{
    my $self = shift;
    return if ($self->{'_disable_proglog'});
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $string = shift;
    chomp $string;
    my $do_trace = 0;
    my $s;
    my $l = $self->{'_proglog'}->lock_ex_nb();
    unless ($l)
    {
	sleep(1);
	$l = $self->{'_proglog'}->lock_ex_nb();
    }
    if ($l)
    {
	unless ($self->{'_proglog'}->exist)
	{
	    $self->writedebug("Writing to new userlog for test ".$self->session." for rig '".$self->name."'") if ($self->debug);
	    $self->{'_userlog'}->writeline();
	    chmod 0666,$self->{'_proglog'}->filename;
	}
	if (@_)
	{
	    my $user = shift;
	    ### Assume second argument is user name and append ' by user' ###
	    $string .= " by user '$user'";
	}
	else
	{
	    $do_trace = 1;
	    my $tty = POSIX::ttyname(1);
	    my $user = RFC::Main::get_user_name($<);
	    foreach ($tty,$user)
	    {
		$_ = '' unless (defined($_));
	    }
	    $string .= " by user '$user' on $tty";
	}
	### Opens the logfile #####
	my $time = localtime;
	my $s = $time.' : '.$string;
	$self->{'_proglog'}->append($s);
	$self->{'_proglog'}->unlock;
	$self->tracelog($string) if ($do_trace || $self->debug);
	return 1;
    }
    else
    {
	warn "Could not lock userlog file for writing! Message '$s' Could not be appended!\n";
	return 0;	
    }
}


sub userlog
{
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my $string = shift;
    chomp $string;
    my $do_trace = 0;
    my $s;
    my $l = $self->{'_userlog'}->lock_ex_nb();
    unless ($l)
    {
	sleep(1);
	$l = $self->{'_userlog'}->lock_ex_nb();
    }
    if ($l)
    {
	unless ($self->{'_userlog'}->exist)
	{
	    $self->writedebug("Writing to new userlog for test ".$self->session." for rig '".$self->name."'") if ($self->debug);
	    $self->{'_userlog'}->writeline();
	    chmod 0666,$self->{'_userlog'}->filename;
	}
	if (@_)
	{
	    my $user = shift;
	    ### Assume second argument is user name and append ' by user' ###
	    $string .= " by user '$user'";
	}
	else
	{
	    $do_trace = 1;
	    my $tty = POSIX::ttyname(1);
	    my $user = RFC::Main::get_user_name($<);
	    foreach ($tty,$user)
	    {
		$_ = '' unless (defined($_));
	    }
	    $string .= " by user '$user' on $tty";
	}
	### Opens the logfile #####
	my $time = localtime;
	my $s = $time.' : '.$string;
	$self->{'_userlog'}->append($s);
	$self->{'_userlog'}->unlock;
	$self->tracelog($string) if ($do_trace || $self->debug);
	return 1;
    }
    else
    {
	warn "Could not lock userlog file for writing! Message '$s' Could not be appended!\n";
	return 0;	
    }
}

sub tracelog
{
    my $self = shift;
    ### NB Do NOT call init here as this may leed to deep recursion! ###
    my $string = shift;
    chomp $string;
    $string = '' unless defined($string);
    #######################################
    ## Getting complete stack backtrace ###
    #######################################
    my @trace = ();
    my $i = 0;
    while(my ($package,$filename,$line,$subroutine) = caller($i++))
    {
        unshift @trace,"'$filename' line $line called $subroutine";
    }
    my $stacktrace = join(' -> ',@trace);
    $string .= ' #### Stack backtrace: '.$stacktrace;
    ### Opens the logfile #####
    my $time = localtime;
    my $s = $time.' : '.$string;
    unless ($self->{'_trace'})
    {
	warn "Tracelog file object not found! Message '$s' Could not be appended!\n";
	return undef;
    }
    my $l = $self->{'_trace'}->lock_ex_nb();
    unless ($l)
    {
	sleep(1);
	$l = $self->{'_trace'}->lock_ex_nb();
    }
    if ($l)
    {
	$self->{'_trace'}->lock_un();
	unless ($self->{'_trace'}->exist)
	{
	    warn "Writing to new tracelog for test ".$self->session." for rig '".$self->name."'\n" if ($self->debug);
	    $self->{'_trace'}->writeline();
	    chmod 0666,$self->{'_trace'}->filename;
	}
	$self->{'_trace'}->append($s);
	$self->{'_trace'}->unlock;
	return 1;
    }
    else
    {
	warn "Could not lock tracelog file for writing! Message '$s' Could not be appended!\n";
	return 0;
    }
}


sub load_session_nr()
### Function returning the session number ###
{
    my $self = shift;
    my $file = $publicdir.'rig'.$self->{'_name'}.'/test.nr';
    $self->{'_session'} = 0;
    if (-e $file)
    {
        $self->writedebug("Loading test number from file '$file'") if ($self->debug);
        sysopen(FH, $self->{'_riglock'}, O_WRONLY | O_CREAT) or $self->die("Could not open lockfile $self->{'_riglock'} $!");
        my $l = flock(FH, LOCK_SH|LOCK_NB);
	unless ($l)
	{
	    sleep(1);
	    $l = flock(FH, LOCK_SH|LOCK_NB);
	}
	if ($l)
	{
	    open MYIN,'<',$file or $self->die("Could not open file $file $!");
	    my $test = <MYIN>;
	    CORE::close MYIN;
	    flock(FH, LOCK_UN);
	    CORE::close FH;
	    if ($test =~ /(\d+)/)
	    {
		$self->{'_session'} = $1;
	    }
	}
	else
	{
	    CORE::close FH;
	    my $fn = $self->{'_riglock'};
	    warn "Could not lock '$fn' for reading when loading session number!\n";
	    return 0;
	}
    }
    $self->{'_webtest'} = $publicdir.'rig'.$self->name.'/'.$self->name.'test'.$self->session.'/';
    return $self->{'_session'};
}


sub print_setup()
{
    #############################################
    ### print_setup()                         ###
    ### utility function for debugging        ###
    ### purposes, prints the contents of the  ###
    ### device instance data fields $self->{} ###
    #############################################
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my @arr = ('*******************************************');
    push @arr,'Rig ID: Rig'.$self->{'_name'};
    push @arr,'Member functions:';
    my $class = $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,'';
    return join("\n",@arr);
}


sub test_list()
{
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    $self->die('Intialisation of rig '.$self->name.' failed, last mesage: '.$self->{'_error'}) if ($self->{'_error'});
    my @arr = ();
    foreach my $key ('_MULTI','_MFC','_RELAY','_SIMPLE','_WATER','_GAS','_TEMPLOG','_GASGROUP','_PSU','_AOUT','_TEMPCONTROL','_FILTER','_PID','_LOGIC','_ALERT','_MATH')
    {
	foreach my $k (keys %{$self->{$key}})
	{
	    my %item = ('id'=>$self->{$key}{$k},'name'=>$key.'_'.$self->{$key}{$k}->name);
	    push @arr,\%item;
	}
    }
    return @arr;
}


sub print_config()
{
    my $self = shift;
    $self->init() unless ($self->{'_modtime'} == $self->modtime());
    my @arr = ($self->name);
    push @arr,'Iv-curve running' if ($self->is_iv());
    my $l = $self->{'_maillock'}->lock_sh_nb;
    my $count = 0;
    while (!$l && $count++ < 3)
    {
	sleep(1);
	$l = $self->{'_maillock'}->lock_sh_nb;
    }
    if ($l)
    {
	my @list = $self->{'_maillock'}->readlines;
	push @arr,'Devices with warning bit set: '.join(', ',@list);
    }
    else
    {
	$self->writedebug("Warning! Could not lock '".$self->{'_maillock'}->filename."'",1);
    }
    $self->{'_maillock'}->lock_un;
    ### Run through devices ####
    foreach my $type ($self->list_types())
    {
	push @arr, '##### '.$type.' #####'; 
	foreach my $name ($self->list_devices($type))
	{
	    my $dev = $self->get_device($type,$name);
	    push @arr,$dev->print_config() if ($dev);
	}
    }
    push @arr,'### Note that filter devices often masquerade as other devices and thus shows up as those devices also! ###';
    return join("\n",@arr);
}

sub check_group()
{
    my $self = shift;
    my $usernumber = $<;
    my @groups = split(/\s/,$();
    my %h = ();
    ## Get rid of duplicates ##
    foreach my $g (@groups)
    {
	$h{$g} = 1;
    }
    @groups = keys %h;
    ### Get apache group name ###
    my $groupname = undef;
    my $http_conf = `locate httpd.conf | grep -P '.conf\$' | grep etc`;
    chomp $http_conf;
    open MYIN_http,'<',$http_conf or $self->die("Could not open $http_conf for reading $!");
    while (my $line = <MYIN_http>)
    {
	next unless ($line =~ /^[\s\t]*Group\s+(\w+)/);
	$groupname = $1;
	last;
    }
    close MYIN_http;
    foreach my $g (@groups)
    {
	my $name = (getgrgid($g))[0];
	next unless ($name);
	return 1 if ($groupname eq $name)
    }
    $self->die('You are attempting to access processes for rig '.$self->name.', but are not logged in as a user which is part of group '.$groupname);
}

sub check_run()
{
    my $self = shift;
    my $usernumber = $<;
    my $username = RFC::Main::get_user_name($usernumber);
    $self->die('You are attempting to access processes for rig '.$self->name.', but are not logged in as rig'.$self->name) unless ($username eq 'rig'.$self->name);
    return 1;
}


sub inc_test($)
{
    my $self = shift;
    my $text = shift;
    my $user = shift;
    $self->lock_control();
    my $session = $self->session();
    my $newsession = $session + 1;
    #### Increase test nmber ###
    my $file = $publicdir.'rig'.$self->{'_name'}.'/test.nr';
    $self->writedebug("Writing new test number to file '$file'") if ($self->debug);
    open MYOUT,'>',$file or $self->die("Could not open file $file  for writing$!");
    print MYOUT $newsession,"\n";
    close MYOUT;
    $self->load_session_nr;
    $self->create_dirs;
    ### Copy curret configuration to new session config ###
    ### Wil be overwritten once a day                   ###
    my $fn = $publicdir.'rig'.$self->name.'/'.$self->name.'test'.$newsession.'/configfile';
    $self->{'_config_old'}[$newsession] = ElchemeaConfig->new($fn,$self->{'_configlock'});
    $self->{'_config_old'}[$newsession]->debug($self->{'_debug'});
    my @lines = $self->config->readlines();
    $self->{'_config_old'}[$newsession]->writeline(@lines);
    chmod 0664,$self->{'_config_old'}[$newsession]->filename;
    $self->init();
    $self->create_dirs;
    my $string = "New test started";
    my $time = localtime();
    my $r = $self->name;
    $self->proglog($string,$user);
    $string = <<END;
Information for test $newsession on rig $r

Test started $time

Rignumber                   : $r
Testnumber                  : $newsession
$text

END

    $self->info($string);
    foreach ('proglog','userlog','errorlog')
    {
	my $f = $self->{'_webtest'}.$_;
	unless (-e $f)
	{
	    touch($f);
	}
	chmod 0666,$f;
    }
    my $skip_setflow = $self->get_cv('main','set_zero_output_start_test');
    unless ($skip_setflow && $skip_setflow =~ /no/i)
    {
	foreach my $n ($self->list_devices_control('gas'))
	{
	    my $d = $self->get_device('gas',$n);
	    next unless ($d->type eq 'Gas');
	    $d->setflow(0,$user) if ($d);
	}
	foreach my $n ($self->list_devices_control('PSU'))
	{
	    my $d = $self->get_device('PSU',$n);
	    $d->current('ocv',$user) if ($d);
	}
    }
    my $olddir = $RFC::Header::publicdir.'rig'.$self->name.'/'.$self->name.'test'.$session.'/';
    my $target = $homedir.'infofiles/'.$self->name.'test'.$session;
    if (-e $olddir.'proglog')
    {
	copy($olddir.'proglog',$target.'proglog') or $self->die("Could not copy file $olddir"."proglog $!");
    }
    if (-e $olddir.'info.txt')
    {
	copy($olddir.'info.txt',$target.'.inf') or $self->die("Could not copy file $olddir"."info.txt $!");
    }
    ### handle special start program execuion ###
    my $cmd = $self->get_cv('main','command_to_execute_at_test_start');
    if ($cmd && $cmd =~ /([\w\.\-\/\,\+]+)/)
    {
	$cmd = $1;
	if (-x $cmd)
	{
	    system($cmd.' '.$self->name);
	}
	else
	{
	    $self->errorlog("Could not execute command '$cmd', possibly permission denied");
	}
    }
    ### Do one measurement in new test ###
    RFC::Main::CGI_client($self->name,'measure');
    ### Remove old warnings ###
    $self->unset_warning();
    ### Set mail lock files for vogt and H2vogt ###
    $self->set_warning('H2mailfile');
    $self->set_warning('mailfile');
    ### Mail users that new test has been started ###
    my @adrs = (RFC::Main::get_cv('celltest','start_test_mail_users'));
    foreach my $addr (@adrs)
    {
	my $mok = RFC::Main::mail($addr,"New test started on rig $r\n Current test: $r test $newsession\n$text","New test started on rig $r");
	$self->proglog("Warning: Start test mail not sent to '$addr'") unless ($mok);
    }
    $self->unlock_control;
    return $self->session;
}

sub create_dirs()
{
    my $self = shift;
    my $session = $self->session();
    my $webdir = $publicdir.'rig'.$self->name.'/'.$self->name.'test'.$self->session.'/';
    unless (-d $webdir)
    {
	mkdir $webdir,0775;
	chmod 0775, $webdir;
    }
    my $impdir = $webdir .'impedance/';
    unless (-d $impdir)
    {
	mkdir $impdir,0775;
	chmod 0775, $impdir;
    }
    return;
}
