package RFC::Device;
#$Id: Device.pm,v 1.146 2025/06/23 11:10:59 sofc Exp $
 
#######################################################################
#
#
#    RFC::Device 
#
#  This module contains two types of functions: one set (prefixed list_)
#  returns a list of possible device types of the specified master type.
#  For instance, list_GAS retrns a list of possible gasses whereas list_PSU
#  returns a list of possible PSU classes.
#  The list functions never require any arguments except the 
#  list_device_types function which takes a type argument and returns a list
#  of possible sub types for the device type in question.
#
#  The other group of functions are factory functions createing and 
#  returning instances of the specified type.
#  For instance new_GAS($name,$rig) returns a new RFC::Gas object.
#  
#  The individual factory functions require a varying number of arguments,
#  however common is the first two (rig and name) which are compulsory.
#  Most of the factory functions only require the first 2 arguemnts.
#
#  The rig argument must be an instance of the RFC::Rig class or an object
#  of a similar type that at least honors the get_cv() member function.
#  (Some devices requires additional memberfunctions to be honored by the
#  rig instance, however all these memeber functions are included in a
#  RFC::Rig instance).
#
#  The name arguments is the name of the object to be created.
#  Note that the name must correspond to the name in the section in the 
#  configuration file where the device instance data is defined!
#
#  Below is a complete list of the functions defined in RFC::Device.pm:
#
# -- \begin{longtable}{l p{10cm} }
# -- list_device_types($) & returns a list of the possible subtypes of the specified master type. \\ 
# -- new($@) & Returns a class instance of the specified type. Arguments: type, rig, name, [optional subtype], where rig is an instance of the RFC::Rig class. \\
# -- new_GasGroup($$) & Returns a gas group instance, arguments: rig, name. \\
# -- list_GasGroup() & Returns a list of possible gas group subtypes. \\
# -- new_GAS($$) & Returns a gas instance, arguments: rig, name. \\
# -- list_GAS() & Returns a list of possible gas names (that is, the names of gasses where the gas factor is defined in the global configuration file). \\
# -- new_TEMP($$) & Returns a temperature controler instance, arguments: rig, name, [opt. subtype] \\
# -- list_TEMP() & Returns a list of possible temperature controler subtypes. \\
# -- new_Multiplexer($$) & Returns a gas multiplexer instance, arguments: rig, name, subtype \\
# -- list_Multiplexer() & Returns a list of possible gas multiplexer subtypes. \\
# -- new_MFC($$) & Returns a gas flow controler instance, arguments: rig, name, [opt subtype] \\
# -- list_MFC() & Returns a list of possible gas flow controler subtypes. \\
# -- new_RELAY($$) & Returns a relay instance, arguments: rig, name, [opt. subtype] \\
# -- list_RELAY() & Returns a list of possible relay subtypes. \\
# -- new_SimpleChannel($$) & Returns a simple data aquisition instance, arguments: rig, name, [opt. subtype] \\
# -- list_SimpleChannel() & Returns a list of possible simple data aquisition subtypes. \\
# -- new_Water($$) & Returns a gas humidifier instance, arguments: rig, name, [opt subtype] \\
# -- list_Water() & Returns a list of possible gas humidifier device subtypes. \\
# -- new_Templog($$) & Returns a temperature aquisition instance, arguments: rig, name, [opt. subtype] \\
# -- list_Templog() & Returns a list of possible temperature aquisition subtypes. \\
# -- new_PSU($$) & Returns a DC power supply device instance, arguments: rig, name, subtype \\
# -- list_PSU() & Returns a list of possible DC power supply subtypes. \\
# -- new_AnalogOut($$) & Returns an analog DC output device instance, arguments: rig, name, subtype \\
# -- list_AnalogOut() & Returns a list of possible analog DC output device subtypes. \\
# -- new_filter($$) & Returns an filter device instance, arguments: rig, name, subtype \\
# -- list_filter() & Returns a list of possible filter device subtypes. \\
# -- new_PID($$) & Returns an PID device instance, arguments: rig, name \\
# -- list_PID() & Returns a list of possible PID device subtypes. \\
# -- new_logic($$) & Returns an logic device instance, arguments: rig, name, [opt subtype] \\
# -- list_logic() & Returns a list of possible logic device subtypes. \\
# -- new_Math($$) & Returns an arithmetic device instance, arguments: rig, name, [opt subtype] \\
# -- list_Math() & Returns a list of possible arithmetic device subtypes. \\
# -- new_Alert($$) & Returns an Alert device instance, arguments: rig, name, [opt subtype] \\
# -- list_Alert() & Returns a list of possible Alert device subtypes. \\
# -- \end{longtable}
#
#######################################################################

