102 lines
2.5 KiB
Perl
102 lines
2.5 KiB
Perl
#! /usr/bin/env perl
|
|
|
|
use v5.10.1;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
use Pod::Usage;
|
|
use Text::ParseWords;
|
|
|
|
use ACU::Defense;
|
|
use ACU::Grading;
|
|
use ACU::Log;
|
|
use ACU::LDAP;
|
|
use ACU::Process;
|
|
use ACU::Trace;
|
|
|
|
$ACU::Log::mail_error = 1;
|
|
|
|
our $basedir = "/intradata";
|
|
|
|
sub process
|
|
{
|
|
my $given_args = shift;
|
|
my @args = shellwords(${ shift() });
|
|
|
|
my $project_id = shift @args;
|
|
my $year = shift @args // LDAP::get_year;
|
|
|
|
# Project existing?
|
|
croak "Unable to find $project_id in $year" if (! -d "$basedir/$year/$project_id");
|
|
|
|
my $grade = Grading->new();
|
|
|
|
my @defenses;
|
|
if (-d "$basedir/$year/$project_id/defenses/")
|
|
{
|
|
# 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 $sid;
|
|
($sid = $sout) =~ s/\.xml$//;
|
|
push @defenses, $sid;
|
|
|
|
open my $xml, "<", "$basedir/$year/$project_id/defenses/$sout" or die $!;
|
|
binmode $xml;
|
|
|
|
my $str;
|
|
$str .= $_ while (<$xml>);
|
|
|
|
my $defense = Defense->new($str);
|
|
|
|
my $ids = $defense->getIds();
|
|
|
|
my @keys = keys %$ids;
|
|
my $def_i = $keys[0];
|
|
$def_i =~ s/^(.+)g.*$/$1/;
|
|
|
|
$ids->{$def_i.'_end_$LOGIN'} = undef;
|
|
$ids->{$def_i.'_end_group'} = undef;
|
|
|
|
$grade->create_from_ids($sid, $ids);
|
|
}
|
|
closedir $dh;
|
|
}
|
|
|
|
if (-d "$basedir/$year/$project_id/traces/")
|
|
{
|
|
# Create traces groups
|
|
opendir(my $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))
|
|
{
|
|
next if (grep { $dir eq "defense_$_" } @defenses);
|
|
|
|
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))
|
|
{
|
|
open my $xml, "<", "$basedir/$year/$project_id/traces/$dir/$login" or die $!;
|
|
binmode $xml;
|
|
|
|
my $trace = Trace->new(join '', <$xml>);
|
|
|
|
my %tids = %{ $trace->getIds() };
|
|
for my $kid (keys %tids)
|
|
{
|
|
$ids->{ $kid } = $tids{ $kid };
|
|
}
|
|
}
|
|
|
|
$grade->create_from_ids($dir, $ids);
|
|
}
|
|
closedir $dh;
|
|
}
|
|
|
|
return $grade->toString;
|
|
}
|
|
|
|
Process::set_servers("gearmand:4730");
|
|
Process::register_no_parse("gen_grading", \&process);
|