#!/usr/bin/perl -T
# $Id: setup_program.cgi,v 1.44 2023/11/24 09:11:36 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;
use SemaforeFile;

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

my $isused = 0;
my $cmd = '/bin/ps -efl | /bin/grep custom_prog.pl | /bin/grep -P "rig'.$rig->name.'\\b"';
my $str = `$cmd`;
my @list = ();
@list = split(/\n/,$str) if ($str);
foreach (@list)
{
    $isused = 1 if /celltest/;
}
my @compfiles;
my $file = SemaforeFile->new($RFC::Header::publicdir.'rig'.$rig->name.'/custom.conf');
my $comploc = get_cv('impedance','standard_compensation_files');
for (my $x = 0; $x < @compfiles; $x++)
{
    $compfiles[$x] =~ /([\w\.]+)$/;
    $compfiles[$x] = $1;
}
if ($comploc)
{
    my $ending = '\.i2b';
    if ($comploc =~/(\w*\*\.\w+)$/)
    {
	$ending = $1;
	if ($ending =~ /^\*\./)
	{
	    $ending =~ s/^\*/\\/;
	}
	$comploc =~ s/\w*\*\.i2b$//;
    }
    opendir(DIR,$comploc) or die "Cant open dir $comploc $!";
    @compfiles = grep {/$ending/o && -e "$comploc/$_"} readdir(DIR);
    closedir DIR;
}
else
{
    my $dir = $RFC::Header::publicdir.'rig'.$rig->name.'/imp_comp/';
    opendir(DIR,$dir) or die "Cant open dir $dir $!";
    @compfiles = grep { !/^\./ && -e "$dir/$_"} readdir(DIR);
    closedir DIR;
}


if (!defined(param))
{
    print process('to_login.tt');
}
else
{
    if ($uid)
    {
        print process('main_nav.tt');
        $_ = param('action');
      CASE:
        {
	    ### Insert case statements ###
	    /^Save$/ and do {&save; &main_page; last CASE;};
	    /^wait_input/ and do {&wait_input; &main_page; last CASE;};
	    /^Clear\s+program$/ and do {&clear_prog; last CASE;};
	    /^mleak$/ and do {&add_cmd('m_leak'); &main_page; last CASE;};
	    /^measure$/ and do {&add_cmd('measure'); &main_page; last CASE;};
	    /^iv$/ and do {&add_cmd('iv'); &add_cmd('wait = '.&get_CGI_value_clean('wait')); &main_page; last CASE;};
	    /^ivwait$/ and do {&add_cmd('ivwait'); &main_page; last CASE;};
	    /^killiv$/ and do {&add_cmd('killiv'); &main_page; last CASE;};
	    /^flowvar$/ and do {&add_cmd('#FLOWVAR'); &main_page; last CASE;};
	    /^OCV$/ and do {&add_cmd('current = OCV '.get_CGI_value_clean('device')); &main_page; last CASE;};
	    /^current$/ and do {&add_cmd('current = '.&get_CGI_value_clean('current').' '.get_CGI_value_clean('device')); &main_page; last CASE;};
	    /^voltage$/ and do {&add_cmd('voltage = '.&get_CGI_value_clean('voltage').' '.get_CGI_value_clean('device')); &main_page; last CASE;};
	    /^wait$/ and do {&add_cmd('wait = '.&get_CGI_value_clean('wait')); &main_page; last CASE;};
	    /^set_gas$/ and do {&add_cmd('gas:'. &get_CGI_value_clean('gas') . ' = ' . &get_CGI_value_clean('flow')); &main_page; last CASE;};
	    /^set_pressure$/ and do {&add_cmd('pressure:'. &get_CGI_value_clean('gas') . ' = ' . &get_CGI_value_clean('flow')); &main_page; last CASE;};
	    /^set_pid$/ and do {&add_cmd('PID:'. &get_CGI_value_clean('pid') . ' = ' . &get_CGI_value_clean('setpoint')); &main_page; last CASE;};
	    /^std_imp$/ and do {&imp(0); &main_page; last CASE;};
	    /^current_imp$/ and do {&cimp(); &main_page; last CASE;};
	    /^potsweep$/ and do {&cimp('potsweep'); &main_page; last CASE;};
	    /^chrono$/ and do {&cimp('chrono'); &main_page; last CASE;};
	    /^single_imp$/ and do {&imp(1); &main_page; last CASE;};
	    /^socket_call$/ and do {&socket_call; &main_page; last CASE;};
	    /^temp$/ and do {&add_cmd('ramp = '.&get_CGI_value_clean('ramp').' '.get_CGI_value_clean('device')); &add_cmd('temp = '.&get_CGI_value_clean('temp').' '.get_CGI_value_clean('device')); &main_page; last CASE;};
	    /^adjust$/ and do {&add_cmd('addjust_temp '.&get_CGI_value_clean('temp').' '. &get_CGI_value_clean('offset').' '.get_CGI_value_clean('device')); &main_page; last CASE;};
	    /^text$/ and do {&add_cmd('text = '.&get_CGI_value_clean('text')); &main_page; last CASE;};
	    /^Delete\s+last\s+line$/ and do {&dellast; &main_page; last CASE;};
	    /^Run\sprogram$/ and do {&run_prog; last CASE;};
	    /^Stop\sprogram$/ and do {&stop_prog; last CASE;};
	    /^Load\sold/ and do {&load_main; last CASE;};
	    /^select_prog$/ and do {&load; &main_page; last CASE;};
	    /^gas_multiplex$/ and do {&multiplex; &main_page; last CASE;};
	    /^water_enable/ and do {&add_cmd('water:'. &get_CGI_value_clean('wname') . ' = ' . &get_CGI_value_clean('status')); &main_page; last CASE;};
	    /^relay_enable/ and do {&add_cmd('relay:'. &get_CGI_value_clean('rname') . ' = ' . &get_CGI_value_clean('status')); &main_page; last CASE;};
	    /^exec/ and do {&add_cmd('exec:'.&get_CGI_value('program').' '.&get_CGI_value('args')); &main_page; last CASE;};
	    ### Default response ####
    	    &main_page;
        }
        print process('end_html.tt');
    }
    else 
    {
        print process('not_auth.tt');
    }
}
exit;