use strict;
use warnings;
use Eurotherm qw();
use RFC::OmronTemp qw();
use RFC::CalTemp qw();
use RFC::Main;
use RFC::MFC;
use RFC::Gas;
use RFC::BaseRelay;
use RFC::Monostable;
use RFC::Simple;
use RFC::Water;
use RFC::Templog;
use RFC::Multiplex;
use RFC::GasGroup;
use RFC::PSU;
use RFC::Keithley2400;
use RFC::AnalogOut;
use RFC::TempControl;
use RFC::Elektro;
use RFC::Honeywell;
use RFC::CGas;
use RFC::PSU_Bipolar;
use RFC::PSU_B2N;
use RFC::SPDEV;
use RFC::PLCRead;
use RFC::RFCPID;
use RFC::Kepco;
use RFC::PSUMulti;
use RFC::MKS;
use RFC::Ysplit;
use RFC::Logic;
use RFC::Alert;
use RFC::Sum;
use RFC::Pcontrol;
use RFC::Typecast;
use RFC::Math;
use RFC::Adapter;
use RFC::Julabo;
use RFC::Redundancy;
use RFC::VacuumControl;
use RFC::FilterMultiplex;


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);
}

return 1;

sub list_device_types($)
{
    my $type = shift;
    return undef unless ($type);
    return RFC::Device::list_SimpleChannel() if ($type eq 'simplechannel');
    return RFC::Device::list_RELAY() if ($type eq 'relay');
    return RFC::Device::list_Templog() if ($type eq 'templog');
    return RFC::Device::list_TEMP() if ($type eq 'tempcontrol');
    return RFC::Device::list_MFC() if ($type eq 'MFC');
    return RFC::Device::list_Water() if ($type eq 'water');
    return RFC::Device::list_GAS() if ($type eq 'gas');
    return RFC::Device::list_GasGroup() if ($type eq 'gasgroup');
    return RFC::Device::list_PSU() if ($type eq 'PSU');
    return RFC::Device::list_AnalogOut() if ($type eq 'analog');
    return RFC::Device::list_Multiplexer() if ($type eq 'multiplex');
    return RFC::Device::list_filter() if ($type eq 'filter');
    return RFC::Device::list_PID() if ($type eq 'PID');
    return RFC::Device::list_Logic() if ($type eq 'logic');
    return RFC::Device::list_Math() if ($type eq 'math');
    return RFC::Device::list_Alert() if ($type eq 'Alert');
    return RFC::Device::list_Adapter() if ($type eq 'Adapter');
}

sub new
{
    my $type = shift;
    return undef unless ($type);
    return RFC::Device::new_SimpleChannel(@_) if ($type eq 'simplechannel');
    return RFC::Device::new_RELAY(@_) if ($type eq 'relay');
    return RFC::Device::new_Templog(@_) if ($type eq 'templog');
    return RFC::Device::new_TEMP(@_) if ($type eq 'tempcontrol');
    return RFC::Device::new_MFC(@_) if ($type eq 'MFC');
    return RFC::Device::new_Water(@_) if ($type eq 'water');
    return RFC::Device::new_GAS(@_) if ($type eq 'gas');
    return RFC::Device::new_GasGroup(@_) if ($type eq 'gasgroup');
    return RFC::Device::new_PSU(@_) if ($type eq 'PSU');
    return RFC::Device::new_AnalogOut(@_) if ($type eq 'analog');
    return RFC::Device::new_Multiplexer(@_) if ($type eq 'multiplex');
    return RFC::Device::new_filter(@_) if ($type eq 'filter');
    return RFC::Device::new_PID(@_) if ($type eq 'PID');
    return RFC::Device::new_Logic(@_) if ($type eq 'logic');
    return RFC::Device::new_Math(@_) if ($type eq 'math');
    return RFC::Device::new_Alert(@_) if ($type eq 'Alert');
    return RFC::Device::new_Adapter(@_) if ($type eq 'Adapter');
    return undef;
}

sub list_Adapter()
{
    return ('Ramprate','ExponentialDecay','TempControl');
}

