#!/usr/bin/perl
# $Id: custom_prog.pl,v 1.83 2026/05/18 06:46:28 sqko Exp $
$SIG{INT} = \&my_sigint;
use strict;
use warnings;
use RFC::Main;
use RFC::Rig;
use File::Copy;
use SemaforeFile;
use IO::Interface::Simple;
use SocketClient;
use POSIX qw /floor/;
use SOAP::Lite;
our @SOAP_ERRORS = ();
our %soap = ();
our %soapimp = ();
my $PROGRAM = $0;
if (scalar(@ARGV) < 2)
{
    exit;
}
my $rig = RFC::Rig->new(shift);
$rig->check_run;
my $kidpid;

my $allow_exec = get_cv('global','allow_exec');
my $file = shift;
if (!-e($file))
{
    $rig->proglog("No file: $file found by $PROGRAM, exiting!",$PROGRAM);
    exit;
}

my $start_time = localtime();
my $email = undef;
if (@ARGV) 
{
    my $rid = shift;
    $email = RFC::Main::passwd_client('email',$rid) if ($rid);
}

my $f = SemaforeFile->new($file);
my @list = $f->readlines;


my @ilst = ('eth','em','en','lo');
my $local = '';
my @ifl = IO::Interface::Simple->interfaces();
OUTER:
foreach my $try (@ilst)
{
    foreach my $interface (@ifl)
    {
        if ($interface =~ /$try/)
        {
            my $if = IO::Interface::Simple->new($interface);
            $local = $if->address();
            last OUTER if ($local);
        }
    }
}

my $timeslot_wait = SemaforeFile->new('/home/celltest/Rig_'.$rig->name.'_timeslot_wait');
my $timeslot_start = SemaforeFile->new('/home/celltest/Rig_'.$rig->name.'_timeslot_start');
## Remove all previous timeslot lock files for vcleanup ##
foreach my $f ($timeslot_wait,$timeslot_start)
{
    unlink $f if (-e $f);
}