sub save
{
    my $fn = 'custom.conf';
    my $file = SemaforeFile->new($RFC::Header::publicdir.'rig'.$rig->name.'/'.$fn);
    my $string = param('program');
    $file->writeline($string);
}

sub main_page_template
{
    my $server = $rig->get_cv('impedance','server');
    my $port = $rig->get_cv('impedance','port');
    my $isuser = $rig->get_cv('impedance','user');
    my $session = $rig->get_cv('impedance','session');
    my $comp = $rig->get_cv('impedance','compensation');
    $comp = 'DEFAULT' unless ($comp);
    $server = '127.0.0.1' unless ($server);
    $port = '4040' unless ($port);
    $isuser = get_user() unless ($isuser);
    $session = 1 unless ($session);
    $str = '';
    $str = join("\n",$file->readlines()) if (-e $file->filename);
    my %data = (
	'PSUs' => [$rig->list_devices_control('PSU')],
	'gasses' => [$rig->list_devices_control('gas')],
	'waters' => [$rig->list_devices_control('water')],
	'PIDs' => [$rig->list_devices_control('PID')],
	'tempcontrols' => [$rig->list_devices_control('tempcontrol')],
	'relays' => [$rig->list_devices_control('relay')],
	'program' => $str,
	'server' => $server,
	'comp' => $comp,
	'port' => $port,
	'session' => $session,
	'impuser' => $isuser,
	'compfiles' => [@compfiles],
	'temp' => 750,
	'ramp' => 60,
	'tempoffset' => 5,
	'maxtime' => 60,
	);
    my %mgasses = ();
    my %mtypes = ();
    my @l = ();
    foreach my $d ($rig->list_devices_control('multiplex'))
    {
        my $dev = $rig->get_device('multiplex',$d);
        my %h = (
            'name' => $dev->name(),
	    'label' => $dev->label(),
            );
        push @l,\%h;
	$mgasses{$d} = [$dev->gasses()];
	$mtypes{$d} = $dev->type();
    }
    $data{'multiplexers'} = [@l];
    $data{'mgasses'} = \%mgasses;
    $data{'mtypes'} = \%mtypes;
    my $path = $RFC::Header::libdir.'user_exec/';
    opendir DIR,$path or die &errorlog("Could not open dir $path: $!");
    my @list = grep {!/^\./} readdir DIR; ## Only read real files and not . or ..
    closedir DIR;
    $data{'programs'} = [@list];
    my $f = $RFC::Header::publicdir.'rig'.$rig->name.'/flowvar.conf';
    open MYIN,'<',$f;
    my @flowlines = <MYIN>;
    close MYIN;
    $f = $RFC::Header::publicdir.'rig'.$rig->name.'/impedance.conf';
    open MYIN,'<',$f;
    my @implines = <MYIN>;
    close MYIN;
    $data{'flowlines'} = [@flowlines];
    $data{'implines'} = [@implines];
    print process('program.tt',&get_template_data_ref(\%data));
}


