#!/usr/bin/perl -w
#$Id: cgi_service.cgi,v 1.15 2019/02/08 12:02:10 sqko Exp $
use strict;
use warnings;
use Data::Dumper;
use Pod::WSDL;
use SOAP::Transport::HTTP;

my $server = SOAP::Transport::HTTP::CGI
    -> dispatch_to('CGIserver')
    -> handle;

package CGIserver;
use RFC::Header;
use RFC::Main;
use RFC::Rig;
use RFC::RFCCGI;
use Sys::Hostname;
use IO::Socket::INET;
use LWP::UserAgent;
use URI::Escape;
use vars qw(@ISA);
@ISA = qw(SOAP::Server::Parameters);

=begin WSDL
_DOC Returns the hostname of the server
_RETURN $string
=end WSDL

=cut

sub ping()
{
    my $class = shift;
    return SOAP::Data->new(name=>'result',value=>hostname(),type=>'string');
}


=begin WSDL
_DOC Appends the supplied information to the command log
_IN rig $int Rig number
_IN comment $string Text to be_appended
_RETURN $string
=end WSDL

=cut

sub cmdlog
{
    my $class = shift;
    my $rig = shift;
    my $str = shift;
    my $r = RFC::Rig->new($rig);
    my $res = $r->proglog("Remote message from $ENV{REMOTE_ADDR}: ".$str,$0);
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}

=begin WSDL
_DOC Appends the supplied information to the rigs logbook
_IN rig $int Rig number
_IN comment $string Text to be appended
_RETURN $string
=end WSDL

=cut

sub logbook
{
    my $class = shift;
    my $r = shift;
    my $str = shift;
    my $rig = RFC::Rig->new($r);
    my $f = $RFC::Header::publicdir.'rig'.$rig->name.'/logbook.txt';
    my $l = $rig->riglock; 
    my $file = SemaforeFile->new($f,$l);
    my $dot_addr = $ENV{REMOTE_ADDR};
    $file->append("Remote message from $dot_addr: ".$str);
    my $res = $rig->proglog("Remote message from $dot_addr: ".$str,$0);
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}





=begin WSDL
_DOC Notifies the RFCcontrol rig that the requested timeslot has started.
_IN rig $int Rig number
_RETURN $string
=end WSDL

=cut

sub timeslot_begin
{
    my $class = shift;
    my $rig = shift;
    my $res = &CGI_client($rig,'timeslot_begin');
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}


=begin WSDL
_DOC Notifies the RFCcontrol rig that the requested timeslot has ended.
_IN rig $int Rig number
_RETURN $string
=end WSDL

=cut

sub timeslot_end
{
    my $class = shift;
    my $rig = shift;
    my $res = &CGI_client($rig,'timeslot_end');
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}

=begin WSDL
_DOC Notifies the RFCcontrol rig that the requested remote impednace measruement has finished.
_IN rig $int Rig number
_IN address $string IP address
_IN username $string Username
_IN mode $string Mode
_IN sessionnr $int Session nr
_IN fileid $int File id
_RETURN $boolean
=end WSDL

=cut


sub impedance_ok
{
    my $class = shift;
    my $rig = shift;
    $rig =~ /(\d+)/;
    $rig = $1;
    my $res = &CGI_client($rig,'impedance_ok',@_);
    return SOAP::Data->new(name=>'result',value=>1,type=>'boolean');
}




=begin WSDL
_DOC Initiates a new login session, returns the sesison hash if succesfull
_IN username $string Username
_IN passwd $string Password
_RETURN $string
=end WSDL

=cut

sub new_session
{
    my $class = shift;
    my $name = shift;
    my $pass = shift;
    my $res = RFC::Main::passwd_client('new_session',$name,$pass);
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}


=begin WSDL
_DOC Logs out the specified user
_IN username $string Username
_RETURN $string
=end WSDL

=cut

sub logout_user
{
    my $class = shift;
    my $name = shift;
    my $res = RFC::Main::passwd_client('logout_user',$name);
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}


