110 lines
2.2 KiB
Perl
110 lines
2.2 KiB
Perl
#! /usr/bin/env perl
|
|
|
|
use v5.10.1;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
use Pod::Usage;
|
|
use Text::ParseWords;
|
|
use XML::LibXML;
|
|
|
|
use ACU::Log;
|
|
use ACU::LDAP;
|
|
use ACU::Process;
|
|
|
|
$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 %grades;
|
|
my @headers;
|
|
my @averages;
|
|
|
|
opendir(my $dh, "$basedir/$year/$project_id/grades/") or croak "can't opendir $basedir/$year/$project_id/grades/: $!";
|
|
for my $gfile (grep { ( ! /^\./ ) && -f "$basedir/$year/$project_id/grades/$_" } readdir($dh))
|
|
{
|
|
my $login;
|
|
($login = $gfile) =~ s/\.xml$//;
|
|
|
|
open my $xml, "<", "$basedir/$year/$project_id/grades/$gfile" or die $!;
|
|
binmode $xml;
|
|
my $dom = XML::LibXML->load_xml(IO => $xml);
|
|
close $xml;
|
|
|
|
my @ugrades = @headers;
|
|
for my $grade ($dom->documentElement()->getElementsByTagName("grade"))
|
|
{
|
|
my $i;
|
|
for ($i = 0; $i <= $#ugrades; $i++)
|
|
{
|
|
if ($ugrades[$i] eq $grade->getAttribute("name"))
|
|
{
|
|
$ugrades[$i] = $grade->getAttribute("value");
|
|
$averages[$i] += $grade->getAttribute("value");
|
|
last;
|
|
}
|
|
}
|
|
|
|
if ($i > $#ugrades)
|
|
{
|
|
push @headers, $grade->getAttribute("name");
|
|
push @ugrades, $grade->getAttribute("value");
|
|
push @averages, $grade->getAttribute("value");
|
|
}
|
|
}
|
|
|
|
$grades{$login} = \@ugrades;
|
|
}
|
|
closedir $dh;
|
|
|
|
# Print CSV
|
|
my $out = "login";
|
|
|
|
foreach my $header (@headers) {
|
|
$out .= ",$header";
|
|
}
|
|
$out .= "\n";
|
|
|
|
my $nb = 0;
|
|
foreach my $login (keys %grades)
|
|
{
|
|
$nb += 1;
|
|
$out .= "$login";
|
|
my @ugrades = @{ $grades{$login} };
|
|
for my $header (@headers)
|
|
{
|
|
my $g = shift @ugrades;
|
|
$out .= ",";
|
|
if ($g && $g ne $header) {
|
|
$out .= $g;
|
|
} else {
|
|
$out .= "0";
|
|
}
|
|
}
|
|
$out .= "\n";
|
|
}
|
|
|
|
$out .= "Average";
|
|
foreach my $average (@averages)
|
|
{
|
|
$out .= ",".($average / $nb);
|
|
}
|
|
$out .= "\n";
|
|
|
|
return $out;
|
|
}
|
|
|
|
Process::set_servers("gearmand:4730");
|
|
Process::register_no_parse("get_csv", \&process);
|