package AFM;
#$Id: AFM.pm,v 1.17 2013/01/03 12:22:46 sofc Exp $
use strict;
use warnings;
use RFC::Header;
use RFC::Main qw();
use RFC::Rig;
use SocketClient qw();
use SemaforeFile;
use ElchemeaConfig;
use Fcntl qw(:DEFAULT :flock);

BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.0;
    %EXPORT_TAGS = (
        'standard'=>[qw/$publicdir check_run get_config_global get_cv get_usercv get_usercv_test get_config_value_old valid_data check_rig_nr get_test_nr get_user_name add_zero lock_rig unlock_rig errorlog $name/],
                    );
    Exporter::export_ok_tags('standard');
    Exporter::export_tags('standard');
    @ISA = qw(Exporter);
}

my $rig = undef;
our $name = 'Risoe celltest controll facility version 4.0.0 in compatibility mode';

sub mail
{
    &RFC::Main::mail(@_);
}

sub errorlog
{
    RFC::Main::errorlog(@_);
}

sub GPIB_client(@)
{
    return SocketClient::GPIB_client(@_);
}

sub serial_client($@)
{
    my $tty = shift;
    return SocketClient::serial_client($tty,@_);
}

sub lock_rig($)
{
    my $r = shift;
    $rig = RFC::Rig->new($r) unless ($rig && $rig->name eq $r);
    $rig->lock_control();
}

sub unlock_rig($)
{
    my $r = shift;
    $rig = RFC::Rig->new($r) unless ($rig && $rig->name eq $r);
    $rig->unlock_control();
}

sub check_run($)
{
    my $r = shift;
    $rig = RFC::Rig->new($r) unless ($rig && $rig->name eq $r);
    return $rig->check_run;
}

sub get_config_global($$)
{
    return &get_cv(@_);
}

sub get_cv($$)
{
    my $section = shift;
    my $key = shift;
    return RFC::Main::get_cv($section,$key);
}

sub get_config_value_old($$$)
#### get_config_value_old($$$):                                 ###
#### Function that returns the value matching the input $string ###
#### The search is done in the configfile for rig $rig          ###
#### If no match is found, the result is the empty string       ###
#### The match is made by patternmatch, so some abbrevation can ###
#### be accepted, but this function returns the last match      ###
#### found if there are duplicate matches (last by alphabet!!!) ###
#### Maintained for backwards compatability only!               ###
{
    my $tmprig = $_[0];
    $tmprig =~ /(\d+)/;
    my $rig = $1;
    my $tmpstr = $_[1];
    my $ttest = $_[2];
    if ($ttest =~ /(\d+)/)
    {
        $ttest = $1+0;
    }
    else
    {
        return undef;
    }
    if (!defined($tmpstr))
    {
        return undef;
    }
    if (length($tmpstr)<1)
    {
        return "";
    }
    $tmpstr =~ /([\w\.]+)/;
    my $string = $1;

    my $file = $publicdir.'rig'.$rig.'/'.$rig.'test'.$ttest.'/configfile';
    sysopen(FH, $configlock, O_WRONLY | O_CREAT) or die &errorlog("Cant open lockfile $configlock $!\n");
    flock(FH, LOCK_SH);
    open DATA , '<', $file or die &errorlog("Cant open old configuration file $file $!\n");
    my %data = ();
    while (my $str = <DATA>)
    {
        if (!($str =~ /^\s+$/))
        {
            if ($str && $str =~ /([\w\.]+)[\s\=\:]+([\w\.\:]*)/)
	    {
		$data{$1} = $2;
	    }
        }
    }
    close(DATA);
    flock(FH, LOCK_UN);
    close(FH);
    my $res = "";
    foreach my $key (sort keys %data)
    {
        if ($key =~ /^$string$/)
        {
            $res = $data{$key};
        }
    }
    $res =~ s/\s*$//;
    return $res;
}

sub get_usercv($$$)
{
    my $r = shift;
    $rig = RFC::Rig->new($r) unless ($rig && $rig->name eq $r);
    return $rig->get_cv(@_);
}

sub get_usercv_test($$$$)
{
    my $r = shift;
    $rig = RFC::Rig->new($r) unless ($rig && $rig->name eq $r);
    my $test = shift;
    my $section = shift;
    my $key = shift;
    return $rig->get_cv_test($section,$key,$test);
}

sub remove_underscores($)
##################################################################
### Replaces any SINGLE underscore with space and any DOUBLE   ###
### underscores with a single one (Handy for gnuplot!)         ###
##################################################################
{
    my $string = shift;
    $string =~ s/([a-zA-Z0-9])_([a-zA-Z0-9])/$1 $2/g;
    $string =~ s/__/_/g;
    return $string;
}

sub get_test_nr()
{
    my $r = shift;
    $rig = RFC::Rig->new($r) unless ($rig && $rig->name eq $r);
    return  $rig->session();
}

sub get_user_name($)
{
    my $u = shift;
    return RFC::Main::get_user_name($u);
}

sub check_rig_nr($)
{
    my $r = shift;
    return RFC::Main::check_rig_nr($r);
}

sub valid_data($$)
{
    my $file = $_[0];
    my $ignore = $_[1];
    my @valid = ();
    my $str = `/usr/bin/head -1 $file`;
    chomp $str;
    my @list = split(/\s+/,$str);
    ### As validata only accepts less than 100 columns, assume they are ok if more than that ####
    if (@list > 99)
    {
        foreach (@list)
        {
            push @valid,1;
        }
        return @valid;
    }
    my $validdata = '/usr/local/bin/validata';
    unless (-e $validdata)
    {
        foreach (@list)
        {
            push @valid,1;
        }
        return @valid;
    }
    my $command = "$validdata < $file 2> /dev/null";
    my $res = `$command`;
    if ($res)
    {
        my @outst = split("\n",$res);
        for (my $x = 1; $x < scalar(@outst); $x++)
        {
            $outst[$x] =~ /([\w]+)\s+([\+\-\d\.\w]+)\s+([\+\-\d\.\w]+)\s*$/;
            my $type = $1;
            my $min = $2;
            my $max = $3;
            my $myvalid = 1;
            if ($type =~ /other/)
            {
                $myvalid = 0;
            }
            if ($type =~ /alnum/)
            {
                $myvalid = 0;
            }
            if (($min == $max) && ($ignore))
            {
                $myvalid = 0;
            }
            if (($min == -32768) && ($min == $max))
            {
                $myvalid = 0;
            }
            $valid[$x-1] = $myvalid;
        }
    }
    return @valid;
}


sub add_zero($)
{
    my $n = shift;
    if ($n > 0 && $n < 100)
    {
	$n = sprintf("%02d",$n);
    }
    return $n;
}


return 1;
