#!/usr/bin/perl
package judge;
#read .ana and warn about invalid description
#!!ATTENTION!!
#This assumes that current-dir. of anapaw is analogin home

#Usage
#----------------------------
#$./anacheck.ana [path] [option]
#
#[option]
# -s : only checking
# -o : output cleaned-up anafile to STDOUT

use strict;
use warnings;
use IO::File;
use List::Util;

#Parameters
#----------------------------
%judge::algo = ("analys" => \&getAnalys, # selection of parsing routine
"gate" => \&getGate,
"xygate" => \&getXY,
"and" => \&getComGate,
"or" => \&getComGate,
"stop" => \&checkStop,
"hst1" => \&checkhst1,
"hst2" => \&checkhst2,
"end" => \&blank,
"exit" => \&blank,
);
@judge::exists = ("0"); # list of existing gates
@judge::analyser = (); # list of using analyser
$judge::algokey = join("|", keys(%judge::algo)); # for matching
$judge::parsealgo= \␣ # reference to current using parser
$judge::output = 0; # output flag
$judge::message = ""; # message from parser
#$judge::fixed = "";
#----------------------------

my ($path, $mode) = @ARGV; # Read command-line parameter
unless($path){die "Please set a filepath as parameter\n";}
my @tline = &getFile2Array($path); # Read target .ana file
&setMode($mode); # Read option

my $cline = 0;
@tline =
map{ #Parsing
++$cline; # line number incliment
if((m/^c/) or (m/^[\s]*$/)){$_;} # track comment and blank line
else{
if(m/^[\s]*($judge::algokey)/){ # if find a control keyword(-> see %judge::algo), change the parser to correspond one
$judge::parsealgo = $judge::algo{$+};
$_;
}else{
if(&touchStone($_)){$judge::parsealgo = $judge::algo{"gate"}}
my $status = &$judge::parsealgo($_);
if(!defined($status)){ # if parser find an error, it'll return undef
chomp $judge::message;
print STDERR "line$cline error : $judge::message\n";
(); #<-returning a blank list (or blank string)
}elsif($status == 1){ # parser find a warning, it'll return 1
chomp $judge::message;
print STDERR "line$cline warning : $judge::message\n";
();
}else{ # parser would return 0 when it hasn't found any mistake
$_;
}
}
}
} @tline;

if($judge::output){print @tline;}

#Sub Routine
#----------------------------
sub setMode{ # read an option such that "-o"
my $str = $_[0];
unless($str){return;}
unless($str=~m/\-([a-z])/){print STDERR "warning : can't understand parameter! -> as none\n"; return;}
else{
if($+ eq "s"){ # suppress mode :: only evaluation
print STDERR "Output Off\n";
$judge::output = 0;
}elsif($+ eq "o"){ # clean-up mode :: output lines without wrong
print STDERR "Output On\n";
$judge::output = 1;
}
}
}


sub getFile2Array{ # should I explain?
my $path = $_[0];

my $target = IO::File->new();
$target->open($path,"r") or die "$!\n";
my @tline = $target->getlines();
$target->close;

return @tline;
}