=begin WSDL
_DOC Checks if user has a valid session, returns the usrid if so, 0 otherwise
_IN username $string Username
_IN session $string Session hash
_RETURN $int
=end WSDL

=cut

sub checkuser
{
    my $class = shift;
    my $name = shift;
    my $session = shift;
    my $res = RFC::Main::passwd_client('checkuser',$name,$session);
    $res = 0 unless ($res && $res > 0);
    return SOAP::Data->new(name=>'result',value=>$res,type=>'integer');
}



=begin WSDL
_DOC Checks if user has a valid session and is authorised for the rig
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_RETURN $boolean
=end WSDL

=cut

sub rig_auth
{
    my $class = shift;
    my $name = shift;
    my $session = shift;
    my $r = shift;
    my $res = RFC::Main::passwd_client('checkuser',$name,$session);
    $res = 0 unless ($res && $res > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$name));
    return SOAP::Data->new(name=>'result',value=>$res,type=>'boolean');
}


=begin WSDL
_DOC Checks if user has a valid session and is certified for the rig
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_RETURN $boolean
=end WSDL

=cut

sub rig_cert
{
    my $class = shift;
    my $name = shift;
    my $session = shift;
    my $r = shift;
    my $res = RFC::Main::passwd_client('checkuser',$name,$session);
    $res = 0 unless ($res && $res > 0 && RFC::RFCCGI::rig_cert_nocgi($r,$name));
    return SOAP::Data->new(name=>'result',value=>$res,type=>'boolean');
}


=begin WSDL
_DOC This function runs the specified device member function. 
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
The function_args variable is a comma separated list of arguments to the function to be called, may be empty for functions without arguments.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_IN type $string Devicetype
_IN name $string Devicename
_IN function $string Function name
_IN args $string Function arguments, separate with comma
_RETURN @string
=end WSDL

=cut

sub run_device_function
{
    my $class = shift;
    my $rid = shift;
    my $session = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$rid,$session);
    my $r = shift;
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$rid))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $type = shift;
    my $name = shift;
    my $function = shift;
    my $args = shift;
    my @res = ();
    eval {
	my $rig = RFC::Rig->new($r);
	my $dev = $rig->init_device($type,$name);
	die "Error: No device returned from init_device()\n" unless $dev;
	if ($args)
	{
	    @res = $dev->$function(split(/\s*\,\s*/,$args));
	}
	else
	{
	    @res = $dev->$function();
	}
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not complete function call $function on device $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    my @list = ();
    foreach my $i (@res)
    {
	my $d = SOAP::Data->new(name=>'result',type=>'string',value=>$i);
	push @list,$d;
    }
    return @list;
}


=begin WSDL
_DOC This function returns the current value for the device specified. 
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications.
_IN rig $int Rig number
_IN type $string Device type
_IN name $string Device name
_RETURN $decimal
=end WSDL

=cut

sub read
{
    my $class = shift;
    my $r = shift;
    my $type = shift;
    my $name = shift;
    my $res;
    eval {
	my $rig = RFC::Rig->new($r);
	my $dev = $rig->init_device($type,$name);
	die "Error: No device returned from init_device()\n" unless $dev;
	$res = $dev->read();
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not read device $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'value',value=>$res,type=>'decimal');
}

=begin WSDL
_DOC This function returns the device control mode
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications.
_IN rig $int Rig number
_IN type $string Device type
_IN name $string Device name
_RETURN $string
=end WSDL

=cut

sub mode
{
    my $class = shift;
    my $r = shift;
    my $type = shift;
    my $name = shift;
    my $res;
    eval {
	my $rig = RFC::Rig->new($r);
	my $dev = $rig->get_device($type,$name);
	die "Error: No device returned from get_device()\n" unless $dev;
	$res = $dev->mode();
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not get device mode for $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'value',value=>$res,type=>'string');
}

=begin WSDL
_DOC This function returns true if an i-V curve is running on the specified rig
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN rig $int Rig number
_RETURN $boolean
=end WSDL