sub new_Adapter
{
    my $rig = shift;
    my $name = shift;
    die errorlog("No name or rig specified for new_Adapter()!") unless ($name && $rig);
    my $id = undef;
    my $type = $rig->get_cv('Adapter_'.$name,'class');
    $type = shift if (@_);
    $type = 'Ramprate' unless ($type);
    $_ = $type;
  CASE:
    {
	/^Ramprate/ and do {$id = RFC::RamprateAdapter->new($name,$rig,@_); last CASE;};
	/^Exponential/ and do {$id = RFC::ExponentialDecayAdapter->new($name,$rig,@_); last CASE;};
	/^TempControl/ and do {$id = RFC::TempControlAdapter->new($name,$rig,@_); last CASE;};
    }
    die errorlog("Could not get id for Adapter device name $name") unless ($id);
    return $id;    
}

sub list_Math()
{
    return ('Add','Multiply','Subtract','Divide','Log','Exp','Root','Abs','Inv');
}

sub new_Math
{
    my $rig = shift;
    my $name = shift;
    die errorlog("No name or rig specified for new_Math()!") unless ($name && $rig);
    my $id = undef;
    my $type = $rig->get_cv('Math_'.$name,'class');
    $type = shift if (@_);
    $type = 'Add' unless ($type);
    $_ = $type;
  CASE:
    {
	/^Add/ and do {$id = RFC::Math_add->new($name,$rig,@_); last CASE;};
	/^Sub/ and do {$id = RFC::Math_sub->new($name,$rig,@_); last CASE;};
	/^Mul/ and do {$id = RFC::Math_multiply->new($name,$rig,@_); last CASE;};
	/^Div/ and do {$id = RFC::Math_divide->new($name,$rig,@_); last CASE;};
	/^Log/ and do {$id = RFC::Math_log->new($name,$rig,@_); last CASE;};
	/^Exp/ and do {$id = RFC::Math_exp->new($name,$rig,@_); last CASE;};
	/^Root/ and do {$id = RFC::Math_root->new($name,$rig,@_); last CASE;};
	/^Abs/ and do {$id = RFC::Math_abs->new($name,$rig,@_); last CASE;};
	/^Inv/ and do {$id = RFC::Math_inv->new($name,$rig,@_); last CASE;};
    }
    die errorlog("Could not get id for Math device name $name") unless ($id);
    return $id;    
}


sub list_Alert()
{
    return ('Normal','Trigger');
}

sub new_Alert
{
    my $rig = shift;
    my $name = shift;
    die errorlog("No name or rig specified for new_Alert()!") unless ($name && $rig);
    my $id = undef;
    my $type = $rig->get_cv('Alert_'.$name,'class');
    $type = shift if (@_);
    $type = 'Normal' unless ($type);
    $_ = $type;
  CASE:
    {
	/^Normal$/i and do {$id = RFC::Alert->new($name,$rig,@_); last CASE;};
	/^Trigger$/i and do {$id = RFC::Trigger->new($name,$rig,@_); last CASE;};
    }
    die errorlog("Could not get id for Alert device name $name") unless ($id);
    return $id;    
}



sub list_Logic()
{
    return ('AND','OR','NOT','Buffer','XOR','NAND','NOR','NXOR','Modulus');
}

sub new_Logic
{
    my $rig = shift;
    my $name = shift;
    die errorlog("No name or rig specified for new_Logic()!") unless ($name && $rig);
    my $id = undef;
    my $type = $rig->get_cv('Logic_'.$name,'class');
    $type = shift if (@_);
    $type = 'AND' unless ($type);
    $_ = $type;
  CASE:
    {
	/^AND$/i and do {$id = RFC::Logic_AND->new($name,$rig,@_); last CASE;};
	/^OR$/i and do {$id = RFC::Logic_OR->new($name,$rig,@_); last CASE;};
	/^NOT$/i and do {$id = RFC::Logic_NOT->new($name,$rig,@_); last CASE;};
	/^Buffer$/i and do {$id = RFC::Logic_Buffer->new($name,$rig,@_); last CASE;};
	/^XOR$/i and do {$id = RFC::Logic_XOR->new($name,$rig,@_); last CASE;};
	/^NAND$/i and do {$id = RFC::Logic_NAND->new($name,$rig,@_); last CASE;};
	/^NOR$/i and do {$id = RFC::Logic_NOR->new($name,$rig,@_); last CASE;};
	/^NXOR$/i and do {$id = RFC::Logic_NXOR->new($name,$rig,@_); last CASE;};
	/^Modulus/i and do {$id = RFC::Modulus->new($name,$rig,@_); last CASE;};
    }
    die errorlog("Could not get id for Logic device name $name") unless ($id);
    return $id;    
}


