#!/usr/bin/perl -T
# $Id: rig_ajax_run.cgi,v 1.75 2023/12/13 09:26:52 sqko Exp $
############################################################
############################################################
###                                                      ###
###   Originally designed by Soeren Koch                 ###
###                                                      ###
###   Impelemented by Soeren Koch                        ###
###                                                      ###
###   Copyright by Soeren Koch January 20011             ###
###                                                      ###
############################################################
############################################################

use strict;
use warnings;
use CGI qw(:standard :netscape);
use RFC::Main;
use RFC::Rig;
use RFC::RFCCGI qw(:cgi :html);
use RFC::Header;

my $acmode = get_cv('global','access_mode');
$acmode = 'celltest' unless ($acmode);

unless (param)
{
    print header(-access_control_allow_origin => '*',-content_type=>'text/plain',-charset=>'utf-8');
    print <<END;


Oops.. no parameters, displaying interface definitions!

Common parameters:

Parameter 'action', determines which function to call (each described below)
Generally, the script returns OK on the first line if input is valid, and an errorstring if not.
Thus remember to check for the 'OK' string as part of the ajax response function.

For functions requiring valid logins the following additional parameters must be included in addition to the ones specified.:
'name' Username, text
'pass' Session key, text


Function description based on 'action' parameter:

The following functions are avaliable without a valid session:


get_imp_data
Returns the impedance data for the specified rig, test and impedance filename
Note that if access limitations apply (.htaccess file exists in target data location) the call does not return any data!
Parameters:
'rig'  Rig number, integer
'testno' Test number, integer
'fíle'  Filename

show_info
Returns the content of the test information file for the rig and test specified
Note that if access limitations apply (.htaccess file exists in target data location) the call does not return any data!
Parameters:
'rig'  Rig number, integer
'testno' Test number, integer

show_log
Returns the content of the program log for the rig and test specified
Note that if access limitations apply (.htaccess file exists in target data location) the call does not return any data!

Parameters:
'rig'  Rig number, integer
'testno' Test number, integer

show_error
Returns the content of the error log for the rig and test specified
Note that if access limitations apply (.htaccess file exists in target data location) the call does not return any data!
Parameters:
'rig'  Rig number, integer
'testno' Test number, integer

is_iv
Returns 1 if an i-V curve is running, 0 otherwise
Parameters:
'rig'  Rig number, integer

get_callibration_file
Returns the content of the specified temperature callibration file.
Parameters:
'filename' Filename (must be located in $homedir/convert-tables/userfiles/

plot_callibration_file
Plots the data in the  the specified temperature callibration file.
Returns the filename of the png file showing the data using relative path (base path is /home/http/html/)
Parameters:
'filename' Filename (must be located in $homedir/convert-tables/userfiles/

checkuser
Returns 'OK' if the user session is valid and an error otherwise 
Parameters:
'name' Username
'pass' Session token

new_session
Initiates a new login session. If the supplied username and password combination is correct it returns 'OK', the userid and a new valid session token.
It retuns an error message if credentials was not valid.
Parameters:
'name' Username
'pass' password


read
Returns the vaue of the specified device
Parameters:
'rig' Rig number
'type' Device type
'dname' Device name 



The following functions are only avaliable with a vallid login session (and thus the name and pass parameters must be specified in addition the ones described below).

run_device_function
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 described above.
Parameters:
'rig'  Rig number, integer
'type' Device type
'dname' Device name
'function' Device member function to call (see individual device classes for avaliable functions)
'arguments' Comma delimited list of arguments to the function call, may be empty for functions without arguments

get_ramprate
Returns the ramprate for the device specified (if the device has the get_ramp function defined)
Parameters:
'rig'  Rig number, integer
'type' Device type
'dname' Device name

list_caching
Returns a list of device names which is configured as allowing caching (primarily durring i-V curves)
Parameters:
'rig'  Rig number, integer

get_programs_test
Returns a list of filenames of previous sequential programs for the rig and test spoecified.
Parameters:
'rig'  Rig number, integer
'testno' Test number, integer

start_iv
Starts an i-V curve for the rig specified.
Parameters:
'rig'  Rig number, integer

stop_iv
Stops a running i-V curve for the rig specified.
Parameters:
'rig'  Rig number, integer

set_imp

Parameters:
'rig'  Rig number, integer
'server' Remote server to handle the impedance measurement (usually an Elchemea system)
'port' TCP-IP port on the rempote server to send the request to (usually 4040).
'impuser' username on the remote system to run the impedance
'session' Session number to determine which configuration to use (based on username and session number)
'comp' Type and/or filename for local impedance compensation after measruement has completed.

set_multiplex
Selectes which gas is engaged for a gas multiplexer.
Parameters:
'rig'  Rig number, integer
'dev' Device name
'gas' Name of gas device to select (note NOT the name of the gas controled by the gas device).

set_relay
Sets the specified relay to the specified state
Parameters:
'rig'  Rig number, integer
'dev' Device name
'status' State to set the relay to, 1 for ON and 0 for OFF

set_gas
Sets the gas flow for the specified gas
Parameters:
'rig'  Rig number, integer
'dev' Device name
'flow' Flow rate in L/h, floating point

set_pid
Sets the setpoint for the specified PID
Parameters:
'rig'  Rig number, integer
'dev' Device name
'setpoint' Setpoint, floating point

set_temp
Sets the target setpoint and ramprate for the specified temperature controler
Parameters:
'rig'  Rig number, integer
'dev' Device name
'ramp' Ramprate in C/hour, floating point
'temp' Temperature setpoint, floating point

set_current
Sets the DC current for the specified PSU
Parameters:
'rig'  Rig number, integer
'dev' Device name
'current' DC current in A, floating point, use the value 'ocv' for open circuit conditions

set_voltage
Sets the DC voltage for the specified PSU
Parameters:
'rig'  Rig number, integer
'dev' Device name
'voltage' DC voltage in V,floating point, use the value 'ocv' for open circuit conditions

add_info
Appends the specified text to the info file for the current test on the specified rig
Parameters:
'rig'  Rig number, integer
'comments' Text to be appended

create_zip
Recreates the zip archive for the specified rig and test
Parameters:
'rig'  Rig number, integer
'test' Test number, integer


END
    exit;
}

print header(-access_control_allow_origin => '*');
my $ac = param('action');
unless ($ac)
{
    print "";
    exit;
}
if ($ac eq 'checkuser')
{
    my $uid = &login_ok();
    if ($uid)
    {
	print "OK\n$uid\n";
    }
    else
    {
	print "Error: User not authenticated! (perhaps session timeout?)\n";
    }
    exit;
}
if ($ac eq 'new_session')
{
    my ($user,$pass) = &RFC::RFCCGI::get_id();
    my $md5 = RFC::Main::passwd_client('new_session',$user,$pass);
    my $uid = RFC::Main::passwd_client('checkuser',$user,$md5);
    if ($uid)
    {
	print "OK\n";
	print "$uid\n";
	print "$md5\n";
    }
    else
    {
	print "User not authenticated!\n";
    }
    exit;
}

my $r = param('rig');
unless ($r)
{
    print header();
    print "No rig specified!\n";
    exit;
}
my $rig = RFC::Rig->new($r);


if ($ac eq 'read')
{
    my $htacc = $rig->webdir().'/.htaccess';
    if (-e $htacc && !(login_ok() && rig_auth()))
    {
	print "Warning: .htaccess file found in current test dir for $r\nNo data can be exposed without authorisation!\n";
	exit;
    }
    my $type = param('type');
    my $name = param('dname');
    my $dev = $rig->init_device($type,$name);
    if ($dev)
    {
	eval {
	    my $val = $dev->read();
	    print "OK\n$val";
	};
	if ($@)
	{
	    print "ERROR\n";
	    if ($@ =~ /^(.*)\s*\#+/)
	    {
		print $1;
	    }
	    else
	    {
		print $@;
	    }
	}
    }
    else
    {
	print "ERROR\n";
	print "Warning: no device found of type '$type' with name '$name'!";
    }
    $rig->DESTROY();
    exit;
}

if ($ac eq 'get_imp_data')
{
    my $test = param('testno');
    my $fn = param('file');
    unless ($test && $fn)
    {
	print "Warning, No test or filename specified!\n";
	exit;
    }
    my $impedancedir =  $RFC::Header::publicdir . "rig" . $rig->name . "/" . $rig->name . "test"  . $test . "/impedance";
    my $htacc = $rig->webdir($test).'/.htaccess';
    if (-e $htacc && !(login_ok() && rig_auth()))
    {
	print "Warning: .htaccess file found in test dir for $r and test $test!\nNo data can be exposed without authorisation!\n";
	exit;
    }
    unless (-d $impedancedir)
    {
	print "Warning, $impedancedir not found!\n";
	exit;
    }
    my $file = $impedancedir.'/'.$fn;
    my $name = '';
    my @data = ();
    my $f = SemaforeFile->new($file);
    my @lines = $f->readlines();
    my $x = 0;
    while ($x++ < @lines)
    {
	next unless ($lines[$x] =~ /^[\s\t]*\d+[\s\t]*$/);
	last;
    }
    while ($x++ < @lines)
    {
	push @data,$lines[$x] if ($lines[$x] && $lines[$x] =~ /\d/);
    }
    if ($file =~ /([\w\d\-\.]+)$/)
    {
	$name = $1;
    }
    print "OK\n";
    print $name,"\n";
    print $file,"\n";
    print join("\n",@data);
    exit;
}
if ($ac eq 'show_log')
{
    my $htacc = $rig->webdir.'/.htaccess';
    if (-e $htacc && !(login_ok() && rig_auth()))
    {
	my $test = $rig->session();
	print "Warning: .htaccess file found in test dir for $r and test $test!\nNo data can be exposed without authorisation!\n";
	exit;
    }
    my $content = $rig->get_sessionlog;
    print $content;
    exit;
}
if ($ac eq 'show_info')
{
    my $htacc = $rig->webdir.'/.htaccess';
    if (-e $htacc && !(login_ok() && rig_auth()))
    {
	my $test = $rig->session();
	print "Warning: .htaccess file found in test dir for $r and test $test!\nNo data can be exposed without authorisation!\n";
	exit;
    }
    my $content = $rig->info();
    print $content;
    exit;
}
if ($ac eq 'show_error')
{
    my $htacc = $rig->webdir.'/.htaccess';
    if (-e $htacc && !(login_ok() && rig_auth()))
    {
	my $test = $rig->session();
	print "Warning: .htaccess file found in test dir for $r and test $test!\nNo data can be exposed without authorisation!\n";
	exit;
    }
    my $content = $rig->get_errorlog();
    print $content;
    exit;
}
if ($ac eq 'is_iv')
{
    if ($rig->is_iv)
    {
	print "1\n";
    }
    else
    {
	print "0\n";
    }
    exit;
}
if ($ac eq 'get_callibration_file')
{
    if (param('filename') =~ /([\w\.\-]+)/)
    {
	my $filename = $homedir.'convert-tables/userfiles/'.$1;
	my $file = SemaforeFile->new($filename);
	print join("\n",$file->readlines) if ($file->exist);
    }
    exit;
}
if ($ac eq 'plot_callibration_file')
{
    my $GNUPLOT = &get_cv('GNUPLOT','location');
    if (param('filename') =~ /([\w\.\-]+)/)
    {
	my $fn = $1;
	my $dat = $homedir.'convert-tables/userfiles/'.$fn;
	unless (-e $dat && -s $dat > 10)
	{
	    print "";
	    exit;
	}
	chdir $htmldir;
	my $pwd = `pwd`;
	my $out = 'png/'.$fn.'.png';
	my $gp = SemaforeFile->new('/tmp/plot_cal_'.$$.'.gp');
	my @lines = ("set out '$out'",'set term png',"set ylabel 'T (C)'","set xlabel 'V (mV)'","set size 0.7,0.7");
	push @lines,"set title '$fn'";
	push @lines,"set nokey";
	push @lines,"plot '</bin/sort -n $dat' u 1:2 w linesp"; 
	$gp->writeline(@lines);
	my $cmd = $GNUPLOT.' '.$gp->filename;
	system($cmd) and print "";
	unlink $gp->filename if ($gp->exist);
	print 'celltest/png/'.$fn.'.png'."\n";
    }
    exit;
}
unless (login_ok())
{
    print "";
    exit;
}

### Everyone is allowed to append logbook entries! ####
if ($ac eq 'add_info')
{
    my $string = get_CGI_value('comments');
    $string =~ s/\\n/\n/g;
    my $time = localtime();
    my $user = &get_user();
    my $str = $time.', User '.$user.' added: '.$string."\n";
    my $content = $rig->info($str);
    print $content;
    exit;
}

my $usermode = user_auth($acmode,'c');
if (RFC::RFCCGI::rig_mode())
{
    ####  Read and use mode deprecated after initialisation of rig authentification ####
    $usermode = 1;
}
unless (RFC::RFCCGI::rig_auth())
{
    $usermode = 0;
}
unless ($usermode)
{
    print "Warning: You are not authorised to change parameters on $rig changes aborted!";
    exit;
}

if ($ac eq 'run_device_function')
{
    ## Although this function is mererely for getting data, it can possibly be misused ##
    ## To minimise damage, it can only be called by logged in users (and if they can   ##
    ## hack the login, they can do damage anyways, so no reason to be paranoid here..) ## 
    my $type = param('type');
    my $name = param('dname');
    my $function = param('function');
    my $dev = $rig->init_device($type,$name);
    if ($dev)
    {
	eval {
	    my @res = ();
	    my $args = param('arguments');
	    if ($args)
	    {
		@res = $dev->$function(split(/\s*\,\s*/,$args));
	    }
	    else
	    {
		@res = $dev->$function();
	    }
	    foreach (@res)
	    {
		$_ = '' unless (defined($_));
	    }
	    if (@res)
	    {
		print "OK\n";
		print join("\n",@res) if (@res);
	    }
	    else
	    {
		print "ERROR\n";
		print "Warning: Device function '$function' returned undefined!";
	    }
	};
	if ($@)
	{
	    print "ERROR\n";
	    if ($@ =~ /^(.*)\s*\#+/)
	    {
		print $1;
	    }
	    else
	    {
		print $@;
	    }
	}
    }
    else
    {
	print "ERROR\n";
	    print "Warning: no device found of type '$type' with name '$name'!";
    }
    $rig->DESTROY();
    exit;
}


if ($ac eq 'get_ramprate')
{
    my $type = param('type');
    my $name = param('dname');
    my $dev = $rig->init_device($type,$name);
    if ($dev)
    {
	print "OK\n";
	if ($dev->has_ramp())
	{
	    print "1\n";
	    print $dev->get_ramp(),"\n";
	}
	else
	{
	    print "0\n0\n";
	}
    }
    else
    {
	print "Warning: No device with name $name of type $type was found for $rig";
    }
    $rig->DESTROY();
    exit;
}
if ($ac eq 'list_caching')
{
    my @list = $rig->list_caching();
    foreach my $item (@list)
    {
	print $item->type(),' - ',$item->name(),"\n";
    }
    exit;
}
if ($ac eq 'get_programs_test')
{
    my $test = $rig->session;
    $test = &get_CGI_value_clean('session') if (&get_CGI_value('session'));
    my $dir = $RFC::Header::publicdir.'rig'.$rig->name.'/'.$rig->name.'test'.$test;
    opendir(DIR,$dir);
    my @list = grep {/program_/} readdir(DIR);
    closedir DIR;
    foreach (sort {$a cmp $b} @list)
    {
	print $dir,'/',$_,"\n";
    }
    exit;
}
if ($ac eq 'start_iv')
{
    my $user = &get_user();
    my $res = CGI_client($rig->name,'iv');
    if ($res =~ /i-V curve started/)
    {
	$rig->proglog("i-V curve started",$user);
            print "i-V curve on $rig started";
    }
    else
    {
	$rig->errorlog("Error: i-V curve could not be started: $res",$user);
	print $res;
    }
    exit;
}
if ($ac eq 'stop_iv')
{
    my $user = &get_user();
    my $res = CGI_client($rig->name,'stop_iv');
    if ($res =~ /stopping/i)
    {
	$rig->proglog("i-V curve stopped!",$user);
	print "i-V curve on $rig stopped";
    }
    else
    {
	$rig->errorlog("Error: i-V curve could not be stopped: $res",$user);
	print $res;
    }
    exit;
}
if ($ac eq 'set_imp')
{
    my $fn = $rig->config->filename();
    chomp $fn;
    unless (-w $fn)
    {
	print "Warning!\nconfiguration file is readonly!\n";
	exit;
	}
    my $ip = get_CGI_value_clean('server');
    my $port = get_CGI_value_clean('port');
    my $user = get_CGI_value_clean('impuser');
    my $session = get_CGI_value_clean('session');
    my $file = get_CGI_value_clean('comp');
    my $comploc = get_cv('impedance','standard_compensation_files');
    $rig->change_config_value('impedance','server',$ip);
    $rig->change_config_value('impedance','port',$port);
    $rig->change_config_value('impedance','user',$user);
    $rig->change_config_value('impedance','session',$session);
    $rig->change_config_value('impedance','compensation',$file);
    my $dir;
    if ($comploc)
    {
	$comploc =~ /^([\w\/]+)\*/;
	$dir = $1;
    }
    else
    {
	$dir = $RFC::Header::publicdir.'rig'.$rig->name.'/imp_comp/';
    }
    my $impcmd = 'impedance';
    if ($file eq 'DEFAULT')
    {
	$dir = '';
	$file = '';
	$impcmd = 'current_impedance';
    }
    my $string = "$impcmd $ip:$port $session $user comp:$dir$file"; 
    #### Check if program ia already running and abort if so ###
    my $isused = 0;
    my $cmd = '/bin/ps -efl | /bin/grep custom_prog.pl | /bin/grep rig'.$rig->name;
    my $str = `$cmd`;
    my @list = ();
    @list = split(/\n/,$str) if ($str);
    foreach (@list)
    {
	$isused = 1 if /celltest/;
    }
    if ($isused)
    {
	print "Program already running, no new program can be activated, aborting!";
	exit;
    }
    ##### Create new unique file name for program name ####
    my $dat = `date +"%Y:%m:%d:%H:%M"`;
    $dat =~ /([\d\:]*)/;
    $dat = $1;
    my $file1 = $RFC::Header::publicdir.'rig'.$rig->name.'/'.$rig->name.'test'.$rig->session.'/impedance_'.$dat.'.txt';
    my $f = SemaforeFile->new($file1);
    $f->append($string);
    my $res = RFC::Main::CGI_client($rig->name,'custom',$f->filename,get_user());
    chomp $res;
    print $res;
    exit;
}
if ($ac eq 'set_multiplex')
{
    my $fn = $rig->config->filename();
    chomp $fn;
    unless (-w $fn)
    {
	print "Warning!\nconfiguration file is readonly!\n";
	exit;
    }
    my $dev = get_CGI_value_clean('dev');
    my $gas = get_CGI_value_clean('gas');
    my $user = &get_user();
    my $d = $rig->get_device('multiplex',$dev);
    if ($d) {
	eval {
	    $d->set($gas,$user);
	    if ($d->has_ramp)
	    {
		my $ramp = get_CGI_value_clean('ramp');
		$d->set_ramp($ramp,$user);
	    }
	    if ($d->mode =~ /auto/i)
	    {
		print "Gas for multiplexer $dev set to $gas for $rig";
		$rig->proglog("Gas for multiplexer $dev set to $gas",$user);
	    }
	    else
	    {
		print "Gas for multiplexer $dev set to $gas manually for $rig";
		$rig->proglog("Gas for multiplexer $dev set to $gas manually",$user);
	    }
	};
	if ($@)
	{
	    if ($@ =~ /(.*)\#+/)
	    {
		my $s = $1;
		$rig->errorlog("Error when user $user attempts to set gas for multiplexer $dev: $s",$user);
		print "Error: ".$s;
	    }
	    else
	    {
		$rig->errorlog("Error when user $user attempts to set gas for multiplexer $dev: $@",$user);
		print "Error: ".$@;
	    }
            }
    }
    else
    {
	print "Warning: No gas multiplexer device found with name '$dev' for $rig";
    }
    exit;
    
}
if ($ac eq 'set_relay')
{
    my $dev = get_CGI_value_clean('dev');
    my $status = get_CGI_value_clean('status');
    $status = 0 unless ($status);
    my $user = &get_user();
    my $d = $rig->get_device('relay',$dev);
    if ($d) {
	eval {
	    if ($d->mode =~ /auto/i)
	    {
		$d->set($status,$user);
		if ($d->has_ramp)
		{
		    my $ramp = get_CGI_value_clean('ramp');
		    $d->set_ramp($ramp,$user);
		}
		print "Status for relay $dev set to $status for $rig";
	    }
	    else
	    {
		my $f = $d->set($status,$user);
		die "Status for $dev could not be set to $status for $rig\n" unless ($f == $status);
		print "Status for $dev set to $status manually for $rig";
	    }
	};
	if ($@)
	{
	    if ($@ =~ /(.*)\#+/)
	    {
		my $s = $1;
		$rig->errorlog("Error when user $user attempts to set status for device $dev: $s",$user);
		print "Error: ".$s;
	    }
	    else
	    {
		$rig->errorlog("Error when user $user attempts to set status for device $dev: $@",$user);
		print "Error: ".$@;
	    }
	}
    }
    else
    {
	print "Warning: No relay device found with name '$dev' for $rig";
        }
    exit;
}
if ($ac eq 'set_gas')
{
    my $dev = get_CGI_value_clean('dev');
    my $flow = get_CGI_value_clean('flow');
    my $user = &get_user();
    my $d = $rig->get_device('gas',$dev);
    if ($d) {
	eval {
	    if ($d->mode =~ /auto/i)
	    {
		my $cutoff = $d->cutoff_set();
		if ($d->has_ramp)
		{
		    my $ramp = get_CGI_value_clean('ramp');
		    $d->set_ramp($ramp,$user);
		}
		if (!$d->is_pressure && $cutoff && $flow < $cutoff)
		{
		    my $f = $d->setflow(0,$user);
		    if ($f && $f =~ /^(.+):/)
		    {
			$f = $1;
		    }
		    die "Flow for gas $dev could not be set to $flow l/hour for $rig\n" unless (defined($f) && abs($f) < $d->accuracy);
		    my $str = "Flow for gas $dev set to 0 l/hour as flow was below cutoff for gas $dev on $rig";
		    print $str;
		    $rig->proglog($str,$user);
		}
		else
		{
		    my $f = $d->setflow($flow,$user);
		    if ($f && $f =~ /^(.+):/)
		    {
			$f = $1;
		    }
		    if ($d->is_pressure)
		    {
			die "Pressure for gas $dev could not be set to $flow barA for $rig\n" unless (defined($f) && (!$d->accuracy() || (abs($f-$flow) < $d->accuracy)));
			print "Pressure for gas $dev set to $flow barA for $rig";
		    }
		    else
		    {
			die "Flow for gas $dev could not be set to $flow l/hour for $rig\n" unless (defined($f) && (!$d->accuracy() || (abs($f-$flow) < $d->accuracy)));
			print "Flow for gas $dev set to $flow l/hour for $rig";
		    }
		}
	    }
	    else
	    {
		my $f = $d->setflow($flow,$user);
		print "Flow for gas $dev has to be set to $flow l/hour manually for $rig";
		### Print any slave device info as well ###
		if ($f =~ /^[\d\.\+\-eE]+\D+/)
		{
		    $f =~ /^[\d\.\+\-eE]+(.*)/;
		    print ' '.$1;
		}
		if ($d->has_ramp)
		{
		    my $ramp = get_CGI_value_clean('ramp');
		    $d->set_ramp($ramp,$user);
		}
	    }
	};
	if ($@)
	{
	    if ($@ =~ /(.*)\#+/)
	    {
		my $s = $1;
		$rig->errorlog("Error when user $user attempts to set flow for gas $dev: $s",$user);
		print "Error: ".$s;
	    }
	    else
	    {
		$rig->errorlog("Error when user $user attempts to set flow for gas $dev: $@",$user);
		print "Error: ".$@;
	    }
	}
    }
    else
        {
            print "Warning: No gas device found with name '$dev' for $rig";
        }
    exit;
}
if ($ac eq 'set_pid')
{
    my $dev = get_CGI_value_clean('dev');
    my $flow = get_CGI_value('setpoint');
    $flow = 0 unless ($flow);
    $flow =~ /([\d\.\-\+eE]+)/;
    $flow = $1+0;
    my $user = &get_user();
    my $d = $rig->get_device('PID',$dev);
    if ($d) {
	eval {
	    my $f = $d->set($flow,$user);
	    if ($d->has_ramp)
	    {
		my $ramp = get_CGI_value_clean('ramp');
		$d->set_ramp($ramp,$user);
	    }
	    die "Setpoint for PID regulator $dev could not be set to $flow for $rig\n" unless ($f == $flow);
	    print "Setpoint for PID $dev set to $flow for $rig";
	};
	if ($@)
	{
	    if ($@ =~ /(.*)\#+/)
	    {
		my $s = $1;
		$rig->errorlog("Error when user $user attempts to set setpoint for PID regulator $dev: $s",$user);
		print "Error: ".$s;
	    }
	    else
	    {
		$rig->errorlog("Error when user $user attempts to set setpoint for PID regulator $dev: $@",$user);
		print "Error: ".$@;
	    }
	}
    }
    else
    {
	print "Warning: No PID device found with name '$dev' for $rig";
    }
    exit;
}
if ($ac eq 'set_temp')
{
    my $dev = get_CGI_value_clean('dev');
    my $temp = get_CGI_value_clean('temp');
    my $ramp = get_CGI_value_clean('ramp');
    my $user = &get_user();
    my $d = $rig->get_device('tempcontrol',$dev);
    if ($d) {
	eval {
	    my $t = $d->set_temp($temp,$user);
	    die "Could not set temperature for $d on $rig\n" unless (defined($t));
	    print "Temperature set to $temp C";
	    if ($d->has_ramp)
	    {
		my $r = $d->set_ramp($ramp,$user);
		die "Could not set ramprate on $d for $rig\n" unless (defined($r));
		print "\nand ramprate set to $ramp C/hour for $rig";
	    }
	};
	if ($@)
	{
	    $rig->errorlog("Error when user $user attempts to set temperature for device $dev: $@",$user);
	    print "Error: ".$@;
	}
    }
    else
    {
	print "Warning: No temperature control device found with name '$dev' for $rig";
    }
    exit;
}
if ($ac eq 'set_current')
{
    my $dev = get_CGI_value('dev');
    my $c = get_CGI_value('current');
    if ($c =~ /^[\s\t]*([\+\-\.\deE]+)[\s\t]*$/)
    {
	$c = $1;
    }
    else
    {
	$c = 'ocv';
    }
    my $user = &get_user();
    if ($dev =~ /(.*)\s+\(analog\)/)
    {
	my $analog = $1;
	my $d = $rig->get_device('analog',$analog);
	if ($d) {
	    eval {
		$d->current($c,$user);
		print "Current output '$analog' set to $c A for $rig";
		$rig->proglog("Current for device '$analog' set to $c A",$user);
		if ($d->has_ramp)
		{
		    my $ramp = get_CGI_value_clean('ramp');
		    $d->set_ramp($ramp,$user);
		}
	    };
	    if ($@)
	    {
		$rig->errorlog("Error when attempt to set current for device $analog: $@",$user);
		print "Error: ".$@;
		}
	}
	else
	{
	    print "Warning: No analog output device found with name '$analog' for $rig";
	}
	exit;	    
    }
    else
    {
	my $d = $rig->get_device('PSU',$dev);
	if ($d) {
	    eval {
		$d->current($c,$user);
		if ($c =~ /ocv/i)
		{
		    print "Current set to OCV for $rig";
		}
		else
		{
		    print "Current set to $c A for $rig";
		}
		if ($d->has_ramp)
		{
		    my $ramp = get_CGI_value_clean('ramp');
		    $d->set_ramp($ramp,$user);
		}
	    };
	    if ($@)
	    {
		$rig->errorlog("Error when attempt to set current for device $dev: $@",$user);
		print "Error: ".$@;
	    }
	}
	else
	{
	    print "Warning: No current control device found with name '$dev' for $rig";
	}
    }
    exit;
}
if ($ac eq 'set_voltage')
{
    my $dev = get_CGI_value('dev');
    my $c = get_CGI_value('voltage');
    if ($c =~ /^[\s\t]*([\+\-\.\deE]+)[\s\t]*$/)
    {
	$c = $1;
    }
    else
    {
	$c = 'ocv';
    }
    my $user = &get_user();
    if ($dev =~ /(.*)\s+\(analog\)/)
    {
	my $analog = $1;
	my $d = $rig->get_device('analog',$analog);
	if ($d) {
	    eval {
		$d->set($c);
		print "Voltage output '$analog' set to $c V for $rig";
		$rig->proglog("Voltage for device '$analog' set to $c V",$user);
		if ($d->has_ramp)
		{
		    my $ramp = get_CGI_value_clean('ramp');
		    $d->set_ramp($ramp,$user);
		}
	    };
	    if ($@)
	    {
		$rig->errorlog("Error when attempt to set voltage for device $analog: $@",$user);
		print "Error: ".$@;
	    }
	}
	else
	{
	    print "Warning: No analog output device found with name '$analog' for $rig";
	}
	exit;	    
    }
    else
    {
	my $d = $rig->get_device('PSU',$dev);
	if ($d) {
	    eval {
		$d->voltage($c,$user);
		if ($c =~ /ocv/i)
		{
		    print "Voltage set to OCV for $rig";
		}
		else
		{
		    print "Voltage set to $c V for $rig";
		}
		if ($d->has_ramp)
		{
		    my $ramp = get_CGI_value_clean('ramp');
		    $d->set_ramp($ramp,$user);
		}
	    };
	    if ($@)
	    {
		$rig->errorlog("Error when attempt to set voltage for device $dev: $@",$user);
		print "Error: ".$@;
	    }
	}
	else
	{
	    print "Warning: No voltage control device found with name '$dev' for $rig";
	}
	}
    exit;
}


if ($ac eq 'create_zip')
{
    my $test = get_CGI_value_clean('test');
    my $user = &get_user();
    CGI_client($rig->name,'create_data_archive',$test,$user);
    print 'OK';
    exit;
}