sub wait_input
{
    my $devname = &get_CGI_value_clean('rname');
    return unless ($devname);
    my $maxtime = &get_CGI_value_clean('maxtime');
    if ($maxtime)
    {
	&add_cmd('wait_for_input: '.$devname.' '.$maxtime);
    }
    else
    {
	&add_cmd('wait_for_input: '.$devname);
    }
}

sub load_main
{
    my $test = $rig->session;
    $test = &get_CGI_value_clean('test') if (&get_CGI_value('test'));
    my $cmd = '/bin/ls -1 '.$RFC::Header::publicdir.'rig'.$rig->name.'/'.$rig->name.'test'.$test.'/program_*.txt';
    my @list = `$cmd`;
    my %data = (
	'files' => [@list],
	);
    print process('load_program.tt',&get_template_data_ref(\%data));
}

sub load
{
    eval
    {
	my $f = &get_CGI_value('file');
	$f =~ /([\w\-\.\/\:]+)/;
	$f = $1;
	if ($f)
	{
	    my $old = SemaforeFile->new($f);
	    my @lines = $old->readlines();
	    $file->writeline(@lines);
	}
	else
	{
	    &print_error('No filename specified, operation aborted!');
	}
    };
    if ($@)
    {
	&errorlog($@);
	&print_error();
    }
}


sub stop_prog
{
    eval
    {    
	my $res = RFC::Main::CGI_client($rig->name,"stop_custom"); 
	my $user = get_user();
	$rig->proglog("Program terminated",$user);
	my %data = (
	    'message' => "Program for rig ".$rig->name." terminated by user $user",
	    );
	print process('start_stop.tt',&get_template_data_ref(\%data));
    };
    if ($@)
    {
	&errorlog($@);
	&print_error();
    }

}