=cut

sub is_iv
{
    my $class = shift;
    my $res = 0;
    my $r = shift;
    eval {
	my $rig = RFC::Rig->new($r);
	$res = 1 if ($rig->is_iv());
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not get i-V curve status: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'value',value=>$res,type=>'boolean');
}

=begin WSDL
_DOC This function starts an i-V curve on the specified rig
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_RETURN $boolean
=end WSDL

=cut

sub start_iv
{
    my $class = shift;
    my $rid = shift;
    my $session = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$rid,$session);
    my $r = shift;
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$rid))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $res;
    eval {
	$res = CGI_client($r,'iv');
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not append text to info file: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'value',value=>$res,type=>'string');
}

=begin WSDL
_DOC This function stops anny running i-V curve on the specified rig.
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_RETURN $decimal
=end WSDL

=cut

sub stop_iv
{
    my $class = shift;
    my $rid = shift;
    my $session = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$rid,$session);
    my $r = shift;
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$rid))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $res;
    eval {
	$res = CGI_client($r,'stop_iv');
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not append text to info file: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'value',value=>$res,type=>'string');
}


=begin WSDL
_DOC This function appends the specified information to the info file. 
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_IN text $string text to be appended
_RETURN $boolean
=end WSDL

=cut

sub add_info
{
    my $class = shift;
    my $rid = shift;
    my $session = shift;
    my $r = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$rid,$session);
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$rid))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $text = shift;
    my $res;
    eval {
	my $rig = RFC::Rig->new($r);
	my $time = localtime();
	my $str = $time.', User '.$rid.' added: '.$text."\n";
	$res = $rig->info($str);
	if ($res)
	{
	    $res = 1;
	}
	else
	{
	    $res = 0;
	}
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not append text to info file: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'value',value=>$res,type=>'boolean');
}




=begin WSDL
_DOC This function set the flowrate for the specified gas. 
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_IN name $string Device name
_IN flow $decimal Flowrate
_RETURN $decimal
=end WSDL

=cut

sub set_gas
{
    my $class = shift;
    my $rid = shift;
    my $session = shift;
    my $r = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$rid,$session);
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$rid))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $name = shift;
    my $flow = shift;
    my $res;
    eval {
	my $rig = RFC::Rig->new($r);
	my $dev = $rig->get_device('gas',$name);
	die "Error: No device returned from get_device()\n" unless $dev;
	$res = $dev->setflow($flow,$rid);
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not set gas flow for $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'decimal');
}


=begin WSDL
_DOC This function set the selected gas for the specified gas multiplexer. 
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_IN name $string Device name
_IN gas $string Gas name
_RETURN $string
=end WSDL

=cut

sub set_multiplex
{
    my $class = shift;
    my $user = shift;
    my $session = shift;
    my $r = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$user,$session);
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$user))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $name = shift;
    my $gas = shift;
    my $res;
    eval {
	my $rig = RFC::Rig->new($r);
	my $d = $rig->get_device('multiplex',$name);
	die "Error: No device returned from get_device()\n" unless $d;
	$res = $d->set($gas,$user);
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not set gas for multiplexer $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}


=begin WSDL
_DOC This function set the setpoint for the specified PID device. Returns the new setpoint if succesfull. 
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_IN name $string Device name
_IN setpoint $decimal Setpoint
_IN ramprate $decimal Ramprate, only used if device has a ramprate defined
_RETURN $decimal
=end WSDL

=cut

sub set_pid
{
    my $class = shift;
    my $user = shift;
    my $session = shift;
    my $r = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$user,$session);
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$user))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $name = shift;
    my $flow = shift;
    my $ramp = shift;
    my $res;
    eval {
	my $rig = RFC::Rig->new($r);
	my $d = $rig->get_device('PID',$name);
	die "Error: No device returned from get_device()\n" unless $d;
	my $f = $d->set($flow,$user);
	if ($d->has_ramp)
	{
	    $d->set_ramp($ramp,$user);
	}
	die "Setpoint for PID regulator $name could not be set to $flow for $rig\n" unless ($f == $flow);
	$res = $flow;
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not set PID device $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'decimal');
}

