Add new process for generating grading XML

ACU/Grading.pm

@@ -35,17 +35,17 @@ sub _initialize
     $self->{max} = $dom->documentElement()->getAttribute("max") // "20";
 }
 
-sub create_from_trace ($$)
+sub create_from_ids
 {
     my $self = shift;
-    my $trace_id = shift;
     my $trace_name = shift;
-    my $trace = shift;
+    my $ids = shift;
+
+    my $trace_id = $trace_name;
+    $trace_id =~ s/[^a-zA-Z0-9_]/_/g;
 
     my $g = Grade->new($trace_id, $trace_name);
 
-    my $ids = $trace->getIds();
-
     for my $id (sort( keys %{ $ids } ))
     {
 	my $p = Point->new($ids->{$id}, $id, 0, 0);

grades/gen_grading.pl

@@ -54,7 +54,7 @@ do {
 
     close $xml unless $xml eq *STDIN;
 
-    $grade->create_from_trace($id_name, $name, $trace);
+    $grade->create_from_ids($id_name, $name, $trace);
 
 } while ($#ARGV >= 0);
 

process/launch.sh

@@ -78,6 +78,7 @@ then
 	
 	noyce)
 	    launch_screen "lerdorf_process_files_intradata_get" "while true; do $PERL ~/liblerdorf/process/files/intradata_get.pl; done"
+	    launch_screen "lerdorf_process_projects_gen_grading" "while true; do $PERL ~/liblerdorf/process/projects/gen_grading.pl; done"
 	    ;;
 	
 	ksh)

process/projects/gen_grading.pl

@@ -0,0 +1,72 @@
+#! /usr/bin/env perl
+
+use v5.10.1;
+use strict;
+use warnings;
+use Carp;
+use Pod::Usage;
+
+use lib "../../";
+
+use ACU::Defense;
+use ACU::Grading;
+use ACU::Log;
+use ACU::LDAP;
+use ACU::Process;
+use ACU::Trace;
+
+our $basedir = "/intradata";
+
+sub process
+{
+    my $given_args = shift;
+    my @args = shift;
+
+    my $project_id = shift @args;
+    my $year = shift @args // LDAP::get_year();
+
+    # Project existing?
+    if (! -d "$basedir/$year/$project_id")
+    {
+	log ERROR, "Unable to find $project_id in $year";
+	return "Unable to find $project_id in $year";
+    }
+
+    my $grade = Grading->new();
+
+    # Create defenses groups
+    opendir(my $dh, "$basedir/$year/$project_id/defenses/") or croak "can't opendir $basedir/$year/$project_id/defenses/: $!";
+    for my $sout (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/defenses/$_" } readdir($dh))
+    {
+	my $defense = Defense->new("$basedir/$year/$project_id/defenses/$_");
+
+	$grade->create_from_ids($sout, $defense->getIds());
+    }
+    closedir $dh;
+
+    # Create traces groups
+    opendir($dh, "$basedir/$year/$project_id/traces/") or croak "can't opendir $basedir/$year/$project_id/traces/: $!";
+    for my $dir (grep { ( ! /^\./ ) && -d "$basedir/$year/$project_id/traces/$_" } readdir($dh))
+    {
+	my $ids = {};
+
+	opendir(my $dhm, "$basedir/$year/$project_id/traces/$dir") or croak "can't opendir $basedir/$year/$project_id/traces/$dir: $!";
+	for my $login (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/traces/$dir/$_" } readdir($dhm))
+	{
+	    my $trace = Trace->new("$basedir/$year/$project_id/traces/$dir/$_");
+
+	    my %tids = %{ $trace->getIds() };
+	    for my $kid (keys %tids)
+	    {
+		$ids->{ $kid } = $tids{ $kid };
+	    }
+	}
+
+	$grade->create_from_ids($_, $ids);
+    }
+    closedir $dh;
+
+    return $grade->toString;
+}
+
+Process::register_no_parse("gen_grading", \&process);