sub new_PID
{
    my $rig = shift;
    my $name = shift;
    die errorlog("No name or rig specified for new_PID()!") unless ($name && $rig);
    my $id = undef;
    my $type = $rig->get_cv('PID_'.$name,'type');
    $type = 'PID' unless ($type);
    $_ = $type;
  CASE:
    {
	/^Linear/ and do {$id = RFC::LApproach->new($name,$rig,@_); last CASE;};
	/^PID$/i and do {$id = RFC::RFCPID->new($name,$rig,@_); last CASE;};
    }
    die errorlog("Could not get id for PID device name $name") unless ($id);
    return $id;
}

sub list_PID()
{
    return ('PID','LinearApproach');
}

sub new_filter
{
    my $rig = shift;
    my $name = shift;
    die errorlog("No name or rig specified for new_filter()!") unless ($name && $rig);
    my $id = undef;
    my $type = $rig->get_cv('filter_'.$name,'class');
    $type = shift if (@_);
    $type = 'input_spline' unless ($type);
    $_ = $type;
  CASE:
    {
	/Redundancy/i and do {$id = RFC::Redundancy->new($name,$rig,@_); last CASE;};
	/Typecast_PSU/i and do {$id = RFC::TypecastFaraday->new($name,$rig,@_); last CASE;};
	/Typecast/i and do {$id = RFC::TypecastDefault->new($name,$rig,@_); last CASE;};
	/Constant/i and do {$id = RFC::Constant->new($name,$rig,@_); last CASE;};
	/Schmidttrigger/i and do {$id = RFC::Strigger->new($name,$rig,@_); last CASE;};
	/^Y-split$/i and do {$id = RFC::Ysplit->new($name,$rig,@_); last CASE;};
	/^input_spline$/i and do {$id = RFC::SPDEV->new($name,$rig,@_); last CASE;};
	/^output_spline$/i and do {$id = RFC::SPOutDEV->new($name,$rig,@_); last CASE;};
	/^IO_spline$/i and do {$id = RFC::SPIODEV->new($name,$rig,@_); last CASE;};
	/^sum$/i and do {$id = RFC::Sum->new($name,$rig,@_); last CASE;};
	/^min$/i and do {$id = RFC::Min->new($name,$rig,@_); last CASE;};
	/^max$/i and do {$id = RFC::Max->new($name,$rig,@_); last CASE;};
	/^Lowpass$/i and do {$id = RFC::Lowpass->new($name,$rig,@_); last CASE;};
	/^Moving_average$/i and do {$id = RFC::MovingAverage->new($name,$rig,@_); last CASE;};
	/^Circular_average$/i and do {$id = RFC::CircularAverage->new($name,$rig,@_); last CASE;};
	/^Derivative$/ and do {$id = RFC::Derivative->new($name,$rig,@_); last CASE;};
	/^Integrator$/ and do {$id = RFC::Integrator->new($name,$rig,@_); last CASE;};
	/^Truncate$/ and do {$id = RFC::Truncate->new($name,$rig,@_); last CASE;};
	/^Integer$/ and do {$id = RFC::Integer->new($name,$rig,@_); last CASE;};
	/^Input_multiplex/ and do {$id = RFC::FilterMultiplex->new($name,$rig,@_); last CASE;};
	/^Output_multiplex/ and do {$id = RFC::OutputMultiplex->new($name,$rig,@_); last CASE;};
    }
    die errorlog("Could not get id for filter device name $name") unless ($id);
    return $id;	
}

sub list_filter()
{
    return ('input_spline','output_spline','IO_spline','Y-split','Schmidttrigger','Sum','Min','Redundancy','Max','Lowpass','Moving_average','Circular_average','Derivative','Integrator','Typecast','Typecast_PSU_to_gas','Truncate','Integer','Constant','Input_multiplex','Output_multiplex');
}


sub new_GasGroup
{
    my $rig = shift;
    my $name = shift;
    die errorlog("No name or rig specified for new_GasGroup()!") unless ($name && $rig);
    my $id = RFC::GasGroup->new($name,$rig);
    die errorlog("Could not get id for gas group name $name") unless ($id);
    return $id;
}

sub list_GasGroup()
{
    return ('ICP');
}

sub new_GAS
{
    my $rig = shift;
    my $name = shift;
    die errorlog("No name or rig specified for new_GAS()!") unless ($name && $rig);
    my $id = undef;
    my $type = $rig->get_cv('gas_'.$name,'class');
    $type = shift if (@_);
    $type = 'Normal' unless ($type);
    $_ = $type;
  CASE:
    {
	/^Multiline$/i and do {$id = RFC::CGas->new($name,$rig,@_); last CASE;};
	/^Normal$/i and do {$id = RFC::Gas->new($name,$rig,@_); last CASE;};
    }
    die "No gas line id returned for name '$name'" unless ($id);
    return $id;	
}