my $is_timeslot = 0;
my $tslot_addr = '';
my $linenr = 0;
my $count = 0;
my $str = '';
eval {
    foreach $str (@list)
    {
	$linenr++;
	$str =~ s/[\r\n]*//g;
	next if ($str =~ /^\s*\#/);
	next if ($str =~ /^\s*$/);
	last if ($str =~ /^\s*exit\s*$/);
	$count++;
	if ($str =~ /^\s*timeslot_start/) {&timeslot_start($str); next;};
	if ($str =~ /^\s*timeslot_end/) {&timeslot_end(); next;};
	if ($is_timeslot && !$timeslot_start->exist())
	{
	    $rig->proglog("WARNING! Command '$str' ignored as timeslot control semafore is missing!",$PROGRAM);
	    next;
	}
	if ($str =~ /^\s*socket\s+\d/){&socket_call($str); next;};
	if ($str =~ /^\s*gas:ramp:\w+\s+[\d\.]+/){&set_flow_ramp($str); next;};
	if ($str =~ /^\s*gas:\w+\s*\=\s*[\d\.]+/){&set_flow($str); next;};
	if ($str =~ /^\s*pressure:\w+\s*\=\s*[\d\.]+/){&set_pressure($str); next;};
	if ($str =~ /^\s*PID:\w+\s*\=\s*[\d\.\-eE]+/){&set_PID($str); next;};
	if ($str =~ /^\s*current:ramp:\w+\s+[\w\.]+/){&set_current_ramp($str);  next;};
	if ($str =~ /^\s*current\s*\=\s*[\w\.]+/){&set_current($str);  next;};
	if ($str =~ /^\s*voltage\s*\=\s*[\w\.]+[\s\t]+\w+/){&set_voltage($str);  next;};
	if ($str =~ /^\s*m_leak/){&m_leak;  next;};
	if ($str =~ /^\s*wait\s*\=\s*[\d\.]+/){&wait($str);  next;};
	if ($str =~ /^\s*iv\s*$/){&iv;  next;};
	if ($str =~ /^\s*ivwait\s*$/){&ivwait;  next;};
	if ($str =~ /^\s*text\s*\=/) {&cmdl($str);  next;};
	if ($str =~ /^\s*temp\s*\=/) {&temp($str);  next;};
	if ($str =~ /^\s*addjust_temp\s+/) {&addj_temp($str);  next;};
	if ($str =~ /^\s*ramp\s*\=/) {&ramp($str);  next;};
	if ($str =~ /^\s*killiv\s*/) {&killiv;  next;};
	if ($str =~ /^\s*measure\s*/) {&my_measure;  next;};
	if ($str =~ /^\s*c_step:\d+\s*\=\s*[\d\.]+/) {&c_step($str);  next;};
	if ($str =~ /^\s*c_limit\s*\=\s*[\d\.]+/) {&c_limit($str);  next;};
	if ($str =~ /^\s*v_limit\s*\=\s*[\d\.]+/) {&v_limit($str);  next;};
	if ($str =~ /^\s*e_limit\s*\=\s*[\d\.]+/) {&e_limit($str);  next;};
	if ($str =~ /^\s*ivpause\s*\=\s*[\d\.]+/) {&ivpause($str);  next;};
	if ($str =~ /^\s*impedance\s+[\w\-\.\:]+\s+\d+\s+[\w\.]+/) {&imp($str);  next;};
	if ($str =~ /^\s*potsweep\s+[\d\.\:]+\s+\d+\s+[\w\.]+/) {&cimp($str);  next;};
	if ($str =~ /^\s*chrono\s+[\d\.\:]+\s+\d+\s+[\w\.]+/) {&cimp($str);  next;};
	if ($str =~ /^\s*current_impedance\s+[\w\-\.\:]+\s+\d+\s+[\w\.]+/) {&cimp($str);  next;};
	if ($str =~ /^\s*change_channel\s+[\w\-\.\:]+\s+\w+\s+\d+/) {&change_channel($str);  next;};
	if ($str =~ /^\s*gas_multiplexer\s+(\d+)\s+(\w+)/) {&gasmultiplex($1,$2); next;};
	if ($str =~ /^\s*water:\w+\s*\=\s*\w+/) {&set_water($str); next;};
	if ($str =~ /^\s*relay:\w+\s*\=\s*\w+/) {&set_relay($str); next;};
	if ($str =~ /^\s*mail:/) {&mail($str); next;};
	if ($str =~ /^\s*exec:/) {&prog_exec($str); next;};
	if ($str =~ /^\s*function/) {&func($str); next;};
	if ($str =~ /^\s*wait_for_input:\s+\w+/) {&wait_input($str); next;};
    }
};
if ($@)
{
    $rig->errorlog("Runtime error on line $linenr! Command '$str' could not be completed, Errormessage: $@",$PROGRAM);
    $rig = undef;
    exit;
}
$rig->proglog("Program finished. $count commands executed!\n",$PROGRAM);
$rig = undef;
exit;


sub func($)
{
    my $str = shift;
    if ($str =~ /function\s+(\w+)\s+(\w+)\s+(\w+)\s*(.*)/)
    {
	my $type = $1;
	my $name = $2;
	my $func = $3;
	my $argstr = $4;
	my @args = ();
	if ($argstr)
	{
	    @args = split(/\s+/,$argstr);
	}
	my $dev = $rig->get_device($type,$name);
	if ($dev)
	{
	    my $res = '';
	    eval {
		{
		    no strict "refs";
		    $res = $dev->$func(@args);
		}
		$res = '' unless defined($res);
		chomp $res;
		$rig->proglog("Executed function '$func' on device '$name' of type '$type'; Result: '$res'",$PROGRAM);
	    };
	    if ($@)
	    {
		$rig->errorlog("Could not execute function '$func' on device '$name' of type '$type'; Error: ".$@,$PROGRAM);
	    }
	}
	else
	{
	    $rig->errorlog("Error when attempting to execute function '$func' on device '$name' of type '$type'; Error: 'Bo device instance returned by get_device()'");
	}
    }
}

sub socket_call($)
{
    my $str = shift;
    if ($str =~ /socket\s+([\w\-\.]+):(\d+)[\s\t]+([\w\s\.\t\-\+\:\;\'\"]+)$/)
    {
	my $host = $1;
	my $port = $2;
	my $args = $3;
	$args = '' unless (defined $args);
	eval {
	    my $res = SocketClient::socket_client($host,$port,split(/\t/,$args));
	    chomp $res;
	    $args =~ s/\t/,/g;
	    $rig->proglog("Result of socket call to $host:$port with arguments $args: $res",$PROGRAM);
	};
	if ($@)
	{
	    $rig->errorlog("Could not execute socket call to $host:$port: $@",$PROGRAM);
	}
    }
}


sub remote_soap_imp
{
    my $addr = shift;
    my $cmd = shift;
    my @args = @_;
    my $res;
    eval {
	my $saddr = $addr;
	$saddr =~  s/\:.*$//;
	my $wsdl = 'https://'.$saddr.'/wsdl/elchemea.wsdl';
	$soapimp{$saddr} = SOAP::Lite->on_fault(\&soapGetBad)->service($wsdl) unless ($soapimp{$saddr});
	$res = $soapimp{$saddr}->$cmd(@args);
    };
    if ($@)
    {
	## Fallback ##
	my $command = &get_cv('impedance','remote_client')." $addr $cmd ".join(' ',@args);
	$res = `$command`;
    }
    return $res;
}



sub remote_soap
{
    my $addr = shift;
    my $cmd = shift;
    my @args = @_;
    my $res;
    eval {
	my $saddr = $addr;
	$saddr =~  s/\:.*$//;
	my $wsdl = 'https://'.$saddr.'/wsdl/timeslot.wsdl';
	$soap{$saddr} = SOAP::Lite->on_fault(\&soapGetBad)->service($wsdl) unless ($soap{$saddr});
	$res = $soap{$saddr}->$cmd(@args);
    };
    if ($@)
    {
	## Fallback ##
	my $command = &get_cv('impedance','remote_client')." $addr $cmd ".join(' ',@args);
	$res = `$command`;
    }
    return $res;
}


sub timeslot_start($)
{
    if ($is_timeslot)
    {
	$rig->proglog("ERROR! You can not request a new time slot within an existing time slot!",$PROGRAM);
	return;
    }
    my $str = shift;
    if ($str =~ /timeslot_start\s+[\=\s]*([\w\.\-]+)\s+(\d+)\s(\d+)\s+(\w+)/)
    {
        my $host = $1;
        my $port = $2;
        my $time = $3*60;
        my $rigname = $4;
        my $address = $host.':'.$port;
        $tslot_addr = $address;
        my $res = &remote_soap($address,'add_item','timeslot',$time,$rigname,$local);
        $is_timeslot = -1;
        if ($res && $res =~ /^\s*(\d+)/)
        {
            $is_timeslot = $1;
            $timeslot_wait->writeline('');
            $rig->proglog("Waiting for time slot on shared resource...",$PROGRAM);
            sleep(10);
            while ($timeslot_wait->exist)
            {
                sleep(1);
            }
            $rig->proglog("Time slot started on shared resource for $rigname, proceeding with time locked commands!",$PROGRAM);
            sleep(1);
        }
        else
        {
            $rig->proglog("ERROR: Time slot could not be reserved on shared resource!",$PROGRAM);
        }
    }
    elsif ($str =~ /timeslot_start\s+[\=\s]*([\w\.\-]+)\s+(\d+)\s(\d+)/)
    {

	my $host = $1;
	my $port = $2;
	my $time = $3*60;
	my $address = $host.':'.$port;
	$tslot_addr = $address;
	my $res = &remote_soap($address,'add_item','timeslot',$time,'rig'.$rig->name,$local);
	$is_timeslot = -1;
	if ($res && $res =~ /^\s*(\d+)/)
	{
	    $is_timeslot = $1;
	    $timeslot_wait->writeline('');
	    $rig->proglog("Waiting for time slot on shared resource...",$PROGRAM);
	    sleep(10);
	    while ($timeslot_wait->exist)
	    {
		sleep(1);
	    }
	    $rig->proglog("Time slot started on shared resource, proceeding with time locked commands!",$PROGRAM);
	    sleep(1);
	}
	else
	{
	    $rig->proglog("ERROR: Time slot could not be reserved on shared resource!",$PROGRAM);
	}
    }
}

sub timeslot_end()
{
    $rig->proglog("Exiting time locked commands!",$PROGRAM);
    $timeslot_start->lock_ex();
    unlink $timeslot_start->filename() if ($timeslot_start->exist());
    $timeslot_start->lock_un();
    $is_timeslot = 0;
    sleep(60);
}

sub gasmultiplex()
{
    my $name = shift;
    my $gas = shift;
    my $dev = $rig->multiplex($name);
    if ($dev)
    {
	$dev->set($gas,$PROGRAM);
	$rig->proglog("gas for multiplexer ".$dev->name." set to $gas",$PROGRAM);
    }
    else
    {
	$rig->proglog("Error: No device returned for gas multiplexer '$name'!",$PROGRAM);
    }
    sleep(10);
}


sub my_sigint
{
    ### Exits gracefully when catching a sigint (kill -2)!! ###
    $SIG{INT} = 'IGNORE';  ## Ignores further SIGINT ###
    ### removes i-V controlfile if it exsists ###
    if ($rig->is_iv)
    {
	$rig->proglog("Stopping i-V curve\n",$PROGRAM);
	$rig->iv_stop;
    }
    if ($kidpid)
    {
	$rig->proglog("Stopping external program with pid $kidpid\n",$PROGRAM);
	kill 2,$kidpid;
    }
    if ($email)
    {
	my $message = "Program for rig ".$rig->name." started $start_time was terminated prematurely!\n";
	my $subject = "Program for rig ".$rig->name." terminated!";
	RFC::Main::mail($email,$message,$subject);
    }
    if ($is_timeslot && $is_timeslot > 0)
    {
	### Try to delete time slot request ###
	&remote_soap($tslot_addr,'del_item',$is_timeslot);
    }
    unlink $timeslot_start->filename() if ($timeslot_start->exist());
    unlink $timeslot_wait->filename() if ($timeslot_wait->exist());
    $rig->proglog("$0 caught SIGINT, exiting!!!\n",$PROGRAM);
    exit;
}

sub prog_exec($)
{
    unless ($allow_exec && $allow_exec =~ /yes/i)
    {
	$rig->proglog('ERROR Execution of external programs denied!',$PROGRAM);
	return;
    }
    my $tmpf = SemaforeFile->new('/tmp/exec_'.$$.'.txt');
    my $path = $RFC::Header::libdir.'user_exec/';
    my $str = shift;
    $str =~ s/[\s\t\n]+$//;
    if ($str =~ /\s*exec:([\.\w\-]+)\s+([\w\s\.\+\-\:\=]+)\s*(&*)$/)
    {
	my $prog = $path.$1;
	my $args = $2;
	my $fork = $3;
	unless (-e $prog)
	{
	    $rig->proglog('ERROR! Program '.$prog.' not found!',$PROGRAM);
	    return;
	}
	if ($args !~ /^[\w\s\.\-\+\=\:]*$/)
	{
	    $rig->proglog('ERROR! Arguments to '.$prog.' contained illegal special characters!',$PROGRAM);
	    return;
	}
	my $cmd = $prog.' '.$args;
	$cmd .= ' &' if ($fork);
	$rig->proglog("external program $prog started with arguments '$args'",$PROGRAM);
	my $kpid = fork();
	if ($kpid == 0)
	{
	    $kidpid = $$;
	    $tmpf->writeline($kidpid);
	    exec($cmd);
	}
	else
	{
	    ### Wait for child to exit;
	    sleep(1);
	    my @l = $tmpf->readlines();
	    $kidpid = $l[0] if (@l);
	    unlink $tmpf->filename;
	    waitpid($kpid,0);
	}
	$kidpid = 0;
	return;
    }
    if ($str =~ /\s*exec:([\.\w\-]+)\s*(&*)$/)
    {
	my $prog = $path.$1;
	my $fork = $2;
	unless (-e $prog)
	{
	    $rig->proglog('ERROR! Program '.$prog.' not found!',$PROGRAM);
	    return;
	}
	my $cmd = $prog;
	$cmd .= ' &' if ($fork);
	$rig->proglog("external program $prog started without arguments",$PROGRAM);
	my $kpid = fork();
	if ($kpid == 0)
	{
	    $kidpid = $$;
	    $tmpf->writeline($kidpid);
	    exec($cmd);
	}
	else
	{
	    ### Wait for child to exit;
	    sleep(1);
	    my @l = $tmpf->readlines();
	    unlink $tmpf->filename;
	    $kidpid = $l[0] if (@l);
	    waitpid($kpid,0);
	}
	$kidpid = 0;
	return;
    }
}

sub change_channel($)
{
    my $str = shift;
    if ($str =~ /change_channel\s+([\w\-\d\:\.\/]+)\s+(\w+)\s+(\d)/)
    {
	my $addr = $1;
	my $user = $2;
	my $ch = $3;
	my $cmd = get_cv('impedance','remote_client')." $addr mode";
	my $mode = `$cmd`;
	chomp $mode;
	my $dev = $rig->get_device('relay','multiplex_channel');
	$dev->set($ch,$PROGRAM,1) if ($dev);
	if ($mode =~ /\w/)
	{
	    my $cmd = get_cv('impedance','remote_client')." $addr change_channel $user $mode $ch";
	    my $mode = `$cmd`;
	    if ($mode =~ /\d/)
	    {
		$rig->proglog("Changed remote system $addr to channel $ch\n",$PROGRAM);
		return;
	    }
	}
	$rig->proglog("Error: Could not change remote system $addr to channel $ch!\n",$PROGRAM);
	return;
    }
    $rig->proglog("Error: Misnatch of aruments to change_channel!\n",$PROGRAM);
}

sub mail($)
{
    my $str = shift;
    if ($str =~ /mail:\s*([\w\.]+\@[\w\.]+)\s+(.*)/)
    {
	my $adr = $1;
	my $mess = $2;
	eval {
	    RFC::Main::mail($adr,$mess,"$PROGRAM for rig ".$rig->name." sends the following message");
	    $rig->proglog("Mail sent to $adr\n",$PROGRAM);
	};
	if ($@)
	{
	    $rig->proglog("Mail to $adr could not be sent! Error: $@\n",$PROGRAM);
	}
    }
}


sub killiv
{
    ### removes i-V controlfile if it exsists ###
    if ($rig->is_iv)
    {
	$rig->proglog("Stopping running i-V curve!!!\n",$PROGRAM);
	$rig->iv_stop;
	sleep(360);
    }
}

sub set_flow_ramp($)
{
    my $string = shift;
    $string =~ /gas:ramp:(\w+)\s+([\d\.]+)\s+([\d\.]+)\s+([\d\.]+)/;
    my $g = $1;
    my $flow = $2+0;
    my $step = $3+0;
    my $delay = $4+0;
    $delay = 1 if ($delay < 1);
    my $gas = $rig->get_device('gas',$g);
    unless ($gas)
    {
	$rig->proglog("Error: Could not get device for gas '$g'",$PROGRAM) 
    }
    else
    {
	$step = $gas->accuracy/2 if (!$step || $step < $gas->accuracy/2);
	my $start = $gas->read();
	$rig->proglog("Ramping gas flow for $g from $start L/h to $flow L/h with $step L/h, waiting $delay s on each step");
	my $diff = $flow - $start;
	$step = -$step if ($diff < 0);
	my $steps = POSIX::floor($diff / $step);
	for (my $x = 0; $x < $steps; $x++)
	{
	    $start += $step;
	    $gas->setflow($start,$PROGRAM,'nolog');
	    sleep($delay);
	}
	$gas->setflow($flow,$PROGRAM);
    }
}

sub set_flow($)
{
    my $string = shift;
    $string =~ /gas:(\w+)\s*\=\s*([\d\.]+)/;
    my $g = $1;
    my $gas = $rig->get_device('gas',$g);
    my $flow = $2+0;
    $rig->proglog("Error: Could not get device for gas '$g'",$PROGRAM) unless ($gas);
    $gas->setflow($flow,$PROGRAM);
}

sub set_pressure($)
{
    my $string = shift;
    $string =~ /pressure:(\w+)\s*\=\s*([\d\.]+)/;
    my $g = $1;
    my $gas = $rig->gas($g);
    my $flow = $2+0;
    $rig->proglog("Error: Could not get device for gas '$g'",$PROGRAM) unless ($gas);
    $gas->setflow($flow,$PROGRAM) if ($gas);
}

sub set_PID($)
{
    my $string = shift;
    $string =~ /PID:(\w+)\s*\=\s*([\-\d\.eE]+)/;
    my $name = $1;
    my $d = $rig->get_device("PID",$name);
    my $flow = $2+0;
    $rig->proglog("Error: Could not get device for PID '$name'",$PROGRAM) unless ($d);
    $d->set($flow,$PROGRAM);
}


sub set_water($)
{
    my $string = shift;
    $string =~ /water:(\w+)\s*\=\s*(\w+)/;
    my $name = $1;
    my $status = $2;
    my $water = $rig->water($name);
    $rig->proglog("Error: Could not get device for water bubler '$name'",$PROGRAM) unless ($water);
    $water->setstatus($status,$PROGRAM);
}

sub set_relay($)
{
    my $string = shift;
    $string =~ /relay:(\w+)\s*\=\s*(\w+)/;
    my $name = $1;
    my $status = $2;
    my $set = $status;
    if ($status !~ /^\d$/)
    {
	$set = 0;
	$set = 1 if ($status && $status =~ /yes/i);
    }
    my $relay = $rig->relay($name);
    $rig->proglog("Error: Could not get device for relay '$name'",$PROGRAM) unless ($relay);
    $relay->set($set,$PROGRAM);
}

sub set_current($)
{
    my $string = shift;
    $string =~ /current\s*\=\s*([\w\.]+)[\s\t]*(\w*)/;
    my $current = $1;
    my $name = $2;
    if ($name)
    {
	my $dev = $rig->get_device('PSU',$name);
	$dev = $rig->get_device('analog',$name) unless ($dev);
	if ($dev)
	{
	    if (ref($dev) =~ /analog/i)
	    {
		$current = 0 unless ($current =~ /\d/);
		$current = $current * 1000;
		$dev->set($current,$PROGRAM);
	    }
	    else
	    {
		$dev->current($current,$PROGRAM);
	    }
	}
	else
	{
	    $rig->errorlog("No PSU or analog controler found with name $name!",$PROGRAM);
	}
    }
    else
    {
	my @list = $rig->list_devices('PSU');
	if (@list && @list == 1)
	{
	    $rig->current($current,$list[0],$PROGRAM);
	}
	else
	{
	    ## Hope rig knows how to handle this ##
	    $rig->current($current);
	}
    }
}

sub set_current_ramp($)
{
    my $string = shift;
    $string =~ /current:ramp:(\w+)\s+([\w\.]+)\s+([\d\.]+)\s+([\d\.]+)/;
    my $name = $1;
    my $current = $2;
    my $step = $3;
    my $delay = $4;
    my $dev = $rig->get_device('PSU',$name);
    $dev = $rig->get_device('analog',$name) unless ($dev);
    if ($dev)
    {
	my $start;
	if (ref($dev) =~ /analog/i)
	{
	    $current = 0 unless ($current =~ /\d/);
	    $current = $current * 1000;
	    $step = $step * 1000;
	    $start = $dev->read();
	    $rig->proglog("Ramping current for $name from $start mA to $current with $step mA, waiting $delay s on each step");
	}
	else
	{
	    $start = $dev->current();
	    $rig->proglog("Ramping current for $name from $start A to $current with $step A, waiting $delay s on each step");
	}
	my $ocv = 0;
	if ($current =~ /ocv/)
	{
	    $ocv = 1;
	    $current = 0;
	}
	my $diff = $current - $start;
	$step = -$step if ($diff < 0);
	my $steps = POSIX::floor($diff / $step);
	for (my $x = 0; $x < $steps; $x++)
	{
	    $start += $step;
	    if (ref($dev) =~ /analog/i)
	    {
		$dev->set($start,$PROGRAM,'nolog');
	    }
	    else
	    {
		$dev->current($start,$PROGRAM,'nolog');
	    }
	    sleep($delay);
	}
	if (ref($dev) =~ /analog/i)
	{
	    $dev->set($current,$PROGRAM);
	}
	else
	{
	    if ($ocv)
	    {
		$dev->current('ocv',$PROGRAM);
	    }
	    else
	    {
		$dev->current($current,$PROGRAM);
	    }	    
	}
    }
    else
    {
	$rig->errorlog("No PSU or analog controler found with name $name!",$PROGRAM);
    }
}


sub set_voltage($)
{
    my $string = shift;
    $string =~ /voltage\s*\=\s*([\w\.]+)[\s\t]*(\w+)/;
    my $volt = $1;
    my $name = $2;
    my $dev = $rig->get_device('PSU',$name);
    $dev = $rig->get_device('analog',$name) unless ($dev);
    if ($dev)
    {
	if (ref($dev) =~ /analog/i)
	{
	    $volt = 0 unless ($volt =~ /\d/);
	    $dev->set($volt,$PROGRAM);
	}
	else
	{
	    $dev->voltage($volt,$PROGRAM);
	}
    }
    else
    {
	$rig->errorlog("No PSU or analog controler found with name $name!",$PROGRAM);
    }
}

sub c_step($)
{
    my $string = shift;
    $string =~ /c_step:(\d)\s*\=\s*([\d\.]+)/;
    my $step = $1+0;
    my $value = $2+0;
    $rig->change_config_value('IV_control','currentstep'.$step,$value);
}

sub c_limit($)
{
    my $string = shift;
    $string =~ /c_limit\s*\=\s*([\d\.]+)/;
    my $limit = $1+0;
    $rig->change_config_value('IV_control','currentlimit',$limit);
}

sub v_limit($)
{
    my $string = shift;
    $string =~ /v_limit\s*\=\s*([\d\.]+)/;
    my $limit = $1+0;
    $rig->change_config_value('IV_control','voltagelimit_iv',$limit);
}

sub e_limit($)
{
    my $string = shift;
    $string =~ /e_limit\s*\=\s*([\d\.]+)/;
    my $limit = $1+0;
    $rig->change_config_value('IV_control','electrolysis_limit_voltage',$limit);
}

sub ivpause($)
{
    my $string = shift;
    $string =~ /ivpause\s*\=\s*([\d\.]+)/;
    my $limit = $1+0;
    $rig->change_config_value('IV_control','ivpause',$limit);
}

sub m_leak()
{
    my $time = time;
    $rig->proglog("Leak measurement # $time\n",$PROGRAM);
    &measure();
    sleep(10);
    &measure();
    sleep(10);
    &measure();
    sleep(30);
}

sub my_measure()
{
    &measure();
    sleep(10);
    &measure();
}

sub wait_input($)
{
    my $string = shift;
    $string =~ /wait_for_input:\s+(\w+)/;
    my $name = $1;
    my $maxtime = 0;
    if ($string =~ /wait_for_input:\s+\w+\s+([\d\.]+)/)
    {
	$maxtime = $1;
    }
    my $dev = $rig->get_device('relay',$name);
    if ($dev)
    {
	my $str = "Waiting for input from $name";
	$str .= " for maximum $maxtime minutes" if ($maxtime);
	$rig->proglog($str,$PROGRAM);
	my $status = 0;
	my $endtime = 0;
	$endtime = time + $maxtime * 60 if ($maxtime);
	while ($status == 0)
	{
	    if ($endtime && time > $endtime)
	    {
		$status = 1;
		$rig->proglog("Maximum wait time exceeded, continuing!",$PROGRAM);
		last;
	    }
	    my $val = $dev->read;
	    if ($val == 1)
	    {
		$status = 1;
		$rig->proglog("Input recieved, continuing!",$PROGRAM);
		last;
	    }
	    sleep(5);
	} 
    }
    else
    {
	$rig->errorlog("No relay found with name $name!",$PROGRAM);
    }
}

sub wait($)
{
    my $string = shift;
    $string =~  /wait\s*\=\s*([\d\.]+)/;
    my $time = $1*60;
    $rig->proglog("Waiting for $time seconds\n",$PROGRAM);
    sleep($time);
}

sub iv
{
    $rig->proglog("i-V curve started",$PROGRAM);
    my $res = RFC::Main::CGI_client($rig->name,'iv');
}

sub ivwait
{
    $rig->proglog("i-V curve started",$PROGRAM);
    my $res = RFC::Main::CGI_client($rig->name,'iv');
    sleep(60);
    while ($rig->is_iv)
    {
	sleep(60);
    }
}

sub addj_temp($)
{
    my $string = shift;
    if ($string =~ /^\s*addjust_temp\s+(\d+)\s+(\d+)\s*(\w*)/)
    {
	my $target = $1;
	my $max_offset = $2;
	my $cdevicename = $3;
	my $devname = $rig->get_cv('control_logic','templog_for_temperature_addjust');
	$devname = ($rig->temps)[0] unless ($devname);
	my $device = $rig->temp($devname);
	unless ($device)
	{
	    $rig->proglog("Error: Could not get device for temperature name '$devname'",$PROGRAM);
	    return;
	}
	my $temp = $device->read;
	my $offset = $target - $temp;
	if (abs($offset) > $max_offset)
	{
	    $rig->proglog("Temperature offset ($offset) larger than allowed ($max_offset) for temperature addjustment",$PROGRAM);
	}
	else
	{
	    my @list = $rig->tempcontrols();
	    unless (@list)
	    {
		$rig->proglog("Error: No temperature control devices found!",$PROGRAM);
		&wait('wait = 180');
		return;
	    }
	    my $controldevice;
	    if ($cdevicename)
	    {
		$controldevice = $rig->tempcontrol($cdevicename);
	    }
	    else
	    {
		$controldevice = $rig->tempcontrol($list[0]);
	    }
	    my $ctemp = $controldevice->get_temp;
	    if ($ctemp)
	    {
		$rig->proglog("Addjusting temperature $offset C, Using '$devname' as reference!",$PROGRAM);
		my $newtemp = $ctemp + $offset;
		$controldevice->set_temp($newtemp,$PROGRAM);
	    }
	    else
	    {
		$rig->proglog("Could not get current controler setpoint, aborting temperature addjustment!",$PROGRAM);
	    }
	    &wait('wait = 180');
	}
    }
    else
    {
	$rig->proglog("Not enough arguments for automatic temperature adjustment!",$PROGRAM);
    }
}

sub temp($)
{
    my $string = shift;
    $string =~ /temp\s*\=\s*(\d+)[\s\t]*(\w*)/;
    my $temp = $1+0;
    my $contr = $2;
    my $res = undef;
    if ($contr)
    {
	$res = $rig->set_temp($temp,$contr,$PROGRAM);
    }
    else
    {
	$res = $rig->set_temp($temp);
    }
    return $res if (defined($res));
    $rig->proglog("Error: Could not set temperature to $temp for controler $contr, no response from device!");
    return undef;
}

sub ramp($)
{
    my $string = shift;
    $string =~ /ramp\s*\=\s*([\d\.]+)[\s\t]*(\w*)/;
    my $ramp = $1+0;
    my $contr = $2;
    my $res = undef;
    if ($contr)
    {
	$res = $rig->set_ramp($ramp,$contr,$PROGRAM);
    }
    else
    {
	$res = $rig->set_ramp($ramp);
    }
    return $res if (defined($res));
    $rig->proglog("Error: Could not set ramprate to $ramp for controler $contr, no response from device!");
    return undef;
}

sub cmdl($)
{
    my $string = shift;
    $string =~ /\=\s*([\w\s\.\,\-\+\'\"\;\:\!]+)/;
    my $st = $1;
    $rig->proglog($st,$PROGRAM);
}


sub imp($)
{
   my $string = shift;
   $string =~ /impedance\s+([\w\-\.\:\/]+)\s+(\d+)\s+([\w\.\-]+)/i;
   my $address = $1;
   my $setup = $2+0;
   my $user = $3;
   ### Find mode (1260 or hioki) of frequency analyser ###
   my $mode = &remote_soap_imp($address,'mode');
   chomp $mode;
   chomp $mode;
   chomp $mode;
   $mode = '1260' unless ($mode);
   my $host = &get_host($address);
   my $res = &remote_soap_imp($address,'impedance',$user,$mode,$setup);
   if ($res =~ /Impedance/)
   {
       $rig->proglog($res,$PROGRAM);
       $res =~ /Session\s+(\d+).*File\s+(\d+).*time\s+([\d\.]+)/;
       my $session = $1+0;
       my $fileid = $2+0;
       my $wait = $3+60;
       sleep(60);
       ### Check for running solartron ###
       $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
       if ($res =~ /MEASURING/i)
       {
	   sleep($wait-60);
	   $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
	   while (($res =~ /^MEASURING/) && ($wait > 0))
	   {
	       $wait = $wait - 30;
	       sleep(30);
	       $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
	   }
	   if (length($res) > 100)
	   {
	       my $test = $rig->session;
	       my $dir = $RFC::Header::publicdir.'rig'.$rig->name.'/'.$rig->name.'test'.$test.'/impedance/raw/';
	       if (!-d($dir))
	       {
		   system("/bin/mkdir $dir");
	       }
	       my $file = $dir.$host.'_s'.$session.'_'.$fileid.'.i2b';
	       {
		   my $f = SemaforeFile->new($file);
		   $f->writeline($res);
	       }
	       if ($string =~ /comp:\s*([\w\.\/\-]+)/)
	       {
		   my $compfile = $1;
		   my $command = "/usr/local/bin/celltest/hio_korr -S $compfile $file";
		   system($command);
		   my $outfile = $file;
		   $outfile =~ s/\.i2b$/_cor.i2b/;
		   my $newfile = $outfile;
		   $newfile =~ s/\/raw\//\//;
		   move($outfile,$newfile);
	       }
	       if ($string =~ /comp_ocv:\s*([\w\.\/\-]+)/)
	       {
		   my $compfile = $1;
		   my $command = "/usr/local/bin/celltest/open_circ_comp $compfile $file";
		   system($command);
		   my $outfile = $file;
		   $outfile =~ s/\.i2b$/_cor.i2b/;
		   my $newfile = $outfile;
		   $newfile =~ s/\/raw\//\//;
		   move($outfile,$newfile);
	       }
	       return;
	   }
	   else
	   {
	       $rig->proglog("Warning: no data returned from remote impedance system ($address)!")
	   }
	   return;
       }
   }
   $res = &remote_soap_imp($address,'impedance',$user,$mode,$setup);
   if ($res =~ /Impedance/)
   {
       $rig->proglog($res,$PROGRAM);
       $res =~ /Session\s+(\d+).*File\s+(\d+).*time\s+([\d\.]+)/;
       my $session = $1+0;
       my $fileid = $2+0;
       my $wait = $3+60;
       sleep(60);
       ### Check for running solartron ###
       $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
       if ($res =~ /MEASURING/i)
       {
	   sleep($wait-60);
	   $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
	   while (($res =~ /^MEASURING/) && ($wait > 0))
	   {
	       $wait = $wait - 30;
	       sleep(30);
	       $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
	   }
	   if (length($res) > 100)
	   {
	       my $test = $rig->session;
	       my $dir = $RFC::Header::publicdir.'rig'.$rig->name.'/'.$rig->name.'test'.$test.'/impedance/raw/';
	       if (!-d($dir))
	       {
		   system("/bin/mkdir $dir");
	       }
	       my $file = $dir.$host.'_s'.$session.'_'.$fileid.'.i2b';
	       {
		   my $f = SemaforeFile->new($file);
		   $f->writeline($res);
	       }
	       if ($string =~ /comp:\s*([\w\.\/\-]+)/)
	       {
		   my $compfile = $1;
		   my $command = "/usr/local/bin/celltest/hio_korr -S $compfile $file";
		   system($command);
		   my $outfile = $file;
		   $outfile =~ s/\.i2b$/_cor.i2b/;
		   my $newfile = $outfile;
		   $newfile =~ s/\/raw\//\//;
		   move($outfile,$newfile);
	       }
	       if ($string =~ /comp_ocv:\s*([\w\.\/\-]+)/)
	       {
		   my $compfile = $1;
		   my $command = "/usr/local/bin/celltest/open_circ_comp $compfile $file";
		   system($command);
		   my $outfile = $file;
		   $outfile =~ s/\.i2b$/_cor.i2b/;
		   my $newfile = $outfile;
		   $newfile =~ s/\/raw\//\//;
		   move($outfile,$newfile);
	       }
	       return;
	   }
	   else
	   {
	       $rig->proglog("Warning: no data returned from remote impedance system ($address)!")
	   }
	   return;
       }
   }
   #### If we havent returned by now, impedance malfunctioned! ###
   $rig->proglog("Impedance could not be started, remote system not responding!!\n",$PROGRAM);
}

sub cimp($)
{
   my $string = shift;
   $string =~ /(\w+)\s+([\w\-\.\:\/]+)\s+(\d+)\s+([\w\.\-]+)/i;
   my $command = lc($1);
   my $address = $2;
   my $setup = $3+0;
   my $user = $4;
   my $homedir = $RFC::Header::publicdir.'rig'.$rig->name.'/imp_comp/';
   ### Find mode (1260 or hioki) of frequency analyser ###
   my $mode = &remote_soap_imp($address,'mode');
   chomp $mode;
   chomp $mode;
   chomp $mode;
   $mode = '1260' unless ($mode);
   my $host = &get_host($address);
   if ($mode =~ /hioki/)
   {
       $homedir .= 'hioki/';
   }
   $command = 'impedance' if ($command =~ /current/);
   ### Insert command for shift of impedance compensation ###
   my $res = &remote_soap_imp($address,$command,$user,$mode,$setup);
   if ($res =~ /Impedance/ || $res =~ /Chrono/ || $res =~ /Potsweep/)
   {
       $rig->proglog($res,$PROGRAM);
       $res =~ /Session\s+(\d+).*File\s+(\d+).*time\s+([\d\.]+)/;
       my $session = $1+0;
       my $fileid = $2+0;
       my $wait = $3+60;
       sleep(60);
       $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
       if ($res =~ /MEASURING/)
       {
	   sleep($wait-60);
	   $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
	   while (($res =~ /^MEASURING/) && ($wait > 0))
	   {
	       $wait = $wait - 30;
	       sleep(30);
	       $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
	   }
	   if (length($res) > 100)
	   {
	       my $test = $rig->session;
	       my $dir = $RFC::Header::publicdir.'rig'.$rig->name.'/'.$rig->name.'test'.$test.'/impedance/raw/';
	       if (!-d($dir))
	       {
		   system("/bin/mkdir $dir");
	       }
	       my $file = $dir.$host.'_s'.$session.'_'.$fileid.'.i2b';
	       $file = $dir.$host.'_s'.$session.'_'.$fileid.'.i2p' if ($command =~ /potsw/);
	       $file = $dir.$host.'_s'.$session.'_'.$fileid.'.i2c' if ($command =~ /chrono/);
	       {
		   my $f = SemaforeFile->new($file);
		   $f->writeline($res);
	       }
	       ### Only do compensation for impedance files ###
	       if ($command =~ /impedance/ && $string =~ /comp:/)
	       {
		   my $command = "/usr/local/bin/celltest/hio_korr -S $homedir".'short.i2b '.$file;
		   system($command);
		   my $outfile = $file;
		   $outfile =~ s/\.i2b$/_cor.i2b/;
		   $command = "/usr/local/bin/celltest/hio_korr -M $homedir".'shunt.i2b '.$outfile;
		   system($command);
		   my $unlinkfile = $outfile;
		   $outfile =~ s/\.i2b$/_cor.i2b/;
		   my $newfile = $outfile;
		   $newfile =~ s/\/raw\//\//;
		   move($outfile,$newfile);
		   unlink $unlinkfile if (-e $unlinkfile);
	       }
	       if ($command =~ /impedance/ && $string =~ /comp_ocv:\s*([\w\.\/\-]+)/)
	       {
		   my $compfile = $1;
		   my $command = "/usr/local/bin/celltest/open_circ_comp $compfile $file";
		   system($command);
		   my $outfile = $file;
		   $outfile =~ s/\.i2b$/_cor.i2b/;
		   my $newfile = $outfile;
		   $newfile =~ s/\/raw\//\//;
		   move($outfile,$newfile);
	       }
	       return;
	   }
	   else
	   {
	       $rig->proglog("Warning: no data returned from remote impedance system ($address)!")
	   }
	   return;
       }
   }
   $res = &remote_soap_imp($address,$command,$user,$mode,$setup);
   if ($res =~ /Impedance/ || $res =~ /Chrono/ || $res =~ /Potsweep/)
   {
       $rig->proglog($res,$PROGRAM);
       $res =~ /Session\s+(\d+).*File\s+(\d+).*time\s+([\d\.]+)/;
       my $session = $1+0;
       my $fileid = $2+0;
       my $wait = $3+60;
       sleep(60);
       $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
       if ($res =~ /MEASURING/)
       {
	   sleep($wait-60);
	   $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
	   while (($res =~ /^MEASURING/) && ($wait > 0))
	   {
	       $wait = $wait - 30;
	       sleep(30);
	       $res = &remote_soap_imp($address,'get_file',$user,$mode,$session,$fileid);
	   }
	   if (length($res) > 100)
	   {
	       my $test = $rig->session;
	       my $dir = $RFC::Header::publicdir.'rig'.$rig->name.'/'.$rig->name.'test'.$test.'/impedance/raw/';
	       if (!-d($dir))
	       {
		   system("/bin/mkdir $dir");
	       }
	       my $file = $dir.$host.'_s'.$session.'_'.$fileid.'.i2b';
	       $file = $dir.$host.'_s'.$session.'_'.$fileid.'.i2p' if ($command =~ /potsw/);
	       $file = $dir.$host.'_s'.$session.'_'.$fileid.'.i2c' if ($command =~ /chrono/);
	       {
		   my $f = SemaforeFile->new($file);
		   $f->writeline($res);
	       }
	       ### Only do compensation for impedance files ###
	       if ($command =~ /impedance/ && $string =~ /comp:/)
	       {
		   my $command = "/usr/local/bin/celltest/hio_korr -S $homedir".'short.i2b '.$file;
		   system($command);
		   my $outfile = $file;
		   $outfile =~ s/\.i2b$/_cor.i2b/;
		   $command = "/usr/local/bin/celltest/hio_korr -M $homedir".'shunt.i2b '.$outfile;
		   system($command);
		   $outfile =~ s/\.i2b$/_cor.i2b/;
		   my $newfile = $outfile;
		   $newfile =~ s/\/raw\//\//;
		   move($outfile,$newfile);
	       }
	       if ($command =~ /impedance/ && $string =~ /comp_ocv:\s*([\w\.\/\-]+)/)
	       {
		   my $compfile = $1;
		   my $command = "/usr/local/bin/celltest/open_circ_comp $compfile $file";
		   system($command);
		   my $outfile = $file;
		   $outfile =~ s/\.i2b$/_cor.i2b/;
		   my $newfile = $outfile;
		   $newfile =~ s/\/raw\//\//;
		   move($outfile,$newfile);
	       }
	       return;
	   }
	   else
	   {
	       $rig->proglog("Warning: no data returned from remote impedance system ($address)!")
	   }
	   return;
       }
   }
   #### If we havent returned by now, impedance malfunctioned! ###
   $rig->proglog("$command could not be started, remote system not responding!!\n",$PROGRAM);
}


#### Utility functions ###

sub get_host($)
{
    my $adr = shift;
    if ($adr =~ /([\d\.\:]+)/)
    {
	my $res = &remote_soap_imp($1,'ping');
        if ($res =~ /localhost.* on addr:\s*([\d\.]+)/)
        {
            return $1;
        }
        if ($res =~ /on ([\w\-\.]+) on addr:/)
        {
            return $1;
        }
    }
    if ($adr =~ /([\w\-\.]+)/)
    {
        my $ip = $1;
        my $res = `/usr/bin/nslookup $ip`;
        if ($res && $res =~ /name\s+\=\s+([\w\-\+]+)/)
        {
            return $1;
        }
        return $ip;
    }
    return $adr;
}

sub measure()
{
    my $cmd = $RFC::Header::libdir.'logfile.pl '.$rig->name.' test';
    return `$cmd`;
}



sub soapGetBad {
    my $soap = shift;
    my $res = shift;
    if( ref( $res ) ) {
        chomp( my $err = $res->faultstring );
        push( @SOAP_ERRORS, "SOAP FAULT: $err" );
    }
    else {
        chomp( my $err = $soap->transport->status );
        push( @SOAP_ERRORS, "TRANSPORT ERROR: $err" );
    }
    warn join(@SOAP_ERRORS),"\n";
    return new SOAP::SOM;
}