=begin WSDL
_DOC Sets the DC current for the specified PSU
The current is either a floating point number or the string 'ocv' for open circuit conditions
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_IN name $string Device name
_IN current $string Current
_RETURN $decimal
=end WSDL

=cut

sub set_current
{
    my $class = shift;
    my $rid = shift;
    my $session = shift;
    my $r = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$rid,$session);
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$rid))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $name = shift;
    my $flow = shift;
    my $res;
    eval {
	my $rig = RFC::Rig->new($r);
	my $dev = $rig->get_device('PSU',$name);
	die "Error: No device returned from get_device()\n" unless $dev;
	$res = $dev->current($flow,$rid);
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not set current for $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'decimal');
}

=begin WSDL
_DOC Sets the DC voltage for the specified PSU
The voltage is either a floating point number or the string 'ocv' for open circuit conditions
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_IN name $string Device name
_IN voltage $string Voltage
_RETURN $decimal
=end WSDL

=cut

sub set_voltage
{
    my $class = shift;
    my $rid = shift;
    my $session = shift;
    my $r = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$rid,$session);
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$rid))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $name = shift;
    my $flow = shift;
    my $res;
    eval {
	my $rig = RFC::Rig->new($r);
	my $dev = $rig->get_device('PSU',$name);
	die "Error: No device returned from get_device()\n" unless $dev;
	$res = $dev->voltage($flow,$rid);
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not set voltage for $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'decimal');
}



=begin WSDL
_DOC This function set the relay to the specified value. 
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_IN name $string Device name
_IN status $boolean Status 
_RETURN $boolean
=end WSDL

=cut

sub set_relay
{
    my $class = shift;
    my $rid = shift;
    my $session = shift;
    my $r = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$rid,$session);
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$rid))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $name = shift;
    my $status = shift;
    my $res;
    eval {
	my $rig = RFC::Rig->new($r);
	my $dev = $rig->get_device('relay',$name);
	die "Error: No device returned from get_device()\n" unless $dev;
	$res = $dev->set($status,$rid);
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not set relay $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'boolean');
}



=begin WSDL
_DOC This function set the temperature and ramprate for the specified tempcontrol device. 
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_IN name $string Device name
_IN setpoint $decimal Setpoint
_IN ramprate $decimal Ramprate
_RETURN $string
=end WSDL

=cut

sub set_temp
{
    my $class = shift;
    my $user = shift;
    my $session = shift;
    my $r = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$user,$session);
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$user))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $name = shift;
    my $temp = shift;
    my $ramp = shift;
    my $res;
    eval {
	my $rig = RFC::Rig->new($r);
	my $d = $rig->get_device('tempcontrol',$name);
	die "Error: No device returned from get_device()\n" unless $d;
	my $t = $d->set_temp($temp,$user);
	die "Could not set temperature for $d on $rig\n" unless (defined($t));
	$res = "Temperature set to $temp C";
	if ($d->has_ramp)
	{
	    my $rr = $d->set_ramp($ramp,$user);
	    die "Could not set ramprate on $d for $rig\n" unless (defined($rr));
	    $res .= "\nand ramprate set to $ramp C/hour for $rig";
	}
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not set tempcontrol device $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}



=begin WSDL
_DOC This function set the temperature and ramprate for the specified tempcontrol device. 
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN rig $int Rig number
_IN type $string Device type
_IN name $string Device name
_RETURN $decimal
=end WSDL

=cut

sub get_ramprate
{
    my $class = shift;
    my $r = shift;
    my $type = shift;
    my $name = shift;
    my $res = 0;
    eval {
	my $rig = RFC::Rig->new($r);
	my $d = $rig->get_device($type,$name);
	die "Error: No device returned from get_device()\n" unless $d;
	$res = $d->get_ramp() if ($d->has_ramp());
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not set tempcontrol device $name: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'decimal');
}


