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

Working on moulette launching script

Browse source
This commit is contained in:
Mercier Pierre-Olivier 2013-09-26 07:08:41 +02:00
parent 188650aeaf
commit babf3f7850
1 changed files with 99 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

120
process/files/moulette_get.pl
View file

@ -3,74 +3,144 @@
use v5.10.1;
use strict;
use warnings;
use Carp;
use Pod::Usage;
use File::Temp;
use File::Copy;
use File::Path qw(remove_tree);
use File::Temp qw/tempfile tempdir/;
use ACU::Log;
use ACU::Process;
my %actions = (
"tar" => \&receive_tar,
"git" => \&receive_tar, # \&receive_git
"git" => \&receive_git,
"tests" => \&create_testsuite,
"moulette" => \&moulette,
);
sub prepare_dir
{
my $year = shift;
my $project_id = shift;
my $rendu = shift;
# TODO: replace ~calvair by the destination directory
my $dir = "~calvair/$year-$project_id-$rendu/";
if (! -d $dir) {
mkpath($destdir) or croak "An error occurs while creating directory: $!";
}
return $dir;
}
sub receive_tar
{
my $args = shift;
my $project_id = $args->{param}{id};
my $year = $args->{param}{year};
my $rendu = $args->{param}{rendu};
my $file = $args->{param}{file};
my $login = $args->{param}{login} // "ref";
if (!exists $args->{files}{$file}) {
return "No file named '$file' given".
}
croak "No file named '$file' given" if (!exists $args->{files}{$file});
($fh, $filename) = tempfile(SUFFIX => $file);
my ($fh, $filename) = tempfile(SUFFIX => $file);
binmode($fh);
print $fh $args->{files}{$file};
close $fh;
my $destdir = prepare_dir($year, $project_id, $file);
# TODO: Call Fact for create .ff
# qx(Fact package create $filename $destdir/$login.ff)
croak "Cannot create $login.ff" if ($?);
return "Ok"
# Clean
unlink $filename;
}
sub receive_git
{
my $args = shift;
my $project_id = $args->{param}{id};
my $year = $args->{param}{year};
my $rendu = $args->{param}{rendu};
my $file = $args->{param}{file};
my $login = $args->{param}{login} // "ref";
croak "No file named '$file' given" if (!exists $args->{files}{$file});
my $tempdir = tempdir();
open my $fh, "|tar -xz -C '$tempdir'";
print $fh $args->{files}{$file};
close $fh;
croak "An error occurs while extracting the tarball" if ($?);
my $destdir = prepare_dir($year, $project_id, $file);
# TODO: Call Fact for create .ff
# qx(Fact package create $tempdir $destdir/$login.ff)
croak "Cannot create $login.ff" if ($?);
# Clean
remove_tree($tempdir);
}
sub create_testsuite
{
my $args = shift;
my $project_id = $args->{param}{id};
my $year = $args->{param}{year};
my $rendu = $args->{param}{rendu};
my $file = $args->{param}{file};
($fh, $filename) = tempfile();
croak "No file named '$file' given" if (!exists $args->{files}{$file});
if (!exists $args->{files}{$file}) {
return "No file named '$file' given".
}
($fh, $filename) = tempfile(SUFFIX => $file);
binmode($fh);
my $tempdir = tempdir();
open my $fh, "|tar -xz -C '$tempdir'";
print $fh $args->{files}{$file};
close $fh;
# TODO: Call Fact to create testsuite
croak "An error occurs while extracting the tarball" if ($?);
return "Ok"
qx(make -C $tempdir/tests/);
croak "An error occurs while making the testsuite" if ($?);
my $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: $!";
# Clean
remove_tree($tempdir);
}
sub moulette
{
my $args = shift;
my $project_id = $args->{param}{id};
my $year = $args->{param}{year};
my $rendu = $args->{param}{rendu};
my $login = $args->{param}{login};
# TODO: Call Fact to launch student tarball
my $testdir = prepare_dir($year, $project_id, $rendu);
return "Ok"
chdir($testdir);
for (my $i = $args->{unamed}; $i > 0; $i--)
{
my $login = $args->{param}{$i}
open my $fhin, "<", "$testdir/test.ft";
open my $fhout, ">", "$testdir/$login.ft";
print $fhout s/#LOGIN_X/$login/g while (<$fhin>);
close $fhin;
close $fhout;
# TODO: Call Fact to launch student tarball
# qx(Fact system manager $login.ft)
log WARN, "An error occurs while starting tests for $login on $year-$project_id-$rendu" if ($?);
}
}
@ -78,14 +148,22 @@ sub process_get
{
my ($given_args, $args) = @_;
my $type = $args->{param}{type};
my $type = $args->{param}{type} // "";
if (! exists $actions{$type}) {
log WARN, "Unknown type '$type'";
return "Unknown type '$type'.";
}
return $actions{$type}($args);
eval {
$actions{$type}($args);
}
if ($@) {
my $err = $@;
log ERROR, $err;
return $err;
}
return "Ok";
}
Process::register("moulette_get", \&process_get);