Rename common to ACU
This commit is contained in:
Mercier Pierre-Olivier
parent
641b516355
commit
e243e7bbcf
4 changed files with 82 additions and 48 deletions
246
ACU/Grading.pm
Normal file
246
ACU/Grading.pm
Normal file
|
|
@ -0,0 +1,246 @@
|
|||
#! /usr/bin/env perl
|
||||
|
||||
package Grading;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use XML::LibXML;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
operators => {
|
||||
'add' => '$a+$b'
|
||||
},
|
||||
tree => undef,
|
||||
ids => {}
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
$self->_initialize(@_);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub _initialize
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
my $dom = XML::LibXML->load_xml(IO => shift);
|
||||
$self->{tree} = $self->parseGrade($dom->documentElement());
|
||||
}
|
||||
|
||||
sub parseGrade ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $ret = [];
|
||||
my $node = shift;
|
||||
|
||||
foreach my $grade ($node->childNodes()) {
|
||||
if ($grade->nodeName eq "operator") {
|
||||
my $tmp = $grade->textContent;
|
||||
chomp($tmp);
|
||||
$self->{operators}{ $grade->getAttribute("name") } = $tmp;
|
||||
}
|
||||
elsif ($grade->nodeName eq "grade") {
|
||||
my $g = Grade->new(
|
||||
$grade->getAttribute("id"),
|
||||
$grade->getAttribute("operator"),
|
||||
$grade->getAttribute("factor")
|
||||
);
|
||||
$g->append(@{ $self->parseGrade($grade) });
|
||||
push @$ret, $g;
|
||||
}
|
||||
elsif ($grade->nodeName eq "point") {
|
||||
my $n = Point->new(
|
||||
$grade->textContent,
|
||||
$grade->getAttribute("ref"),
|
||||
$grade->getAttribute("qversion"),
|
||||
$grade->getAttribute("not")
|
||||
);
|
||||
push @$ret, $n;
|
||||
}
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub reset ($)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->{ids} = {};
|
||||
}
|
||||
|
||||
sub insert ($$$)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->{ids}{$_[0]} = $_[1];
|
||||
}
|
||||
|
||||
sub fill ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
$self->{ids} = shift;
|
||||
}
|
||||
|
||||
sub compute ($)
|
||||
{
|
||||
my $self = shift;
|
||||
my $sum = 0;
|
||||
|
||||
for my $grade (@{ $self->{tree} }) {
|
||||
my $tmp = $grade->compute($self->{operators}, $self->{ids});
|
||||
$sum += $tmp if $tmp;
|
||||
}
|
||||
|
||||
return $sum;
|
||||
}
|
||||
|
||||
sub generate ($;$)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
my $output = shift;
|
||||
|
||||
my $xmlout;
|
||||
if (not $output) {
|
||||
$xmlout = *STDOUT;
|
||||
}
|
||||
else {
|
||||
open $xmlout, "<", $output or die $!;
|
||||
}
|
||||
binmode $xmlout;
|
||||
|
||||
my $dom = XML::LibXML::Document->createDocument("1.0", "UTF-8");
|
||||
my $root = $dom->createElement("grade");
|
||||
}
|
||||
|
||||
|
||||
package Grade;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Safe;
|
||||
use List::Util "reduce";
|
||||
|
||||
sub new ($$;$$)
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
id => shift,
|
||||
operator => shift // "add",
|
||||
factor => shift // 1,
|
||||
tree => []
|
||||
};
|
||||
|
||||
return bless $self;
|
||||
}
|
||||
|
||||
sub append ($@)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
push @{ $self->{tree} }, @_;
|
||||
}
|
||||
|
||||
sub compute ($$$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $operators = shift;
|
||||
my $ids = shift;
|
||||
my @current = ();
|
||||
|
||||
for my $node (@{ $self->{tree} }) {
|
||||
my $t = $node->compute($operators, $ids);
|
||||
push @current, $t if $t;
|
||||
}
|
||||
|
||||
#TODO: Be more secure!
|
||||
#$cpt = new Safe;
|
||||
#$cpt->permit_only(qw(:base_core :base_mem :base_loop));
|
||||
#$safe->share_from('List::Util', [ 'reduce' ]);
|
||||
|
||||
my $res = 0;
|
||||
{
|
||||
no warnings "uninitialized";
|
||||
$res = reduce { eval $operators->{ $self->{operator} } } @current if @current > 1;
|
||||
$res = $current[0] if @current == 1;
|
||||
}
|
||||
|
||||
$res = $res * $self->{factor};
|
||||
|
||||
$ids->{ $self->{id} } = $res;
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
sub add
|
||||
{
|
||||
$a + $b;
|
||||
}
|
||||
|
||||
package Point;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
sub new ($$$$$)
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
value => $_[0],
|
||||
ref => $_[1],
|
||||
qversion => $_[2],
|
||||
not => $_[3]
|
||||
};
|
||||
|
||||
return bless $self;
|
||||
}
|
||||
|
||||
sub getValue ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $ids = shift;
|
||||
|
||||
if ($self->{value} eq "") {
|
||||
return $ids->{ $self->{ref} } // 0;
|
||||
}
|
||||
else {
|
||||
return $self->{value};
|
||||
}
|
||||
}
|
||||
|
||||
sub compute ($$$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $operators = shift;
|
||||
my $ids = shift;
|
||||
my $ret = undef;
|
||||
|
||||
if ((not $self->{ref}) || $self->{ref} ~~ $ids) {
|
||||
$ret = $self->getValue( $ids );
|
||||
}
|
||||
|
||||
if ($self->{not}) {
|
||||
if ($ret) {
|
||||
$ret = undef;
|
||||
} else {
|
||||
$ret = $self->getValue( $ids );
|
||||
}
|
||||
}
|
||||
|
||||
say "$self->{ref}\t$ret" if (defined $main::debug and defined $ret);
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
211
ACU/Trace.pm
Normal file
211
ACU/Trace.pm
Normal file
|
|
@ -0,0 +1,211 @@
|
|||
#! /usr/bin/env perl
|
||||
|
||||
package Trace;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use utf8;
|
||||
use open qw(:encoding(UTF-8) :std);
|
||||
use XML::LibXML;
|
||||
use XML::SAX::ParserFactory;
|
||||
|
||||
sub new ($$)
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
ids => {},
|
||||
infos => {},
|
||||
comments => {},
|
||||
who => {},
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
$self->_initialize(@_);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub _initialize ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
my $sax_handler = TraceHandler->new($self);
|
||||
my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
|
||||
|
||||
$parser->parse_file(shift);
|
||||
}
|
||||
|
||||
sub getVersion ($)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{version};
|
||||
}
|
||||
|
||||
sub getType ($)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{type};
|
||||
}
|
||||
|
||||
sub getInfo ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{infos}{$_[0]};
|
||||
}
|
||||
|
||||
sub getInfos ($)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{infos};
|
||||
}
|
||||
|
||||
sub getComment ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{comments}{$_[0]};
|
||||
}
|
||||
|
||||
sub getComments ($)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{comments};
|
||||
}
|
||||
|
||||
sub getWho ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{who}{$_[0]};
|
||||
}
|
||||
|
||||
sub getFirstWho ($)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
return $self->{who}{def1_end_group};
|
||||
}
|
||||
|
||||
sub getWhos ($)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{who};
|
||||
}
|
||||
|
||||
sub getValue ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{ids}{$_[0]};
|
||||
}
|
||||
|
||||
sub getIds ($)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{ids};
|
||||
}
|
||||
|
||||
|
||||
package TraceHandler;
|
||||
|
||||
use constant NO_ID_VALUE => "__#";
|
||||
|
||||
sub new ($$)
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
parsed => shift,
|
||||
inComment => "",
|
||||
inEval => "",
|
||||
inInfo => "",
|
||||
inValue => "",
|
||||
inWho => "",
|
||||
values => ""
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub start_element
|
||||
{
|
||||
my ($self, $element) = @_;
|
||||
|
||||
if ($element->{Name} eq "trace") {
|
||||
$self->{parsed}{version} = $element->{Attributes}{"{}version"}{Value};
|
||||
$self->{parsed}{type} = $element->{Attributes}{"{}type"}{Value};
|
||||
}
|
||||
elsif ($element->{Name} eq "info") {
|
||||
$self->{inInfo} = $element->{Attributes}{"{}name"}{Value};
|
||||
$self->{parsed}{infos}{ $self->{inInfo} } = 0;
|
||||
$self->{values} = "";
|
||||
}
|
||||
elsif ($element->{Name} eq "eval") {
|
||||
my $tmp = $element->{Attributes}{"{}id"}{Value};
|
||||
if ($tmp) {
|
||||
$self->{inEval} = $tmp;
|
||||
$self->{parsed}{ids}{ $self->{inEval} } = 0;
|
||||
}
|
||||
}
|
||||
elsif ($element->{Name} eq "comment" && $self->{inEval}) {
|
||||
$self->{inComment} = $self->{inEval};
|
||||
$self->{values} = "";
|
||||
}
|
||||
elsif ($element->{Name} eq "who" && $self->{inEval}) {
|
||||
$self->{inWho} = $self->{inEval};
|
||||
$self->{values} = "";
|
||||
}
|
||||
elsif ($element->{Name} eq "value") {
|
||||
if ($element->{Attributes}{"{}id"}{Value}) {
|
||||
$self->{inValue} = $element->{Attributes}{"{}id"}{Value};
|
||||
} else {
|
||||
$self->{inValue} = NO_ID_VALUE;
|
||||
}
|
||||
|
||||
$self->{values} = "";
|
||||
}
|
||||
}
|
||||
|
||||
sub characters
|
||||
{
|
||||
my ($self, $characters) = @_;
|
||||
|
||||
if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) {
|
||||
$self->{values} .= $characters->{Data};
|
||||
}
|
||||
}
|
||||
|
||||
sub end_element
|
||||
{
|
||||
my ($self, $element) = @_;
|
||||
|
||||
if ($element->{Name} eq "value") {
|
||||
if ($self->{values} =~ /(-?[0-9]+(.[0-9]+)?)/) {
|
||||
$self->{parsed}{ids}{ $self->{inEval} } += $1;
|
||||
if ($self->{inValue} ne NO_ID_VALUE) {
|
||||
$self->{parsed}{ids}{ $self->{inValue} } = $1;
|
||||
}
|
||||
}
|
||||
$self->{inValue} = "";
|
||||
}
|
||||
elsif ($element->{Name} eq "comment") {
|
||||
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
|
||||
$self->{parsed}{comments}{ $self->{inComment} } = $1;
|
||||
}
|
||||
$self->{inComment} = "";
|
||||
}
|
||||
elsif ($element->{Name} eq "who") {
|
||||
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
|
||||
$self->{parsed}{who}{ $self->{inWho} } = $1;
|
||||
}
|
||||
$self->{inComment} = "";
|
||||
}
|
||||
elsif ($element->{Name} eq "info") {
|
||||
if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
|
||||
$self->{parsed}{infos}{ $self->{inInfo} } = $1;
|
||||
}
|
||||
$self->{inInfo} = "";
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
132
ACU/new_version.pl
Normal file
132
ACU/new_version.pl
Normal file
|
|
@ -0,0 +1,132 @@
|
|||
#! /usr/bin/env perl
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Getopt::Long;
|
||||
use Pod::Usage;
|
||||
use XML::LibXML;
|
||||
|
||||
# Parse arguments
|
||||
my $input; my $current; my $output; my $version; my $next;
|
||||
my $help; my $man;
|
||||
GetOptions ("output|O=s" => \$output,
|
||||
"current|c=s" => \$current,
|
||||
"version|V=i" => \$version,
|
||||
"next|n=i" => \$next,
|
||||
"help|h|?" => \$help,
|
||||
"man" => \$man,
|
||||
"" => \$input)
|
||||
or pod2usage(2);
|
||||
pod2usage(1) if $help;
|
||||
pod2usage(-exitval => 0, -verbose => 2) if $man;
|
||||
|
||||
# Get the current version
|
||||
if (defined $current && defined $version) {
|
||||
say "Error: Cannot have both -current and -version, choose the one!";
|
||||
pod2usage(1);
|
||||
}
|
||||
elsif (defined $current) {
|
||||
open my $xmlcur, "<", $current or die $!;
|
||||
binmode $xmlcur;
|
||||
my $dom = XML::LibXML->load_xml(IO => $xmlcur);
|
||||
close $xmlcur;
|
||||
|
||||
$version = $dom->documentElement()->getAttribute("version");
|
||||
}
|
||||
|
||||
if(defined $next) {
|
||||
$version = $next;
|
||||
}
|
||||
elsif (!$version) {
|
||||
say "Warning: Assume this is the first version.";
|
||||
$version = 1;
|
||||
}
|
||||
else {
|
||||
$version += 1;
|
||||
}
|
||||
|
||||
# Open versioned XML file
|
||||
my $xmlin;
|
||||
if (defined $input || $#ARGV == -1) {
|
||||
$xmlin = *STDIN;
|
||||
}
|
||||
else {
|
||||
open $xmlin, "<", $ARGV[0] or die $!;
|
||||
}
|
||||
|
||||
binmode $xmlin;
|
||||
my $dom = XML::LibXML->load_xml(IO => $xmlin);
|
||||
close $xmlin unless $xmlin eq *STDIN;
|
||||
|
||||
# Check the version
|
||||
my $my_version = $dom->documentElement()->getAttribute("version");
|
||||
if (!defined $my_version || $my_version < $version) {
|
||||
$dom->documentElement()->setAttribute("version", $version);
|
||||
}
|
||||
|
||||
# Save versioned XML file
|
||||
my $xmlout;
|
||||
if (defined $output) {
|
||||
open $xmlout, '>', $output;
|
||||
binmode $xmlout;
|
||||
}
|
||||
else {
|
||||
$xmlout = *STDOUT;
|
||||
}
|
||||
print {$xmlout} $dom->toString();
|
||||
close $xmlout unless $xmlout eq *STDOUT;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
new_version.pl - Check if the new file version is greater than current file version
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
new_version.pl [options] [file]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Parse the XML file given (or stdin if no file is given) and print a valid versionned XML with a valid version (strictly greater than current version)
|
||||
|
||||
Options:
|
||||
-output=file.xml save prepared XML to this location
|
||||
-current=file.xml location of the current XML file
|
||||
-version=X raw version to use at least
|
||||
-next=X next version to be used
|
||||
-help brief help message
|
||||
-man full documentation
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
=over 8
|
||||
|
||||
=item B<-output=file.xml>
|
||||
|
||||
Save the prepared XML to a file instead of printing it on standard output.
|
||||
|
||||
=item B<-current=file.xml>
|
||||
|
||||
Path to the current XML file, where extract the current version.
|
||||
|
||||
=item B<-version=X>
|
||||
|
||||
The last known version. Used when you haven't the file.
|
||||
|
||||
=item B<-next=X>
|
||||
|
||||
The version to write into the file.
|
||||
|
||||
=item B<-help>
|
||||
|
||||
Print a brief help message and exits.
|
||||
|
||||
=item B<-man>
|
||||
|
||||
Prints the manual page and exits.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
Reference in a new issue