epita-std/ACU
Archived
1
0
Fork 0
Code Releases Activity

Merge branch 'master' of ssh://cpp/liblerdorf

Browse Source
This commit is contained in:
Root Cpp Charlie 2013-11-24 01:05:32 +01:00
commit b69c30d3d0
18 changed files with 248 additions and 199 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
ACU/API/Base.pm
View File

@ -105,8 +105,10 @@ sub send($$$)
log(DEBUG, 'POST Request to ', API_URL, $url);
my $req = POST API_URL . $url, shift;
my $cnt = $ua->request($req)->content;
my $res = $ua->request($req);
log TRACE, $res;
my $cnt = $res->content();
log TRACE, $cnt;
return parse($next, $cnt);
@ -247,8 +249,7 @@ sub new ($$)
my $class = shift;
my $self = {
parsed => shift,
inStd => 0,
inResult => 0,
savValue => 0,
lastGroup => {},
values => ""
};
@ -262,14 +263,10 @@ sub start_element
{
my ($self, $element) = @_;
if ($element->{Name} eq "result") {
$self->{parsed}{result} = $self->{values};
$self->{inResult} = 0;
$self->{values} = "";
}
elsif ($element->{Name} eq "student")
if ($element->{Name} eq "student")
{
$self->{inStd} = 1;
$self->{values} = "";
$self->{savValue} = 1;
push @{ $self->{lastGroup}{stds} }, {
id => $element->{Attributes}{"{}id"}{Value},
chief => $element->{Attributes}{"{}chief"}{Value},
@ -281,13 +278,18 @@ sub start_element
$self->{lastGroup}{id} = $element->{Attributes}{"{}id"}{Value};
$self->{lastGroup}{stds} = [];
}
elsif ($element->{Name} eq "result")
{
$self->{values} = "";
$self->{savValue} = 1;
}
}
sub characters
{
my ($self, $characters) = @_;
if ($self->{inStd}) {
if ($self->{savValue}) {
$self->{values} .= $characters->{Data};
}
}
@ -296,13 +298,16 @@ sub end_element
{
my ($self, $element) = @_;
if ($element->{Name} eq "group")
if ($element->{Name} eq "result")
{
$self->{parsed}{result} = $self->{values};
$self->{savValue} = 0;
}
elsif ($element->{Name} eq "group")
{
push @{ $self->{parsed}{groups} }, $self->{lastGroup};
$self->{lastGroup} = {};
$self->{inStd} = 0;
$self->{values} = "";
$self->{savValue} = 0;
}
elsif ($element->{Name} eq "student")
{

17
ACU/API/Projects.pm
View File

@ -90,10 +90,9 @@ sub get_groups($;$)
my $res = API::Base::get('ProjectGroupHandler', $url);
#TODO: uncomment-me
#if ($res->{result} ne '0') {
# croak "Erreur durant la récupération : " . $res->{message};
#}
if ($res->{result} ne '0') {
croak "Erreur durant la récupération : " . $res->{message};
}
return $res;
}
@ -103,7 +102,10 @@ sub add_grades($;$)
my %data = (
project_name => shift
);
$data{year} = $_ if (shift);
my $y = shift;
if ($y) {
$data{year} = $y;
}
my $res = API::Base::send('ResultHandler', "projects/notes/add.xml", \%data);
@ -120,7 +122,10 @@ sub add_traces($$;$)
project_name => shift,
trace_name => shift,
);
$data{year} = $_ if (shift);
my $y = shift;
if ($y) {
$data{year} = $y;
}
my $res = API::Base::send('ResultHandler', "projects/traces/add.xml", \%data);

2
ACU/Defense.pm
View File

@ -144,6 +144,7 @@ sub genIds ($;$)
}
else {
$grp_i += 1;
$cur_gid = $group->{id};
}
my $qst_i = 0;
@ -160,6 +161,7 @@ sub genIds ($;$)
}
else {
$qst_i += 1;
$cur_qid = $question->{id};
}
my $ans_i = 0;

10
ACU/Grading.pm
View File

