#!/usr/bin/perl -w
#$Id: report.cgi,v 1.19 2024/04/04 06:49:50 sqko Exp $
use strict;
use warnings;
use Data::Dumper;
use SOAP::Transport::HTTP;

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


package Report;
use RFC::Header;
use RFC::Main;
use RFC::Rig;
use Sys::Hostname;
use IO::Socket::INET;
use SemaforeFile;
use File::Touch;
use vars qw(@ISA);
@ISA = qw(SOAP::Server::Parameters);
my %last_init = ();



=begin WSDL
_DOC Returns the last user performing an action on the specified rig
_IN rignr $int rignumber
_RETURN $string
=end WSDL

=cut



sub last_user
{
    my $class = shift;
    my $rig = shift;
    my $res = '';
    if ($rig && $rig =~ /(\d+)/)
    {
        $rig = $1;
	my @list = &RFC::Main::get_rigs(hostname);
	@list = RFC::Main::get_rigs() unless (@list);
        foreach (@list)
        {
            if ($_ == $rig)
            {
                my $r = RFC::Rig->new($rig);
                ## Reinitialise rig instance to reload if new test ##
                my $t = $last_init{$rig};
                unless ($t && $t > time - 10000)
                {
                    $r->init();
                    $last_init{$rig} = time;
                }
                my $dir = $r->webdir();
                my $file = $dir.'proglog';
                eval {
                    my $f = SemaforeFile->new($file);
		    if ($f->exist())
		    {
			$f->open_readback();
			while (my $line = $f->readline() && !$res)
			{
			    $line = $f->readline();
			    if ($line && $line =~ /user\s+\'([a-zA-Z]+)\'/)
			    {
				$res = $1;
				last;
			    }
			}
		    }
                    $f->close;
                };
                if ($@)
                {
                    &errorlog($@);
                    warn $@;
                }
                last;
            }
        }
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}


=begin WSDL
_DOC Returns a string containing a newline separated list of search results for tests on this server.
_IN searchvalue $string Search_value
_RETURN $string
=end WSDL

=cut

sub search
{
    my $class = shift;
    my $str = shift;
    my $res = '';
#    return SOAP::Data->new(name=>'result',value=>'XXX',type=>'string');
    eval {
	my $fn = $RFC::Header::homedir.'info_table.txt';
	my $lock = $RFC::Header::homedir.'info.lock';
	my $file = SemaforeFile->new($fn,$lock);
	$file->lock_sh;
	$file->open_read;
	while (my $st = $file->readline)
	{	
	    next unless ($st =~ /$str/);
	    chomp $st;
	    $st =~ /\s(\d+)test(\d+)\s+([\w\-\.]+)/;
	    my $rig = $1+0;
	    my $test = $2+0;
	    my $cell = $3;
	    $st .= '#';
	    my $path = $RFC::Header::publicdir.'rig'.$rig.'/'.$rig.'test'.$test.'/';
	    my $psfile = '/home/rig'.$rig.'/'.$rig.'test'.$test.'/'.$rig.'test'.$test.'_'.$cell.'.ps';
	    if (-e($psfile))
	    {
		$st .= ' REPORT';
	    }
	    $psfile = '/home/rig'.$rig.'/'.$rig.'test'.$test.'/'.$rig.'test'.$test.'_'.$cell.'.pdf';
	    if (-e($psfile))
	    {
		$st .= ' PDF';
	    }
	    my $f = $path . 'report.fin';
	    if (-e($f))
	    {
		$st .= ' FINISHED';
	    }
	    $st .= "\n";
	    $res .= $st;
	}
	$file->close;
	$file->lock_un;
    };
    if ($@)
    {
	&errorlog($@);
        return SOAP::Fault->faultcode('Server error')
            ->faultstring($@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/Report');
    }
    chomp $res;
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}

=begin WSDL
_DOC Returns the current test number for the specified rig
_IN rignr $int rig_number
_RETURN $int
=end WSDL

=cut


sub equipmentid
{
    my $class = shift;
    my $rig = shift;
    my $id = undef;
    eval {
	my $r = RFC::Rig->new($rig,0,'nocheck');
	$id = $r->get_cv('main','equipmentid');
	$id = undef unless ($id);
    };
    if ($@)
    {
	&errorlog($@);
        return SOAP::Fault->faultcode('Server error')
            ->faultstring($@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/Report');
    }
    return SOAP::Data->new(name=>'result',value=>$id,type=>'integer');
}



=begin WSDL
_DOC Returns the current test number for the specified rig
_IN rignr $int rig_number
_RETURN $int
=end WSDL

=cut


sub testnr
{
    my $class = shift;
    my $rig = shift;
    my $file = $RFC::Header::publicdir.'rig'.$rig.'/test.nr';
    my $test = undef;
    eval {
	die "Testnr file for rig $rig does not exist on this server!\n" unless (-e $file);
	open MYIN,'<',$file or die "Could not open file $file for reading $!\n";
	$test = <MYIN>;
	close MYIN;
    };
    if ($@)
    {
	&errorlog($@);
        return SOAP::Fault->faultcode('Server error')
            ->faultstring($@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/Report');
    }    
    return SOAP::Data->new(name=>'result',value=>$test,type=>'integer');
}


=begin WSDL
_DOC Returns the current test number for the specified rig
_IN rignr $int rig_number
_IN test $int test_number
_RETURN $int
=end WSDL

=cut


sub info
{
    my $class = shift;
    my $rig = shift;
    my $test = shift;
    $test = 0 if (!$test || $test < 0);
    my @lines = ();
    eval {
	my $file = $RFC::Header::publicdir.'rig'.$rig.'/test.nr';
	open MYIN,'<',$file or die "Could not open file $file for reading $!\n";
	my $maxtest = <MYIN>;
	close MYIN;
	chomp $maxtest;
	if ($test && $test > $maxtest)
	{
	    die "Test $test for rig $rig does not exist on this server!\n";
	}
	$file = $RFC::Header::publicdir.'rig'.$rig.'/'.$rig.'test'.$test.'/info.txt';
	die "Info file for rig $rig test $test does not exist on this server!\n" unless (-e $file);
	open MYIN,'<',$file or die "Could not open file $file for reading $!\n";
	@lines = <MYIN>;
	close MYIN;
    };
    if ($@)
    {
	&errorlog($@);
        return SOAP::Fault->faultcode('Server error')
            ->faultstring($@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/Report');
    }    
    return SOAP::Data->new(name=>'result',value=>join('',@lines),type=>'string');
}



=begin WSDL
_DOC Returns a string describing if the specified rig and test number has a finished standard report prepared.
_IN rignr $int rig_number
_IN testnr $int test_number
_RETURN $string
=end WSDL

=cut


sub is_report
{
    my $class = shift;
    my $rig = shift;
    my $test = shift;
    unless ($rig && $test && $rig =~ /\d/ && $test =~ /\d/)
    {
	return SOAP::Data->new(name=>'result',value=>'',type=>'string');
    }
    $rig += 0;
    $test += 0;
    my $str = $rig.'test'.$test;
    my $cell = '';
    eval {
	my $fn = $RFC::Header::homedir.'info_table.txt';
	my $lock = $RFC::Header::homedir.'info.lock';
	my $file = SemaforeFile->new($fn,$lock);
	$file->lock_sh;
	$file->open_read;
	while (my $st = $file->readline)
	{
	    next unless ($st =~ /\s$str\s/);
	    chomp $st;
	    $st =~ /\s$str\s+([\w\-\.]+)/;
	    $cell = $1;
	    last;
	}
	$file->close;
	$file->lock_un;
    };
    if ($@)
    {
	&errorlog($@);
        return SOAP::Fault->faultcode('Server error')
            ->faultstring($@)
            ->faultdetail(bless {code => 1} => 'BadError')
            ->faultactor('https://'.hostname().'/Report');
    }    
    if ($cell)
    {
        my $st = '';
        my $path = $RFC::Header::publicdir.'rig'.$rig.'/'.$rig.'test'.$test.'/';
        my $psfile = '/home/rig'.$rig.'/'.$rig.'test'.$test.'/'.$rig.'test'.$test.'_'.$cell.'.ps';
        if (-e($psfile))
        {
            $st = $cell . ' REPORT';
        }
        $psfile = '/home/rig'.$rig.'/'.$rig.'test'.$test.'/'.$rig.'test'.$test.'_'.$cell.'.pdf';
        if (-e($psfile))
        {
            $st = $cell .' PDF';
        }
        my $f = $path . 'report.fin';
        if (-e($f))
        {
            $st .= ' FINISHED';
        }
        $st .= "\n";
	return SOAP::Data->new(name=>'result',value=>$st,type=>'string');
    }
    return SOAP::Data->new(name=>'result',value=>'',type=>'string');
}




=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 Returns the RFCcontrol software version
_RETURN $string
=end WSDL

=cut


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

=begin WSDL
_DOC Returns a string containing a tab separated list of server names
_RETURN $string
=end WSDL

=cut


sub servers
{
    my $class = shift;
    my @list = split(/\s*\,\s*/,&get_cv('servers','server_names'));
    my $res = join("\t",@list);
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}

=begin WSDL
_DOC Returns a string containing a tab separated list of list-server names
_RETURN $string
=end WSDL

=cut


sub list_servers
{
    my $class = shift;
    my $str = &get_cv('servers','list_server_names');
    $str = &get_cv('servers','listserver') unless ($str);
    my @list = split(/\s*\,\s*/,$str);
    my $res = join("\t",@list);
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}




=begin WSDL
_DOC Returns a string containing a tab separated list of rig numbers
_RETURN $string
=end WSDL

=cut

sub active_rigs
{
    my $class = shift;
    my $res = join("\t",sort {$a <=> $b} (RFC::Main::get_rigs()));
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}



=begin WSDL
_DOC Returns a string containing a tab separated list of rig numbers
_RETURN $string
=end WSDL

=cut

sub rigs()
{
    my $class = shift;
    my @list = &RFC::Main::get_rigs(hostname);
    my $res;
    if (@list)
    {
        $res = join("\t",sort {$a <=> $b} @list);
    }
    else
    {
        $res = join("\t",sort {$a <=> $b} (RFC::Main::get_rigs()));
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'string');
}


=begin WSDL
_DOC Returns true if the specified rig and test is found on this server
_IN rignr $int rig_number
_IN testnr $int test_number
_RETURN $boolean
=end WSDL

=cut


sub is_test
{
    my $class = shift;
    my $rig = shift;
    my $test = shift;
    my $found = 0;
    my @list = &RFC::Main::get_rigs(hostname);
    @list = RFC::Main::get_rigs() unless (@list);
    foreach my $r (@list)
    {
        next unless ($r == $rig);
        my $path = $RFC::Header::publicdir.'rig'.$rig.'/'.$rig.'test'.$test.'/';
        $found = 1 if (-d $path);
        last;
    }
    return SOAP::Data->new(name=>'result',value=>$found,type=>'boolean');
}


=begin WSDL
_DOC Returns a comma separated list of safety task ids for the specified rig.
_IN rig_task $int rig_number
_RETURN $string
=end WSDL

=cut

sub rig_task
{
    my $class = shift;
    my $rig = shift;
    my $taskid = &get_cv('safety_task_access','rig'.$rig);
    chomp $taskid if ($taskid);
    $taskid = '' unless (defined($taskid));
    return SOAP::Data->new(name=>'result',value=>$taskid,type=>'string');
}


=begin WSDL
_DOC Returns true if the specified user is authroised to use the rig.
_IN rignr $int rig_number
_IN username $string username
_RETURN $boolean
=end WSDL

=cut


sub rig_auth
{
    my $class = shift;
    my $rig = shift;
    my $user = shift;
    my $res = 0;
    if ($user && $rig && $rig =~ /(\d+)/)
    {
	$rig = $1;
	if ($user =~ /(\w+)/)
	{
	    $user = $1;
	}
	else
	{
	    $user = '_nobody_';
	}
	my @list = &RFC::Main::get_rigs(hostname);
	@list = RFC::Main::get_rigs() unless (@list);
      OUTER:
	foreach my $i (@list)
	{
	    if ($i == $rig)
	    {
		$res =  &RFC::RFCCGI::rig_data_access_allow($user);
#		my $r = RFC::Rig->new($rig);
#		my $eqid = $r->get_cv('main','equipmentid');
#		my $remote = $r->get_cv('main','authorisation');
#		if ($eqid && $remote && $remote =~ /remote/i)
#		{
#		    ### Use remote autorisation method ##
#		    $res = &RFC::Main::passwd_client('equip_auth',$user,$eqid);
#		    last OUTER;
#		}
#		my $taskid = &get_cv('safety_task_access','rig'.$rig);
#		unless (defined($taskid) && $taskid)
#		{
#		    $res = 1;
#		    last OUTER;
#		}
#		if ($taskid =~ /NONE/)
#		{
#		    $res = 1;
#		    last OUTER;
#		}
#		foreach my $tid (split(/\s*\,\s*/,$taskid))
#		{
#		    my $res = &RFC::Main::passwd_client('check_task_status',$user,$tid);
#		    if (!defined($res) || $res < 0)
#		    {
#			&errorlog("Check_task_status for task $tid did not return expected value: returned: $res instead!");
#			$res = 0;
#			last OUTER;
#		    }
#		    $res = 0 unless ($res);
#		}
		last OUTER;
	    }
	}
    }
    return SOAP::Data->new(name=>'result',value=>$res,type=>'boolean');
}
