Add features to debug notation process
This commit is contained in:
parent
67b5a79301
commit
d3e723f65a
@ -46,7 +46,7 @@ sub create_from_trace ($$)
|
|||||||
|
|
||||||
for my $id (sort( keys %{ $trace->{ids} } ))
|
for my $id (sort( keys %{ $trace->{ids} } ))
|
||||||
{
|
{
|
||||||
my $p = Point->new(0, $id, 0, 0);
|
my $p = Point->new($trace->{ids}{$id}, $id, 0, 0);
|
||||||
push @{ $g->{tree} }, $p;
|
push @{ $g->{tree} }, $p;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -264,7 +264,7 @@ sub compute ($$$;$$)
|
|||||||
@current;
|
@current;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$res = $current[0];
|
$res = $current[0] // 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
$res = $res * $self->{factor};
|
$res = $res * $self->{factor};
|
||||||
@ -287,6 +287,7 @@ package Point;
|
|||||||
use v5.10.1;
|
use v5.10.1;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
use Term::ANSIColor qw(:constants);
|
||||||
|
|
||||||
sub new ($$$$$)
|
sub new ($$$$$)
|
||||||
{
|
{
|
||||||
@ -315,12 +316,16 @@ sub to_string ($$$)
|
|||||||
$parent->appendChild($point);
|
$parent->appendChild($point);
|
||||||
}
|
}
|
||||||
|
|
||||||
sub getValue ($$)
|
sub getValue ($$;$)
|
||||||
{
|
{
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $ids = shift;
|
my $ids = shift;
|
||||||
|
my $justMatch = shift;
|
||||||
|
|
||||||
if ($self->{value} eq "") {
|
if (!$justMatch && !$ids->{ $self->{ref} } // 0) {
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
elsif ($self->{value} eq "") {
|
||||||
return $ids->{ $self->{ref} } // 0;
|
return $ids->{ $self->{ref} } // 0;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
@ -347,6 +352,16 @@ sub compute ($$$;$$)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if ($main::debug)
|
||||||
|
{
|
||||||
|
my $str = "not=".($self->{not}//0).", qversion".($self->{qversion}//"*").", ref=".($self->{ref}//"").",\tvalue=".$self->getValue( $ids, 1 ).", got=".($ret // 0);
|
||||||
|
if ($ret) {
|
||||||
|
say GREEN, ">>>", RESET, " Matching point: ", $str;
|
||||||
|
} else {
|
||||||
|
say RED, " * ", RESET, " Skipped point: ", $str;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
return $ret;
|
return $ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -7,21 +7,51 @@ use Getopt::Long;
|
|||||||
use Pod::Usage;
|
use Pod::Usage;
|
||||||
|
|
||||||
use lib "..";
|
use lib "..";
|
||||||
|
use ACU::Defense;
|
||||||
use ACU::Grading;
|
use ACU::Grading;
|
||||||
|
use ACU::Log;
|
||||||
use ACU::Trace;
|
use ACU::Trace;
|
||||||
|
|
||||||
my $grade = Grading->new();
|
my $grade = Grading->new();
|
||||||
|
my $lastid = "";
|
||||||
|
|
||||||
do {
|
do {
|
||||||
|
my $name = shift;
|
||||||
|
my $file;
|
||||||
|
|
||||||
|
if (-f $name) {
|
||||||
|
$file = $name;
|
||||||
|
$name = "rendu-1";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$file = shift;
|
||||||
|
}
|
||||||
|
my $id_name = $name;
|
||||||
|
$id_name =~ s/[^a-zA-Z0-9_]/_/g;
|
||||||
|
|
||||||
my $xml;
|
my $xml;
|
||||||
open $xml, "<", shift or die $!;
|
open $xml, "<", $file or die $!;
|
||||||
binmode $xml;
|
binmode $xml;
|
||||||
|
|
||||||
my $trace = Trace->new($xml);
|
my $trace;
|
||||||
|
eval {
|
||||||
|
$trace = Trace->new($xml);
|
||||||
|
};
|
||||||
|
if ($@) {
|
||||||
|
open $xml, "<", $file or die $!;
|
||||||
|
binmode $xml;
|
||||||
|
|
||||||
|
eval {
|
||||||
|
$trace = Defense->new($xml);
|
||||||
|
};
|
||||||
|
if ($@) {
|
||||||
|
log ERROR, "Unknown file type: $file";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
close $xml unless $xml eq *STDIN;
|
close $xml unless $xml eq *STDIN;
|
||||||
|
|
||||||
$grade->create_from_trace("rendu_1", "rendu-1", $trace);
|
$grade->create_from_trace($id_name, $name, $trace);
|
||||||
|
|
||||||
} while ($#ARGV >= 0);
|
} while ($#ARGV >= 0);
|
||||||
|
|
||||||
|
@ -13,11 +13,13 @@ use ACU::Log;
|
|||||||
use ACU::Trace;
|
use ACU::Trace;
|
||||||
|
|
||||||
# Parse arguments
|
# Parse arguments
|
||||||
|
our $debug;
|
||||||
my $input; my $format = "csv";
|
my $input; my $format = "csv";
|
||||||
my $help; my $man;
|
my $help; my $man;
|
||||||
GetOptions ("help|h|?" => \$help,
|
GetOptions ("help|h|?" => \$help,
|
||||||
"man" => \$man,
|
"man" => \$man,
|
||||||
"format|F=s" => \$format,
|
"format|F=s" => \$format,
|
||||||
|
"debug|d|v" => \$debug,
|
||||||
"" => \$input)
|
"" => \$input)
|
||||||
or pod2usage(2);
|
or pod2usage(2);
|
||||||
pod2usage(1) if $help;
|
pod2usage(1) if $help;
|
||||||
@ -52,7 +54,9 @@ while ($#ARGV >= -1)
|
|||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
open my $xmltrace, "<", $arg or die $!;
|
if (-f $arg)
|
||||||
|
{
|
||||||
|
open my $xmltrace, "<", $arg or die "$arg: $!";
|
||||||
binmode $xmltrace;
|
binmode $xmltrace;
|
||||||
my $trace = Trace->new($xmltrace);
|
my $trace = Trace->new($xmltrace);
|
||||||
close $xmltrace;
|
close $xmltrace;
|
||||||
@ -60,4 +64,8 @@ while ($#ARGV >= -1)
|
|||||||
$grade->fill($trace->getIds);
|
$grade->fill($trace->getIds);
|
||||||
$who = $trace->getFirstWho() // basename $arg, ".xml", ".trace", ".traces", ".defense", ".defenses", ".mill";
|
$who = $trace->getFirstWho() // basename $arg, ".xml", ".trace", ".traces", ".defense", ".defenses", ".mill";
|
||||||
}
|
}
|
||||||
|
else {
|
||||||
|
log WARN, "No trace file: $arg, skip";
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
Reference in New Issue
Block a user