@ -7,8 +7,6 @@ use strict;
use warnings;
use XML::LibXML;
use ACU::Tinyglob;
sub new
{
my $class = shift;
@ -288,6 +286,7 @@ package Point;
use v5.10.1;
use strict;
use warnings;
use Text::Glob qw( glob_to_regex match_glob );
use Term::ANSIColor qw(:constants);
use ACU::Log;
@ -349,14 +348,13 @@ sub compute ($$$;$$$)
{
eval
{
my $glob = Tinyglob::tinyglob($ref);
if ($glob ne $ref)
if ($ref =~ /\?|\*/)
{
my $value = 0;
for my $r (grep { /^$glob$/ } keys %$ids) {
for my $r (grep { match_glob($ref, $_); } keys %$ids) {
$value += $ids->{ $r };
}
$ids->{ $ref } = $value;
$ids->{ $ref } = $value if ($value);
}
};
if ($@) {

67
ACU/Tinyglob.pm
View File

@ -1,67 +0,0 @@
#! /usr/bin/env perl
package Tinyglob;
use v5.10.1;
use strict;
use warnings;
use Carp;
use Exporter 'import';
our @EXPORT = qw(tinyglob);
sub tinyglob
{
my $orig = shift;
my @str = split("", quotemeta($orig));
my $res = "";
my $metaescape = 0;
for (my $i = 0; $i <= $#str; $i++)
{
if ($str[$i] eq '\\')
{
$i += 1;
if ($str[$i] eq '\\')
{
$metaescape = ! $metaescape;
$res .= $str[$i];
}
elsif ($metaescape && ($str[$i] eq '*' || $str[$i] eq '?')) {
$res .= $str[$i];
$metaescape = 0;
}
elsif ($str[$i] eq '?') {
$res .= '.';
}
elsif ($str[$i] eq '*') {
$res .= '.*';
}
elsif ($metaescape) {
$res .= $str[$i];
$metaescape = 0;
}
else {
$res .= "\\".$str[$i];
}
}
else {
$res .= $str[$i];
}
}
return $res;
}
sub match
{
my $glob = tinyglob(shift);
my $str = shift;
say $glob;
return $str =~ /$glob/;
}
1;

19
ACU/Trace.pm
View File

@ -146,6 +146,23 @@ sub getIds
return \%ids;
}
sub getNonZeroIds
{
my $self = shift;
my $login = shift;
my %ids;
foreach my $group (@{ $self->{groups} })
{
my %tmp = $group->getIds($login);
while (my ($key, $value) = each %tmp)
{
$ids{$key} = $value if $value;
}
}
return \%ids;
}
sub getValue
{
my $self = shift;
@ -428,7 +445,7 @@ sub getValue
my $value = 0;
if (!$login || !exists $self->{who} || $self->{who}{type} eq "group" || $self->{who}{login} eq $login)
{
foreach my $key (%{ $self->{values} })
foreach my $key (keys %{ $self->{values} })
{
$value += $self->{values}{$key} if ($id eq $self->{id} || !$key || $key eq $id);
}

55
ACU/t/tinyglob.t
View File

@ -1,55 +0,0 @@
use v5.10.1;
use strict;
use warnings;
use Test::More;
use lib "../";
BEGIN {
diag("Testing Tinyglob on perl $]");
use_ok('ACU::Tinyglob');
}
use ACU::Tinyglob;
is(Tinyglob::tinyglob("test"), "test");
is(Tinyglob::tinyglob("\\*"), "\\*");
is(Tinyglob::tinyglob("\\\\*"), "\\\\.*");
is(Tinyglob::tinyglob("\\?"), "\\?");
is(Tinyglob::tinyglob("\\\\?"), "\\\\.");
is(Tinyglob::tinyglob("\\."), "\\.");
is(Tinyglob::tinyglob("\\\\."), "\\\\\\.");
is(Tinyglob::tinyglob("a*b?"), "a.*b.");
ok(! Tinyglob::match("?", ""));
ok(! Tinyglob::match("b", "a"));
ok(! Tinyglob::match("b*", "a"));
ok(! Tinyglob::match("b?", "a"));
ok(Tinyglob::match("*", ""));
ok(Tinyglob::match("a", "a"));
ok(Tinyglob::match("?", "a"));
ok(Tinyglob::match("*", "a"));
ok(Tinyglob::match("ab", "ab"));
ok(Tinyglob::match("?b", "ab"));
ok(Tinyglob::match("*b", "ab"));
ok(Tinyglob::match("*", "ab"));
ok(Tinyglob::match("b?", "ba"));
ok(Tinyglob::match("b*", "ba"));
ok(Tinyglob::match("*", "abcdef"));
ok(Tinyglob::match("a?b", "acb"));
ok(Tinyglob::match("a*b", "acb"));
ok(Tinyglob::match("a*b", "acdefb"));
ok(Tinyglob::match("a*b*", "acdefblkjgd"));
ok(! Tinyglob::match("a?b*", "acdefblkjgd"));
ok(Tinyglob::match("a?b*", "acblkjgd"));
ok(Tinyglob::match("a?b*", "abblkjgd"));
ok(! Tinyglob::match("a*b?", "abblkjgd"));
ok(Tinyglob::match("a*b?", "aasdasbd"));
done_testing();

8
commands/first-install.sh
View File

@ -1,10 +1,10 @@
#! /bin/bash
# Install missing packages
DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl libdigest-sha-perl libemail-mime-perl libemail-sender-perl"
ARCH_PACKAGES_LIST="screen perl-io-socket-ssl perl-email-simple perl-email-mime perl-term-readkey perl-ldap perl-lwp-protocol-https perl-datetime-format-iso8601 perl-net-ip" # aur/perl-sys-gamin
GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/IO-Socket-SSL dev-perl/Email-Simple dev-perl/Email-MIME dev-perl/TermReadKey dev-perl/perl-ldap dev-perl/LWP-Protocol-https dev-perl/DateTime-Format-ISO8601 dev-perl/Net-IP"
FBSD_PACKAGES_LIST="screen p5-IO-Socket-SSL p5-Email-Simple p5-Email-MIME p5-Term-ANSIColor p5-Term-ReadKey p5-LWP-Protocol-https p5-DateTime-Format-ISO8601 p5-Net-IP p5-Sys-Gamin"
DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl libdigest-sha-perl libemail-mime-perl libemail-sender-perl libtext-glob-perl"
ARCH_PACKAGES_LIST="screen perl-io-socket-ssl perl-email-mime perl-term-readkey perl-ldap perl-lwp-protocol-https perl-datetime-format-iso8601 perl-net-ip" # aur/perl-sys-gamin aur/perl-text-glob
GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/IO-Socket-SSL dev-perl/Email-MIME dev-perl/TermReadKey dev-perl/perl-ldap dev-perl/LWP-Protocol-https dev-perl/DateTime-Format-ISO8601 dev-perl/Net-IP dev-perl/Email-Sender dev-perl/Text-Glob"
FBSD_PACKAGES_LIST="screen p5-IO-Socket-SSL p5-Email-MIME p5-Term-ANSIColor p5-Term-ReadKey p5-LWP-Protocol-https p5-DateTime-Format-ISO8601 p5-Net-IP p5-Sys-Gamin p5-Text-Glob"
KERNEL=`uname -s`

43
commands/moulette/launch.sh Executable file
View File

@ -0,0 +1,43 @@
#!/bin/sh
if [ -z "$2" ]
then
echo "Usage: $0 [year] <project> <submission> [login ...]"
exit 1
fi
if ! which gearman > /dev/null 2> /dev/null
then
echo "gearman isn't installed on this machine. Please try another one."
exit 1
fi
if [ "x${1:0:2}" = "x20" ]
then
YEAR="$1"
shift
else
YEAR=`ldapsearch -x -b "cn=year,dc=acu,dc=epita,dc=fr" | grep "^year" | cut -d " " -f 2`
fi
PROJECT_ID=$1
RENDU=$2
shift 2
LOGINS=
while [ $# -gt 0 ]
do
LOGINS=" <param>$1</param>
"
shift
done
cat <<EOF | gearman -h gearmand -p 4730 -f moulette_get
<?xml version="1.0" encoding="UTF-8"?>
<process>
<param name="type">moulette</param>
<param name="year">$YEAR</param>
<param name="id">$PROJECT_ID</param>
<param name="rendu">$RENDU</param>
$LOGINS</process>
EOF

59
commands/moulette/sendgit.sh Executable file
View File

@ -0,0 +1,59 @@
#!/bin/sh
usage()
{
echo "Usage: $0 [-d] [year] <project> <submission> <login> [login ...]"
}
if [ -z "$3" ]
then
usage
exit 1
fi
if ! which gearman > /dev/null 2> /dev/null
then
echo "gearman isn't installed on this machine. Please try another one."
exit 1
fi
if [ "x$1" = "x-d" ]
then
BACKGROUD=
shift
else
BACKGROUD="-b"
fi
if [ "x${1:0:2}" = "x20" ]
then
YEAR=" <param name=\"year\">$1</param>"
shift
else
YEAR=
fi
PROJECT_ID=$1
RENDU=$2
shift 2
if [ $# -le 0 ]
then
usage
exit 1
fi
while [ $# -gt 0 ]
do
LOGIN=$1
cat <<EOF | gearman -h gearmand -p 4730 -f send_git $BACKGROUD
<?xml version="1.0"?>
<process>
$YEAR
<param name="id">$PROJECT_ID</param>
<param name="rendu">$RENDU</param>
<param name="login">$LOGIN</param>
</process>
EOF
shift
done

3
commands/project/gen_git_str.pl
View File

@ -11,7 +11,6 @@ my $projid = $ARGV[0];
my $year = $ARGV[1] // LDAP::get_year;
my $res = API::Projects::get_groups($projid, $year);
my $tag = "rendu-1";
map {
my $chief;
@ -31,5 +30,5 @@ map {
for my $member (@{ $_->{stds} }) {
print ' '.$member->{login};
}
say "\n R = \@chefs \@resp-$year-$projid";
say "\n R = \@chefs \@resp-$year-$projid \@soutenance-$year-$projid";
} @{ $res->{groups} };

4
hooks/gl-pre-git
View File

@ -19,7 +19,7 @@ my $promo = qx(git config hooks.promo);
my $id_project = qx(git config hooks.idproject);
my $repo_login = qx(git config hooks.repologin);
my @habitent_loin = qw(amed_m bellev_m freima_m ikouna_l simon_j faure_n abdelm_a habri_z trang_d henrie_p verbec_y);
my @habitent_loin = qw(amed_m bellev_m freima_m ikouna_l simon_j faure_n abdelm_a habri_z trang_d henrie_p verbec_y molini_v);
# First, check if the repository is in the YYYY/ directory
exit 0 if (($promo && $id_project && $repo_login) || $ENV{GL_REPO} !~ /^2[0-9]{3}\/.+\/.+/);
@ -48,7 +48,7 @@ if ($ip->overlaps($labnetwork) == $IP_A_IN_B_OVERLAP)
# exit 1;
#}
exit 0 if (grep { /\Q$repo_login\E/ } @habitent_loin);
exit 0 if (grep { /\Q$ENV{GL_USER}\E/ } @habitent_loin);
my $schoolnetwork = Net::IP->new('10.41.0.0/16');
#my $vjschoolnetwork = Net::IP->new('10.3.0.0/16');

2
hooks/subjects.pl
View File

@ -69,7 +69,7 @@ sub check_xml
sub repository_name
{
my $repo = $ENV{GL_REPO};
$repo =~ s#^subjects/(.*)#$1#;
$repo =~ s#/([^/]*)#$1#;
return $repo;
}

18
hooks/submissions.pl
View File

@ -23,6 +23,8 @@ my $id_project;
my $repo_login;
my @apping = qw(zinger_a zebard_w zanell_a yao_p vinois_a sraka_y soupam_j seck_a ngomsi_s morin_h milis_e menkar_m eusebe_r crief_a chhum_s boumra_n blemus_a bengan_l amasho_a);
my @salonD = qw(aniss_i bogalh_j boulea_b cloare_l elhach_h gabrie_j kaplan_p manuel_c palson_c pizzin_a wajntr_a);
my @salonS = qw(allio_a cadet_l digius_p drouin_n dubois_d dupuis_a langre_m lim_j);
# First, extract information, from config then guess from repository adress
if (my $tmp = `git config hooks.promo`) { chomp $tmp; $promo = $tmp; }
@ -78,9 +80,19 @@ if ($ref =~ m<^refs/tags/(.+)$>)
$open = DateTime::Format::ISO8601->parse_datetime("2013-11-08T20:00:00");
$close = DateTime::Format::ISO8601->parse_datetime("2013-11-10T11:42:00");
}
# TODO: check exceptions by login/group
$open = DateTime::Format::ISO8601->parse_datetime("2013-10-16T16:00:00") if ($repo_login eq "ikouna_l");
elsif ($id_project eq "logomatig" && grep { $_ eq $repo_login } @salonS)
{
$open = DateTime::Format::ISO8601->parse_datetime("2013-11-24T09:00:00");
$close = DateTime::Format::ISO8601->parse_datetime("2013-11-24T21:00:00");
}
elsif ($id_project eq "logomatig" && grep { $_ eq $repo_login } @salonD)
{
$open = DateTime::Format::ISO8601->parse_datetime("2013-11-23T21:00:00");
}
elsif ($id_project eq "logomatig" && "dufour_h" eq $repo_login)
{
$close = DateTime::Format::ISO8601->parse_datetime("2013-11-24T16:42:00");
}
say "Date courante : ", $glts->strftime("%d/%m/%Y %H:%M:%S");

1
migration/repo.sh
View File

@ -321,7 +321,6 @@ do
then
echo -e "\e[1;32m##\e[1;37m Find directory $DIR with some .tex files \e[1;32m##\e[0m"
cd "$DIR"
git rm *.tex
clean_tex `pwd` `readlink -f "$(pwd)/.."`
echo -e "\e[1;32m## ## ## ## ##\e[0m"
echo

64
process/files/intradata_get.pl
View File

@ -100,52 +100,54 @@ sub grades_generate
for my $login (@logins)
{
my @files;
log DEBUG, "Generating grades for $login";
for my $dir (@trace_dirs)
{
log DEBUG, "Fetching identifiers from $dir";
my $tr_file = "$year/$project_id/traces/$dir/$login.xml";
# Looking for a group traces?
if (! -f "$basedir/$tr_file")
# Looking for a group traces first
for my $grp (@{ $groups->{groups} })
{
for my $grp (@{ $groups->{groups} })
my $this = 0;
my $chief;
for my $member (@{ $grp->{stds} })
{
my $this = 0;
my $chief;
for my $member (@{ $grp->{stds} })
if ($member->{chief} eq "true" or $member->{chief} eq "1" or $member->{chief} eq "chief")
{
if ($member->{chief} eq "true" or $member->{chief} eq "1" or $member->{chief} eq "chief")
{
$chief = $member;
next;
}
$this = 1 if ($member->{login} eq $login);
$chief = $member;
next;
}
if ($this && $chief)
{
$tr_file = "$year/$project_id/traces/$dir/".$chief->{login}.".xml";
log DEBUG, "Using group trace: chief is ".$chief->{login};
last;
$this = 1 if ($member->{login} eq $login);
}
if ($this && $chief)
{
if (-f "$basedir/$year/$project_id/traces/$dir/".$chief->{login}.".xml") {
push @files, "$basedir/$year/$project_id/traces/$dir/".$chief->{login}.".xml";
}
last;
}
}
if (-f "$basedir/$tr_file")
{
open my $xmltrace, "<", "$basedir/$tr_file" or die "$tr_file: $!";
binmode $xmltrace;
my $trace = Trace->new(join '', <$xmltrace>);
close $xmltrace;
log DEBUG, "Fill from file: $tr_file";
log TRACE, $trace->getIds($login);
$grading->fill($trace->getIds($login));
if (-f "$basedir/$year/$project_id/traces/$dir/$login.xml") {
push @files, "$basedir/$year/$project_id/traces/$dir/$login.xml";
}
}
for my $path (@files)
{
open my $xmltrace, "<", "$path" or die "$path: $!";
binmode $xmltrace;
my $trace = Trace->new(join '', <$xmltrace>);
close $xmltrace;
log DEBUG, "Fill from file: $path";
log TRACE, $trace->getIds($login);
$grading->fill($trace->getNonZeroIds($login));
}
log DEBUG, "Computed grades: ".$grading->compute($login);
open my $xmlgrade, ">", "$basedir/$year/$project_id/grades/$login.xml" or croak "grades/$login.xml";
@ -281,7 +283,7 @@ sub update_defense
if (! -e "$basedir/$year/$project_id/traces/defense_$defense_id/") {
mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
my ($login, $pass, $uid, $gid) = getpwnam("www-data");
chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
chown $uid, $gid, "$basedir/$year/$project_id/traces/defense_$defense_id/";# or die $!; #FIXME
chmod 0775, "$basedir/$year/$project_id/traces/defense_$defense_id/" or die $!;
}

37
process/files/moulette_get.pl
View File

@ -7,6 +7,7 @@ use threads;
use threads::shared;
use Carp;
use File::Basename;
use File::Compare;
use File::Copy;
use File::Path qw(remove_tree mkpath);
use File::Temp qw/tempfile tempdir/;
@ -153,11 +154,39 @@ sub create_testsuite
jail_exec("gmake -C $tempdir/tests/");
croak "An error occurs while making the testsuite" if ($?);
my $destdir = ( prepare_dir($year, $project_id, $rendu) )[2];
my ($workdir, $outputdir, $destdir) = prepare_dir($year, $project_id, $rendu);
copy("$tempdir/tests/tests.ff", "$destdir/tests.ff") or croak "An error occurs while coping the testsuite: $!";
copy("$tempdir/tests/test.ft", "$destdir/test.ft") or croak "An error occurs while coping test.ft: $!";
chmod 0660, "$destdir/tests.ff";
chmod 0660, "$destdir/test.ft";
# Check if test.ft has changed
if (-f "$tempdir/tests/test.ft")
{
if (! -f "$destdir/test.ft" || compare("$tempdir/tests/test.ft", "$destdir/test.ft"))
{
log DEBUG, "test.ft has changed, UPDATE students ones.";
copy("$tempdir/tests/test.ft", "$destdir/test.ft") or croak "An error occurs while coping test.ft: $!";
chmod 0660, "$destdir/test.ft";
opendir(my $dh, $workdir) or die "Can't list files in $workdir: $!";
while (readdir($dh))
{
if (/([a-zA-Z0-9_-]+).ft$/)
{
log DEBUG, "Remove $1.ft";
unlink "$workdir/$1.ft";
}
}
closedir $dh;
}
else
{
log DEBUG, "test.ft hasn't changed, KEEP students ones.";
}
}
else {
remove_tree($tempdir);
croak "tests/test.ft not found.";
}
# Clean
remove_tree($tempdir);
@ -210,7 +239,7 @@ sub run_moulette
close $fhout;
}
copy("$filesdir/$login.ff", "$workdir/$login.ff") or croak "Cannont copy $login.ff";
copy("$filesdir/$login.ff", "$workdir/$login.ff") or croak "Cannot copy $login.ff";
next if ($login eq "ref" && ! -f "$workdir/$login.ft");
croak "Unable to find a relevant $login.ft, abort moulette start." if (! -f "$workdir/$login.ft");

3
process/files/send_git.pl
View File

@ -7,6 +7,7 @@ use v5.10;
use File::Path qw(remove_tree);
use File::Temp qw/tempfile tempdir/;
use ACU::LDAP;
use ACU::Log;
use ACU::Process;
@ -15,7 +16,7 @@ sub process
{
my ($given_args, $args) = @_;
my $year = $args->{param}{year};
my $year = $args->{param}{year} // LDAP::get_year();
my $project_id = $args->{param}{id};
my $rendu = $args->{param}{rendu};
my $login = $args->{param}{login};