sub list_GAS()
{
    return ('Normal','Multiline');
}

sub new_TEMP
{
    my $rig = shift;
    my $name = shift;
    my $id = undef;
    die errorlog("No name or rig specified for new_TEMP()!") unless ($name && $rig);
    my $type = $rig->get_cv('TControl_'.$name,'controler_type');
    $type = $rig->get_cv($name,'controler_type') if ($name eq 'temperature'); ## Backwards compatibility ##
    $type = shift if (@_);
    $type = 'E2216' unless ($type); ## Default Eurotherm 2216e ##
    if ($type && $type =~ /Honeywell/)
    {
	$id = RFC::Honeywell->new($name,$rig);
    }
    elsif($type && $type =~ /Julabo/)
    {
	$id = RFC::Julabo->new($name,$rig);
    }
    else
    {
	$id = RFC::TempControl->new($name,$rig,$type);
    }
    die "No temperature controler id returned!" unless ($id);
    return $id;
}

sub list_TEMP()
{
    return ('Honeywell','Julabo',Eurotherm::get_list(),RFC::OmronTemp::get_list(),RFC::CalTemp::get_list());
}

sub new_Multiplexer
{
    my $rig = shift;
    my $name = shift;
    my $id = undef;
    my $type = shift;
    $type = $rig->get_cv('gas_multiplexer_'.$name,'type') unless ($type);
    $type = 'Relay' unless ($type);
    die errorlog("No name, rig or type specified for new_Multiplexer()!") unless ($name && $rig && $type);
    $_ = $type;
  CASE:
    {
	/^Slave$/i and do {$id = RFC::Multiplex_slave->new($name,$rig,@_); last CASE;};
	/^ICP$/i and do {$id = RFC::Multiplex->new($name,$rig,@_); last CASE;};
	/^VICI$/i and do {$id = RFC::VICI->new($name,$rig,@_); last CASE;};
	/^Relay$/i and do {$id = RFC::Multiplex->new($name,$rig,@_); last CASE;};
	/^Selector/i and do {$id = RFC::Selector->new($name,$rig,@_); last CASE;};
    }
    die "No multiplexer found matching type $type!" unless ($id);
    return $id;
}

sub list_Multiplexer()
{
    return ('Relay','VICI','Slave','Selector');
}

sub new_MFC
{
    my $rig = shift;
    my $name = shift;
    die errorlog("No name or rig specified for new_MFC()!") unless ($name && $rig);
    my $type = $rig->get_cv('controler_'.$name,'type');
    $type = shift if (@_);
    $type = 'Manual' unless (defined($type));
    my $id = undef;
    $_ = $type;
  CASE:
    {
	/VacuumControl_RVC300/ and do {$id = RFC::VacuumControl_RVC300->new($name,$rig); last CASE;};
	/Vacuum_Manual/ and do {$id = RFC::VacuumControl->new($name,$rig); last CASE;};
	/Pc_ER3000/ and do {$id = RFC::Pcontrol_ER3000->new($name,$rig); last CASE;};
	/Pc_AnalogReadonly/ and do {$id = RFC::Pcontrol_AnalogReadonly->new($name,$rig); last CASE;};
	/Pc_Analog/ and do {$id = RFC::Pcontrol_Analog->new($name,$rig); last CASE;};
	/Pc_Manual/ and do {$id = RFC::Pcontrol->new($name,$rig); last CASE;};
	/Manual/i and do {$id = RFC::MFC->new($name,$rig); last CASE;};
	/AnalogReadonly/i and do {$id = RFC::AnalogReadonly->new($name,$rig); last CASE;};
	/Analog/i and do {$id = RFC::Analog->new($name,$rig); last CASE;};
	/BrooksReadonly/i and do {$id = RFC::BrooksReadonly->new($name,$rig); last CASE;};
	/Brooks/i and do {$id = RFC::Brooks->new($name,$rig); last CASE;};
	/MKSReadonly/i and do {$id = RFC::MKSReadonly->new($name,$rig); last CASE;};
	/MKS/i and do {$id = RFC::MKS->new($name,$rig); last CASE;};
        ### For backwards compatibility only ###
	/^ICP$/i and do {$id = RFC::Analog->new($name,$rig); last CASE;}; 
    }
    die "No MFC/Pcontrol found matching type $type!" unless ($id);
    return $id;
}

sub list_MFC()
{
    return ('Manual','Brooks','BrooksReadonly','Analog','AnalogReadonly','MKS','MKSReadonly','Pc_ER3000','Pc_Analog','Pc_AnalogReadonly','Pc_Manual','VacuumControl_RVC300');
}