=begin WSDL
_DOC Start a new test on the target rig
It can be used for complete remote control of an RFCcontrol rig instance and thus may be used by third party applications in conjunction with new_session.
_IN username $string Username
_IN session $string Session hash
_IN rig $int Rig number
_IN sample $string Sample name/id
_IN holder $string Sample holder name/id
_IN project $string Projectid
_IN info $string Sample_info
_IN testplan $string Test_plan
_IN comments $string Comments
_RETURN $int
=end WSDL

=cut

sub start_new_test
{
    my $class = shift;
    my $user = shift;
    my $session = shift;
    my $r = shift;
    my $uid = RFC::Main::passwd_client('checkuser',$user,$session);
    unless ($uid && $uid > 0 && RFC::RFCCGI::rig_auth_nocgi($r,$user))
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring('Error: User not authenticated')
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');	
    }
    my $sample = shift;
    my $holder = shift;
    my $project = shift;
    my $info = shift;
    my $plan = shift;
    my $comments = shift;
    my $res = '';
    foreach ($sample,$holder,$project,$info,$plan,$comments)
    {
	$_ = '' unless defined($_);
    }
    eval {
	my $account_reg = get_cv('global','account_number_regexp');
	$account_reg = '\w+' unless ($account_reg);
	die "Project number not in correct format: '".$account_reg."\n'" unless ($project && $project =~ /$account_reg/);
	my $rig = RFC::Rig->new($r);
        my $str = "Test house                  : $holder\n";
        $str .= "Alternate test numbers      : $sample\n";
        $str .= "                            : \n";
        $str .= "                            : \n\n";
        $str .= "Sample number               : $sample\n";
        $str .= "Anode current collector     : \n";
        $str .= "Cathode current collector   : \n";
        $str .= "Sealant on anode side       : \n";
        $str .= "Sealant on cathode          : \n\n";
        $info =~ s/\n/ /g;
        $str .= "Sample information          : $info\n\n";
        $plan =~ s/\n/ /g;
        $str .= "Test plan                   : $plan\n\n";
        $str .= "Additional test information : $comments\n\n";
        #### Report script strings ####
        $str .= '#############################################################'."\n";
        $str .= '####################### Report information ##################'."\n";
        $str .= '#############################################################'."\n";
        $str .= 'KEYWORDS # '.$info."\n";
        $str .= 'TESTPLAN # '.$plan."\n";
        $project =~ s/\n/ /g;
        $str .= 'PROJECT # '.$project."\n";
        $str .= '#############################################################'."\n";
        $str .= '####################### END information    ##################'."\n";
        $str .= '#############################################################'."\n";
        $str .= "\n";
	my $msg = $str;
	$res = $rig->inc_test($str,$user);
	my $time = localtime();
	my $inf = $RFC::Header::homedir.'info_table.txt';
	$str = "$time  ".$rig->name.'test'.$res."  $sample\n";
	### Remove hash marks from string (as they messes up the search system)
	$str =~ s/\#/\_/g;
	open INF , '>>' , $inf or die "Could not open info file $inf!";
	print INF $str;
	close INF;
	### Append to remote logbook ##
	$msg = 'New test started: '.$msg.$str;
	my $encode = uri_escape($msg);
	my $eqid = $rig->get_cv('main','equipmentid');
	$eqid = 0 unless ($eqid);
	my $eqadr = get_cv('global','remote_equipment_database');
	return unless ($eqid && $eqadr);
	my $ua = LWP::UserAgent->new();
	$ua->timeout(60);
	my $url = $eqadr;
	my $query = '?name='.$user.'&pass='.$session.'&action=new_maint_log&type=Riglog&equipid='.$eqid.'&description='.$encode;
	my $request = new HTTP::Request('GET',$url.$query);
	my $response = $ua->request($request);
    };
    if ($@)
    {
	return SOAP::Fault->faultcode('Server error')
            ->faultstring("Error: Could not start new test on rig $r: ".$@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/CGIserver');
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}