sub run_prog
{
    my $test = $rig->session;
    eval
    {
	my @lines = ();
	$file->lock_ex;
	$file->open_read;
	while (my $st = $file->readline)
	{
	    push @lines,$st unless ($st =~ /^\#/);
	    if ($st =~ /^\#FLOWVAR/)
	    {
		$st = '#'.$st;
		#### get all flowvar ####
		my $f = $RFC::Header::publicdir.'rig'.$rig->name.'/flowvar.conf';
		open FIN,'<',$f or die "Could not open file $f for reading: $!";
		while (<FIN>)
		{
		    push @lines , $_ unless ($_ =~ /^\#/);
		}
		close FIN;
	    }
	    if ($st =~ /^\#STDIMP/)
	    {
		$st = '#'.$st;
		$st =~ /IP:([\w\-\.]+)/;
		my $ip = $1;
		$st =~ /PORT:(\d+)/;
		my $port = $1;
		$st =~ /USER:(\w+)/;
		my $user = $1;
		$st =~ /SESSION:(\d+)/;
		my $session = $1;
		$st =~ /BOX:(\d+)/;
		my $box = $1;
		$st =~ /COMP:([\w\.\/]+)/;
		my $comp = $1;
		$comp = 'short.i2b' if ($comp eq 'DEFAULT');
		my $impstr = "impedance $ip:$port $session $user comp:$comp";
		my $cimpstr = "current_impedance $ip:$port $session $user comp:";
		my $ip_user = "$ip:$port $user";
		my $imp_uncomp = "impedance $ip:$port $session $user";
		my $f = $RFC::Header::publicdir.'rig'.$rig->name.'/impedance.conf';
		open IIN,'<',$f or die "Could not open file $f for reading: $!";
		while (my $s = <IIN>)
		{
		    $s =~ s/ADDR/$box/;
		    $s =~ s/impedance CONF/$impstr/;
		    $s =~ s/current_impedance CONF/$cimpstr/;
		    $s =~ s/impedance UNCOMP/$imp_uncomp/;
		    $s =~ s/IP_USER/$ip_user/;
		    push @lines , $s unless ($s =~ /^\#/);
		}
		close IIN;
	    }
	}
	$file->close;
	$file->unlock;
	##### Create new unique file name for program name ####
	my $dat = `date +"%Y:%m:%d:%H:%M"`;
	$dat =~ /([\d\:]*)/;
	$dat = $1;
	my $file1 = SemaforeFile->new($RFC::Header::publicdir.'rig'.$rig->name.'/'.$rig->name.'test'.$rig->session.'/program_'.$dat.'.txt');
	$file1->writeline(@lines);
	my $user = &get_user();
	my $res = RFC::Main::CGI_client($rig->name,'custom',$file1->filename,$user); 
	if ($res)
	{
	    $rig->proglog("Program ".$file1->filename." activated by",$user);
	    $file->writeline();
	    my %data = (
		'message' => "Program ".$file1->filename." activated for rig ".$rig->name,
		);
	    print process('start_stop.tt',&get_template_data_ref(\%data));
	}
    };
    if ($@)
    {
	&errorlog($@);
	&print_error();
    }
}


sub main_page
{
    if (!$isused)
    {
	return &main_page_template();
    }
    else
    {
	my $f = '';
        my $cmd = '/bin/ps -efl | /bin/grep custom_prog.pl | /bin/grep -P "rig'.$rig->name.'\\b"';
        my $string = `$cmd`;
        my @list = ();
        @list = split(/\n/,$str) if ($str);
	for my $str (@list)
	{
	    if ($str =~ /(\/home\/http\/html\/[\w\/\:\.]+)/)
	    {
		$f = SemaforeFile->new($1);
	    }    
	}
	my $str = '';
	if ($f && -e $f->filename)
	{
	    $str = join("\n",$f->readlines());
	}
	my %data = (
	    'program' => $str,
	    );
	print process('stop_program.tt',&get_template_data_ref(\%data));
    }
}


sub clear_prog()
{
    eval
    {
	$file->lock_ex;
	$file->open_write;
	$file->close;
	$file->lock_un;
    };
    if ($@)
    {
	&errorlog($@);
	&print_error();
    }
    &main_page();
}

sub add_cmd()
{
    my $cmd = shift;
    chomp $cmd;
    eval
    {
	$file->append($cmd);
    };
    if ($@)
    {
	&errorlog($@);
	&print_error();
    }
}

sub dellast
{
    eval 
    {
	my @l = ();
	@l = $file->readlines() if (-e $file->filename);
	pop @l if (@l);
	$file->writeline(@l);
    };
    if ($@)
    {
	&errorlog($@);
	&print_error();
    }
}

sub imp
{
    my $mode = shift;
    my $ip = &get_CGI_value('ip');
    my $port = &get_CGI_value_clean('port');
    my $addr = 0;
    my $file = &get_CGI_value('comp');
    my $user = &get_CGI_value_clean('riguser');
    my $session = &get_CGI_value_clean('session');
    if ($ip && $ip =~ /([\w\-\.]*)/)
    {
	$ip = $1;
    }
    if ($file && $file =~ /([\w\.\/]*)/)
    {
	$file = $1;
    }
    $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 = $publicdir.'rig'.$rig->name.'/imp_comp/';
    $dir = $comploc if ($comploc);
    if ($mode)
    {
	if ($rig->list_devices_control('PSU'))
	{
	    &add_cmd("measure");
	    &add_cmd("current = OCV");
	    &add_cmd("wait = 1");
	}
	&add_cmd("measure");
	&add_cmd("wait = 1");
	&add_cmd("impedance $ip:$port $session $user comp:$dir$file");
    }
    else
    {
	$dir = '' if ($file =~ /DEFAULT/);
	&add_cmd("#STDIMP IP:$ip PORT:$port USER:$user SESSION:$session BOX:$addr COMP:$dir$file");
    }
}

sub socket_call
{
    my $ip = &get_CGI_value('ip');
    my $port = &get_CGI_value_clean('port');
    if ($ip && $ip =~ /([\d\.]+)/)
    {
	$ip = $1;
	$rig->change_config_value('impedance','server',$ip);
    }
    $rig->change_config_value('impedance','port',$port);
    my $argstr = &get_CGI_value('args');
    $argstr = '' unless (defined($argstr));
    my @args = split(/\s*\,\s*/,$argstr);
    &add_cmd("socket $ip:$port ".join("\t",@args));
}

sub cimp
{
    my $ip = &get_CGI_value('ip');
    my $port = &get_CGI_value_clean('port');
    my $user = &get_CGI_value_clean('riguser');
    my $session = &get_CGI_value_clean('session');
    if ($ip && $ip =~ /([\w\-\.]*)/)
    {
	$ip = $1;
    }
    $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);
    &add_cmd("measure");
    if (@_)
    {
	my $cmd = shift;
	&add_cmd("$cmd $ip:$port $session $user comp:");
    }
    else
    {
	&add_cmd("current_impedance $ip:$port $session $user comp:");
    }
}


sub multiplex
{
    my $cn = &get_CGI_value_clean('controler');
    my $gas = &get_CGI_value_clean('gas');
    my $flow = &get_CGI_value_clean('flow');
    return unless (defined($gas) && $gas ne '');
    &add_cmd("gas_multiplexer $cn $gas"); 
    my $d = $rig->get_device('multiplex',$cn);
    if ($d->type ne 'Selector')
    {
	&add_cmd("gas:$gas = $flow");
    }
}