sub touchStone{ # check a line able to read as gate definition
my $str = $_[0];
my $sstr = $str;
$str=~s/[\s\,]*((\'|\").+(\'|\"))//;
my $comment = $2;
my @param = split(/[\s\,]+/, $str);
$str = $sstr;
map{s/[\s]+//g}@param;
unless($#param+1 == 7){return 0;}
my $max = pop @param; my $min = pop @param;
map{if(m/[^0-9]/){return 0;}}@param;
map{if(m/[^0-9\.]/){return 0;}}($min, $max);
return 1;
}


sub getGate{ # check and pick gate number
my $str = $_[0];
my @num = split(/[\s\,]+/, $str);
my $gate = shift @num; $gate=~ s/^0+([1-9])/$+/;
if($gate=~m/([0-9]+)/){push @judge::exists, $+;}
else{ $judge::message = "found invalid gate definition -> $_"; return 1;}
return 0;
}


sub getComGate{ # check definition section of combined(i.e. and/or ) gate and pick valid ones
my $str = $_[0];
my $sstr = $str;
$str =~ s/[\s\,]*(\'|\").*(\'|\")//; $str=~s/,[\s]*$//;
my ($gate, @operands) = map{s/^0+([1-9])/$+/; $_;} map{s/[\s]+|-//g; $_;} split(/[\s\,]+/, $str);
my $multiand = 1; # should use "reduce"
map {$multiand *= &arrayexists($_,@judge::exists)} @operands;
if($multiand){
if($gate=~m/([0-9]+)/){push @judge::exists, $+;}
else{ $judge::message = "found invalid gate definition -> $_";
return 1;
}
}else{
$judge::message = "found invalid combination definition - doesn't exist -> $_";
return 1;
}

return 0;
}


sub checkStop{
my $str = $_[0];
$str=~m/([0-9]+)/;
my $gate = $+;
unless(&arrayexists($gate,@judge::exists)){
$judge::message = "found definition of stop using undefined gate -> $_";
return 1;
}
return 0;
}


sub getAnalys{ # pick used analyser
my $str = $_[0];
if($str=~m/^([0-9]+)$/){push @judge::analyser, $+;}
else{ $judge::message = "found invalid analyser definition -> $_"; return 1;}
return 0;
}


sub getXY{ # read .cut file and check definitions of 2dgate, and pick
my $str = $_[0];
my ($misc, $path) = split(/,/, $str);
$path =~ s/[\s]+//g;
my $found = 1;
my $io = IO::File->new();
$io->open("../$path","r") or $found = 0;
my @cuts = ();
if($found){
@cuts = $io->getlines;
$io->close;
}else{
$io->close;
$judge::message = "$path doesn't exist -> $str";
return 1;
}

while(my $line = shift @cuts){
if($line=~m/\#/ and $line!~m/:/){
while($line=~m/\#/){$line = shift @cuts;}
if($line=~m/([0-9]+)/){push @judge::exists, $+;}
else{ $judge::message = "found invalid 2Dgate definition on $path -> $line";
return 1;}
}
}
return 0;
}


sub checkhst1{ # check the definition of 1d-histogram
my $str = $_[0];
my $sstr = $str;
$str=~s/[\s\,]*((\'|\").+(\'|\"))//;
my $comment = $2;
my @param = split(/[\s\,]+/, $str);
$str = $sstr;
map{s/[\s]+//g}@param;
my $gate = shift @param; $gate=~s/-//; $gate=~s/^0+([1-9])/$+/;
my ($a1,$id1l,$id1h,$w1,
$nb1,$mib1,$mab1,
) = map{s/[\s]+//g; $_;} @param;
if($#param+1 != 7){
$judge::message = "found invalid using of separator -> $str";
return undef;
}

unless(&arrayexists($a1,@judge::analyser)){
$judge::message = "found using analyser not exists -> $str";
return 1;
}

unless($mib1 < $mab1){
$judge::message = "found invalid definition of range, min >= max -> $str";
return undef;
}

if($nb1 > 4000){
$judge::message = "Too large bin-number: $nb1 -> $str";
return 1;
}

unless(&arrayexists($gate,@judge::exists)){
$judge::message = "found invalid gate using : $gate doesn't exist -> $str";
return 1;
}
return 0;
}


sub checkhst2{ # check the definition of 2d-histogram
my $str = $_[0];
my $sstr = $str;
$str=~s/[\s\,]*((\'|\").+(\'|\"))//;
my $comment = $2;
my @param = split(/[\s\,]+/, $str);
$str = $sstr;
map{s/[\s]+//g}@param;
my $gate = shift @param; $gate=~ s/-//; $gate=~s/^0+([1-9])/$+/;
my ($a1,$id1l,$id1h,$w1,
$a2,$id2l,$id2h,$w2,
$nb1,$mib1,$mab1,
$nb2,$mib2,$mab2,
) = @param;
if($#param+1 != 14){
$judge::message = "found invalid using of separator -> $str";
return undef;
}
unless(&arrayexists($a1,@judge::analyser) or &arrayexists($a2,@judge::analyser)){
$judge::message = "found using analyser not exists -> $str";
return 1;
}

unless($mib1 < $mab1 or $mib2 < $mab2){
$judge::message = "found invalid definition of range, min >= max -> $str";
return undef;
}

if($nb1 > 2000 or $nb2 > 2000){
$judge::message = "Too large bin-number: $nb1 -> $str";
return 1;
}

unless(&arrayexists($gate,@judge::exists)){
$judge::message = "found invalid gate using : $gate doesn't exist -> $str";
return 1;
}
return 0;
}


sub blank{return 0;}


sub arrayexists{
my ($key, @target) = @_;
map{
if($key eq $_){return 1;}
} @target;
return 0;
}