#!/usr/bin/perl -w

use strict;
use warnings;
use File::Basename;
use Switch;

##################################################

sub usage{
    my $prog = basename($0);
    print <<USAGE
Usage: $prog ALARMS SNAP

Generate EPICS alarm records by munging SNAP file with regexp patterns described in ALARMS.
Resultant snap lines are printed to stdout.
USAGE
}

##################################################

sub readBurt {
    #my ($infile) = @_;
    my @infile = @_;

    my @comments;
    # use a hash to ensure that all channels are unique
    my %chanvalhash; 

    # main foreach loop, allows for multiple infiles to be read
    foreach my $file (@infile){
	# this is to keep track of lines that are part of header
	my $insideHeader = 0;

	open(my $fh, "<", $file) or die "Couldn't open ${file}: $!";

	# line by line
	while (<$fh>) {
	    # remove \n, whitespace, trim
	    chomp;
	    $insideHeader = 1-$insideHeader if(/^--- Start/);
	    if($insideHeader == 0){#not inside Header
		my ($r1,$r2,$r3,$r4) = split(/\s+/);
		my ($ron,$ch,$type,$val);
		#because some channels are not "read-only"
		if($r1 =~ /^(RO|RON)$/){
		    if(defined $r4) { 
			($ron,$ch,$type,$val) = (1,$r2,$r3,$r4); 
		    } else { 
			($ron,$ch,$type,$val) = (1,$r2,1,$r3);   
		    }
		} elsif(defined $r3) {
		    ($ron,$ch,$type,$val) = (0,$r1,$r2,$r3);
		} else {
		    ($ron,$ch,$type,$val) = (0,$r1,1,$r2);
		}
		# add all of the values to the channel list
		$chanvalhash{$ch} = {readonly=>$ron,channel=>$ch,type=>$type,value=>$val};
	    } else {#inside header
		push(@comments,$_);
	    }
	    $insideHeader = 1-$insideHeader if(/^--- End/);
	}
	close($fh);
    }
    my @uniquechanvals = values %chanvalhash;
    return (\@uniquechanvals,\@comments);
}

# This function calculates the high and low values based on 
# the nominal value and the epsilon passed in
# It parses for an operator, then does the calc based on that operator
sub tolerance_calc {
    my ($val, $epsilon) = @_;
    my $low, my $high;
    switch($epsilon){
	# multiplication/factor
	case /\*(.+)/ { 
	    my ($factor) = ($epsilon =~ /\*(.+)/);
	    $low = $val / $factor; 
	    $high = $val * $factor; 
	}
	# percentage
	case /\%(.+)/ { 
	    my ($percent) = ($epsilon =~ /\%(.+)/); 
	    if($val == 0) {
		$low = -1 * $percent;
		$high = $percent;
	    } else {
		$low = $val - ($val * $percent); 
		$high = $val + ($val * $percent);
	    }
	}
	# +/- same
	case /\+\/-(.+)/ { 
	    my ($eps) = ($epsilon =~ /\+\/-(.+)/); 
	    $low = $val - $eps; 
	    $high = $val + $eps; 
	}
	# +/- different
	case /\+(.+)\/-(.+)/ { 
	    my ($lo_eps, $hi_eps) = ($epsilon =~ /\+(.+)\/-(.+)/); 
	    $low = $val - $lo_eps; 
	    $high = $val + $hi_eps; 
	}
	# set to fixed values
	case /H(.+)\/L(.+)/ {
	    my ($set_hi, $set_lo) = ($epsilon =~ /H(.+)\/L(.+)/);
	    $low = $set_lo;
	    $high = $set_hi;
	}
	
	else { die "Error: unrecognized epsilon $epsilon." }
    }
    # Swap for negative numbers
    if ($high < $low){
	($high, $low) = ($low, $high);
    }
    return ($low, $high);
}

sub header {
    my $datestring = `date +%c`;
    chomp $datestring;
    print <<HEADER
--- Start BURT header
Time:     $datestring
Login ID: controls (controls)
Eff  UID: 1001
Group ID: 1001
Keywords:
Comments:
Type:     Absolute
Directory FIXME
Req File: FIXME
--- End BURT header
HEADER
}

##################################################

# error checking
if(@ARGV < 2) { &usage; die "Improper number of arguments.\n"; }

# Get the subsystem, state, and other information
my $alarms_file = shift;
my $snap_file = shift;

my %snapshot_patterns;
open PATTERNS, "<$alarms_file" or die "Couldn't open filter file $alarms_file.";
my @all_patterns = <PATTERNS>;
close PATTERNS;

my @patterns;
foreach my $pattern (@all_patterns) {
    chomp $pattern;
    unless($pattern =~ m/^%/ || $pattern =~ m/^\s*$/){ # Check for comments
	my @args = split(/\s+/, $pattern);
	my ($match_string, $epsilon, $alarm);
	if(@args == 3){
	    ($match_string, $epsilon, $alarm) = @args;
	} else{
	    die "Error: improperly formatted filter line: $pattern.\n";
	}	
	# Put the values into a hash
	# can access the match strings via keys %snapshot_patterns
	$snapshot_patterns{$match_string} = {'epsilon'=>$epsilon, 'alarm'=>$alarm};
	push @patterns, $match_string;
    }
}
close PATTERNS;

# Open the input snap file
my ($chanval_ref, $comment_ref) = readBurt($snap_file);
my @chanvals = sort { $a->{channel} cmp $b->{channel} } @$chanval_ref;
my @comments = @$comment_ref;

# create a value hash so we can lookup value by channel name
my %valhash = ();
foreach my $chanval_hr (@chanvals){
    $valhash{$chanval_hr->{channel}} = $chanval_hr->{value};
}

# # If we find a header with the appropriate number of comments
# # If not, write our own
# if(@comments == 11){
#     foreach my $comment (@comments){
# 	print "$comment\n";
#     }
# } else{
#     &header();
# }

# Write the channels and tolerances to the new burtfile
foreach my $name (keys %valhash){
    my $matched = 0;
    # In order to make sure that we only get channels with alarms
    # (i.e. no string variables or other types of variables without
    # alarms) we pick out variables with the HSV extension, then do 
    # a lookup. 
    if($name !~ /(.+)\.HSV$/) {
	next;
    }
    ($name) = ($name =~ /(.+)\.HSV$/);
    foreach my $pattern (@patterns){
	if(!$matched && $name =~ m/$pattern/){
	    my $nom = $valhash{$name};
	    my ($low, $high) = &tolerance_calc($nom, $snapshot_patterns{$pattern}->{epsilon});
	    my $alm = $snapshot_patterns{$pattern}->{alarm};
	    my ($high_alm, $low_alm) = ($alm, $alm);
	    # If we've specified a different value for high and low alarm severities
	    # make sure that gets placed
	    if($alm =~ m!(.+)/(.+)!){
		($high_alm, $low_alm) = ($alm =~ /(.+)\/(.+)/);
	    }
	    # Since switches can only be positive, make sure that if a switch
	    # is zero we set the low value to 0 and low alarm to NO_ALARM
	    if($name =~ m/SW[12]R/ && $nom <= 0){
		$low = 0;
		$low_alm = 'NO_ALARM';
	    }
	    # Print the alarm fields to file
	    # print "$name \t1 \t$nom\n"; # Don't print channel value, only print alarms
	    print "$name.LOW 1 $low\n";
	    print "$name.HIGH 1 $high\n";
	    print "$name.LSV 1 $low_alm\n";
	    print "$name.HSV 1 $high_alm\n";
	    # note we've already matched this channel, skip other patterns
	    $matched = 1;
	}
    }
}