sub new_RELAY
{
    my $rig = shift;
    my $name = shift;
    my $id = undef;
    die errorlog("No name or rig specified for new_RELAY()!") unless ($name && $rig);
    my $type = $rig->get_cv('relay_'.$name,'type');
    $type = 'ICP' unless ($type);
    $type = shift if (@_);
    $_ = $type;
  CASE:
    {
	/^ICP$/i and do {$id = RFC::ICPRelay->new($name,$rig,@_); last CASE;};
	/^ICPDI$/i and do {$id = RFC::ICPDI->new($name,$rig,@_); last CASE;};
	/^Manual/i and do {$id = RFC::ManualRelay->new($name,$rig,@_); last CASE;};
	/^Monostable$/ and do {$id = RFC::Monostable->new($name,$rig,@_); last CASE;};
	/^Monostable-PWM/ and do {$id = RFC::PWM_Mono->new($name,$rig,@_); last CASE;};
    }
    die "No relay found matching type $type!" unless ($id);
    return $id;
}

sub list_RELAY()
{
    return ('ICP','ICPDI','ManualRelay','Monostable','Monostable-PWM');
}

sub new_SimpleChannel
{
    my $rig = shift;
    my $name = shift;
    my $type = undef;
    $type = $rig->get_cv('channel_'.$name,'type');
    $type = 'Keithley' unless ($type);
    $type = shift if (@_);
    my $id = undef;
    die errorlog("No type or rig specified for new_SimpleChannel()!") unless ($name && $rig);
    $_ = $type;
  CASE:
    {
	/Keithley580/ and do {$id = RFC::KeithleyMOM->new($name,$rig,@_); last CASE;};
	/Keithley/i and do {$id = RFC::Keithley->new($name,$rig,@_); last CASE;};
	/ICP7017ZW/i and do {$id = RFC::SimpleICP7017ZW->new($name,$rig,@_); last CASE;};
	/ICP7017/i and do {$id = RFC::SimpleICP7017->new($name,$rig,@_); last CASE;};
	/ICP7019/i and do {$id = RFC::SimpleICP7019->new($name,$rig,@_); last CASE;};
	/ICP/i and do {$id = RFC::SimpleICP->new($name,$rig,@_); last CASE;};
	/ModbusTCP/i and do {$id = RFC::ModbusTCP->new($name,$rig,@_); last CASE;};
	/Modbus/i and do {$id = RFC::SimpleModbus->new($name,$rig,@_); last CASE;};
	/PLCRead/i and do {$id = RFC::PLCRead->new($name,$rig,@_); last CASE;};
	/External/i and do {$id = RFC::SimpleExternal->new($name,$rig); last CASE;};
	/Socket/i and do {$id = RFC::SimpleSocket->new($name,$rig); last CASE;};
	/SOAP/i and do {$id = RFC::SimpleSOAP->new($name,$rig); last CASE;};
    }
    die "No simple channel found matching type $type!" unless ($id);
    return $id;
}

sub list_SimpleChannel()
{
    return ('Keithley','Keithley580','ICP','ICP7017/18','ICP7017ZW','ICP7019','ModbusTCP','Modbus','PLCRead','External','Socket','SOAP');
}

sub new_Water
{
    my $rig = shift;
    my $name = shift;
    my $type = undef;
    $type = $rig->get_cv('channel_'.$name,'type');
    $type = 'Water' unless ($type);
    $type = shift if (@_);
    my $id = undef;
    die errorlog("No type or rig specified for new_water()!") unless ($name && $rig);
    $_ = $type;
  CASE:
    {
	/Water/i and do {$id = RFC::Water->new($name,$rig,@_); last CASE;};
    }
    die "No water bublers found matching type $type!" unless ($id);
    return $id;
}

sub list_Water()
{
    return ('Water');
}

sub new_Templog
{
    my $rig = shift;
    my $name = shift;
    my $type = undef;
    $type = $rig->get_cv('temp_'.$name,'type');
    $type = 'Analog' unless ($type);
    $type = $_[0] if (@_);
    my $id = undef;
    die errorlog("No type or rig specified for new_Templog()!") unless ($name && $rig);
    foreach my $t (&list_TEMP)
    {
	### If type matches one of the types returned by the Eurotherm class, assume controler ###
	### is digital and assign a EuroLog instance                                           ###
	$id = RFC::EuroLog->new($name,$rig,@_) if ($t eq $type);
    }
    ### Assume that temp channel is normal analog if not found abov e ###
    $id = RFC::Templog->new($name,$rig,@_) unless ($id);
    return $id;
}

