Add way to generate grades to intradata-get

ACU/Grading.pm

@@ -30,7 +30,7 @@ sub _initialize
 {
     my $self = shift;
 
-    my $dom = XML::LibXML->load_xml(IO => shift);
+    my $dom = XML::LibXML->load_xml(string => shift);
     $self->{tree} = $self->parseGrade($dom->documentElement());
     $self->{max} = $dom->documentElement()->getAttribute("max") // "20";
 }

process/files/intradata_get.pl

@@ -9,6 +9,7 @@ use lib "../../";
 
 use ACU::Log;
 use ACU::LDAP;
+use ACU::Grading;
 use ACU::Process;
 use ACU::Trace;
 
@@ -20,6 +21,7 @@ my %actions = (
     },
     "grades" => {
 	"new_bonus" => \&grades_new_bonus,
+	"generate" => \&grades_generate,
     },
     "project" => {
 	"create" => \&update_project,
@@ -46,6 +48,93 @@ sub create_tree($$)
 }
 
 
+sub grades_generate
+{
+    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";
+    }
+
+    if (! -e "$basedir/$year/$project_id/grades/") {
+	mkdir "$basedir/$year/$project_id/grades/";
+    }
+
+    log DEBUG, "Generate list of students";
+
+    # Create list of students to generate
+    my @logins;
+    if ($args->{unamed})
+    {
+	for (my $i = $args->{unamed}; $i > 0; $i--) {
+	    push @logins, $args->{param}{$i};
+	}
+    }
+    else
+    {
+	opendir(my $dh, "$basedir/$year/$project_id/traces/") or croak "can't opendir $some_dir: $!";
+	for my $dir (grep { ( ! /^\./ ) && -d "$basedir/$year/$project_id/traces/$_" } readdir($dh))
+	{
+	    opendir(my $dhm, "$basedir/$year/$project_id/traces/$dir") or croak "can't opendir $some_dir: $!";
+
+	    for my $login (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/traces/$dir/$_" } readdir($dhm))
+	    {
+		if (! grep { /^\Q$login\E$/ } @logins) {
+		    push @logins, $login;
+		}
+	    }
+
+	    closedir $dhm;
+	}
+	closedir $dh;
+    }
+
+    log TRACE, @logins;
+
+    # Load grading file
+    my $grading;
+    if (exists $args->{files}{"grading.xml"}) {
+	$grading = $args->{files}{"grading.xml"};
+    }
+    if (! $grading) {
+	log ERROR, "Invalid grading.xml received!";
+	return "Invalid grading.xml received!";
+    }
+
+    my $grading = Grading->new($grading);
+
+    opendir(my $dh, "$basedir/$year/$project_id/traces/") or croak "can't opendir $some_dir: $!";
+    @trace_dirs = grep { ( ! /^\./ ) && -d "$basedir/$year/$project_id/traces/$_" } readdir($dh);
+    closedir $dh;
+
+    for my $login (@login)
+    {
+	for my $dir (@trace_dirs)
+	{
+	    if (-f "$basedir/$year/$project_id/traces/$dir/$login.xml")
+	    {
+		open my $xmltrace, "<", "$basedir/$year/$project_id/traces/$dir/$login.xml" or croak "traces/$dir/$login.xml: $!";
+		binmode $xmltrace;
+		my $trace = Trace->new($xmltrace);
+		close $xmltrace;
+
+		$grading->fill($trace->getIds);
+	    }
+	}
+
+	open my $xmlgrade, ">", "$basedir/$year/$project_id/grades/$login.xml" or croak "grades/$login.xml";
+	binmode $xmlgrade;
+	print $xmlgrade $grade->computeXML($login);
+	close $xmlgrade;
+    }
+
+    return "Ok";
+}
+
 sub grades_new_bonus
 {
     my $args = shift;