Archived
1
0
Fork 0

intradata can get bonus/malus point

This commit is contained in:
Mercier Pierre-Olivier 2013-09-20 17:43:12 +02:00
parent 88eaf60cc5
commit de06d5fd0d
2 changed files with 128 additions and 18 deletions

View file

@ -14,13 +14,16 @@ use ACU::Process;
our $basedir = "/intradata";
my %actions = (
"defense" => {
"update" => \&update_defense,
},
"grades" => {
"new_bonus" => \&grades_new_bonus,
},
"project" => {
"create" => \&update_project,
"update" => \&update_project,
"delete" => \&delete_project,
},
"defense" => {
"update" => \&update_defense,
}
);
@ -42,7 +45,7 @@ sub create_tree($$)
}
sub update_project
sub grades_new_bonus
{
my $args = shift;
@ -54,22 +57,57 @@ sub update_project
return "No project_id given";
}
my $butler;
if (exists $args->{files}{"butler.xml"}) {
$butler = $args->{files}{"butler.xml"};
if (! -e "$basedir/$year/$project_id/traces/") {
mkdir "$basedir/$year/$project_id/traces/";
}
if (! $butler) {
log ERROR, "Invalid butler.xml received!";
return "Invalid butler.xml received!";
if (! -e "$basedir/$year/$project_id/traces/bonus/") {
mkdir "$basedir/$year/$project_id/traces/bonus/";
}
log INFO, "Update $year/$project_id/butler.xml";
for my $kfile (keys %{ $args->{files} })
{
my $kbonus = $kfile;
$kbonus =~ s/[^a-zA-Z0-9_-]/_/g;
return $_ if (create_tree($year, $project_id));
my @lines = ($args->{files}{$kfile} =~ tr/\n//);
open my $out, ">", "$basedir/$year/$project_id/butler.xml";
print $out $butler;
close $out;
my $value = 1;
# Looking for a global value
if ($lines[0] =~ /^\d+$/) {
$value = $1;
log INFO, "Setting global value to $value";
shift @lines;
}
for my $line (@lines)
{
if ($line =~ /^([a-z0-9_-]+)(?:\s*:\s*(\d+))?$/)
{
my $login = $1;
my $tvalue = $2 // $value;
my $trace;
if (-e "$basedir/$year/$project_id/traces/bonus/$login.xml") {
open my $xml, "<", "$basedir/$year/$project_id/traces/bonus/$login.xml" or croak $!;
binmode $xml;
$trace = Trace->new($xml);
close $xml;
}
else {
$trace = Trace->new();
}
$trace->addId($kbonus, $tvalue);
open my $xml, ">", "$basedir/$year/$project_id/traces/bonus/$login.xml" or croak $!;
print $xml $trace->toString();
close $xml
}
else {
log WARN, "Invalid login $line, line skiped";
}
}
}
return "Ok";
}
@ -124,6 +162,38 @@ sub update_defense
return "Ok";
}
sub update_project
{
my $args = shift;
my $project_id = $args->{param}{id};
my $year = $args->{param}{year} // LDAP::get_year;
if (! $project_id) {
log ERROR, "No project_id given.";
return "No project_id given";
}
my $butler;
if (exists $args->{files}{"butler.xml"}) {
$butler = $args->{files}{"butler.xml"};
}
if (! $butler) {
log ERROR, "Invalid butler.xml received!";
return "Invalid butler.xml received!";
}
log INFO, "Update $year/$project_id/butler.xml";
return $_ if (create_tree($year, $project_id));
open my $out, ">", "$basedir/$year/$project_id/butler.xml";
print $out $butler;
close $out;
return "Ok";
}
sub delete_project
{
log WARN, "delete_project: not implemented."