sub list_Templog()
{
    return ('Analog',Eurotherm::get_list());
}


sub new_PSU
{
    my $rig = shift;
    my $name = shift;
    my $type = shift;
    $type = 'SM_15_100' unless ($type);
    my $id = undef;
    if ($type)
    {
	$_ = $type;
      CASE:
	{
	    /DefaultDelta/i and do {$id = RFC::DefaultDelta->new($name,$rig,@_); last CASE;};
	    /ManualPSU/i and do {$id = RFC::ManualPSU->new($name,$rig,@_); last CASE;};
	    /BKPrecision/i and do {$id = RFC::BKPrecision->new($name,$rig,@_); last CASE;};
	    /PSU_Bipolar/ and do {$id = RFC::PSU_Bipolar->new($name,$rig,@_); last CASE;};
	    /PSU_B2N/ and do {$id = RFC::PSU_B2N->new($name,$rig,@_); last CASE;};
	    /PSU_N2B/ and do {$id = RFC::PSU_N2B->new($name,$rig,@_); last CASE;};
	    /SM_15_100/i and do {$id = RFC::SM_15_100->new($name,$rig,@_); last CASE;};
	    /SM_18_50/i and do {$id = RFC::SM_18_50->new($name,$rig,@_); last CASE;};
	    /SM_60_100/i and do {$id = RFC::SM_60_100->new($name,$rig,@_); last CASE;};
	    /SM_35_45/i and do {$id = RFC::SM_35_45->new($name,$rig,@_); last CASE;};
	    /SM_52_30/i and do {$id = RFC::SM_52_30->new($name,$rig,@_); last CASE;};
	    /SM_70_22/i and do {$id = RFC::SM_70_22->new($name,$rig,@_); last CASE;};
	    /SM_120_13/i and do {$id = RFC::SM_120_13->new($name,$rig,@_); last CASE;};
	    /SM_300_5/i and do {$id = RFC::SM_300_5->new($name,$rig,@_); last CASE;};
	    /SM_30_200/i and do {$id = RFC::SM_30_200->new($name,$rig,@_); last CASE;};
	    /ES015_10/i and do {$id = RFC::ES015_10->new($name,$rig,@_); last CASE;};
	    /ES030_5/i and do {$id = RFC::ES030_5->new($name,$rig,@_); last CASE;};
	    /ES075_2/i and do {$id = RFC::ES075_2->new($name,$rig,@_); last CASE;};
	    /ES0300_045/i and do {$id = RFC::ES0300_045->new($name,$rig,@_); last CASE;};
	    /EL_9080_200_HP/ and do {$id = RFC::EL_9080_200_HP->new($name,$rig,@_); last CASE;};
	    /EL_9160_100_HP/ and do {$id = RFC::EL_9160_100_HP->new($name,$rig,@_); last CASE;};
	    /EL_9400_50_HP/ and do {$id = RFC::EL_9400_50_HP->new($name,$rig,@_); last CASE;};
	    /EL_9750_50_HP/ and do {$id = RFC::EL_9750_50_HP->new($name,$rig,@_); last CASE;};
	    /EL_9080_200$/ and do {$id = RFC::EL_9080_200_HP->new($name,$rig,@_); last CASE;};
	    /EL_9160_100$/ and do {$id = RFC::EL_9160_100_HP->new($name,$rig,@_); last CASE;};
	    /EL_9400_50$/ and do {$id = RFC::EL_9400_50->new($name,$rig,@_); last CASE;};
	    /EL_9750_50$/ and do {$id = RFC::EL_9750_50->new($name,$rig,@_); last CASE;};
	    /EL_9080_600_HP/ and do {$id = RFC::EL_9080_600_HP->new($name,$rig,@_); last CASE;};
	    /EL_9160_300_HP/ and do {$id = RFC::EL_9160_300_HP->new($name,$rig,@_); last CASE;};
	    /EL_9400_150_HP/ and do {$id = RFC::EL_9400_150_HP->new($name,$rig,@_); last CASE;};
	    /EL_9080_600$/ and do {$id = RFC::EL_9080_600_HP->new($name,$rig,@_); last CASE;};
	    /EL_9160_300$/ and do {$id = RFC::EL_9160_300_HP->new($name,$rig,@_); last CASE;};
	    /EL_9400_150$/ and do {$id = RFC::EL_9400_150_HP->new($name,$rig,@_); last CASE;};
	    /EL_9750_75$/ and do {$id = RFC::EL_9750_75->new($name,$rig,@_); last CASE;};
	    /EL_9750_75_HP/ and do {$id = RFC::EL_9750_75_HP->new($name,$rig,@_); last CASE;};
	    /EL_3160_60A$/ and do {$id = RFC::EL_3160_60A->new($name,$rig,@_); last CASE;};
	    /EL_3400_25A$/ and do {$id = RFC::EL_3400_25A->new($name,$rig,@_); last CASE;};
	    /EL_9080_200$/ and do {$id = RFC::EL_9080_200->new($name,$rig,@_); last CASE;};
	    /EL_9160_100$/ and do {$id = RFC::EL_9160_100->new($name,$rig,@_); last CASE;};
	    /EL_9400_50_S01$/ and do {$id = RFC::EL_9400_50_S01->new($name,$rig,@_); last CASE;};
	    /EL_9750_25$/ and do {$id = RFC::EL_9750_25->new($name,$rig,@_); last CASE;};
	    /EL_9080_400$/ and do {$id = RFC::EL_9080_400->new($name,$rig,@_); last CASE;};
	    /EL_9400_100$/ and do {$id = RFC::EL_9400_100->new($name,$rig,@_); last CASE;};
	    /EL_9160_200$/ and do {$id = RFC::EL_9160_200->new($name,$rig,@_); last CASE;};
	    /EL_9400_100_S01$/ and do {$id = RFC::EL_9400_100_S01->new($name,$rig,@_); last CASE;};
	    /EL_9750_50$/ and do {$id = RFC::EL_9750_50->new($name,$rig,@_); last CASE;};
	    /Kepco_BOP_50_20MG/ and do {$id = RFC::Kepco_BOP_50_20MG->new($name,$rig,@_); last CASE;};
	    /Keithley2400/ and do {$id = RFC::Keithley2400->new($name,$rig,@_); last CASE;};
	    /PSUMulti/ and do {$id = RFC::PSUMulti->new($name,$rig,@_); last CASE;};
	    /Hocherl_ZS/ and do {$id = RFC::Hocherl_ZS->new($name,$rig,@_); last CASE;};
        /HMP/ and do {$id = RFC::HMP->new($name,$rig,@_); last CASE;};
	}
    }
    else
    {
	### Backwards compatib mode, uses SM 15-100 ##
	$id = RFC::DefaultDelta->new($name,$rig);
    }
    die "No PSU found matching type $type!" unless ($id);
    return $id;
}


sub list_PSU()
{
    return ('ManualPSU','SM_15_100','SM_18_50','SM_60_100','SM_35_45','SM_52_30','SM_70_22','SM_120_13','SM_300_5','SM_30_200','ES015_10','ES030_5','ES075_2','ES0300_045','EL_9080_200','EL_9160_100','EL_9400_50','EL_9750_50','EL_9080_200_HP','EL_9160_100_HP','EL_9400_50_HP','EL_9750_50_HP','EL_9080_600','EL_9160_300','EL_9400_150','EL_9750_75','EL_9080_600_HP','EL_9160_300_HP','EL_9400_150_HP','EL_9750_75_HP','EL_3160_60A','EL_3400_25A','EL_9080_200','EL_9160_100','EL_9400_50','EL_9400_50_S01','EL_9750_25','EL_9080_400','EL_9160_200','EL_9400_100','EL_9400_100_S01','EL_9750_50','PSU_Bipolar','PSU_B2N','PSU_N2B','Kepco_BOP_50_20MG','Keithley2400','PSUMulti','BKPrecision','Hocherl_ZS','HMP');
}


sub new_AnalogOut
{
    my $rig = shift;
    my $name = shift;
    my $type = shift;
    $type = $rig->get_cv('analog_out_'.$name,'type') unless ($type);
    $type = 'ICP87024' unless ($type);
    my $id = undef;
    if ($type)
    {
	$_ = $type;
      CASE:
	{
	    /ICP87024/i and do {$id = RFC::AnalogICP87024->new($name,$rig,@_); last CASE;};
	    /ICP87028/i and do {$id = RFC::AnalogICP87028->new($name,$rig,@_); last CASE;};
	    /ICP7024/i and do {$id = RFC::AnalogICP87024->new($name,$rig,@_); last CASE;};
	    /ManualAnalogOut/i and do {$id = RFC::ManualAnalogOut->new($name,$rig,@_); last CASE;};
	}
    }
    die "No analog output found matching type $type!" unless ($id);
    return $id;
}

sub list_AnalogOut
{
    return ('ICP7024','ICP87024','ICP87028','ManualAnalogOut');
}
