From babf3f7850927fbd941658abf4f6294c6e737bf0 Mon Sep 17 00:00:00 2001
From: Mercier Pierre-Olivier <nemunaire@acu.epita.fr>
Date: Thu, 26 Sep 2013 07:08:41 +0200
Subject: [PATCH] Working on moulette launching script

---
 process/files/moulette_get.pl | 120 ++++++++++++++++++++++++++++------
 1 file changed, 99 insertions(+), 21 deletions(-)

diff --git a/process/files/moulette_get.pl b/process/files/moulette_get.pl
index f5d48df..8a3ff12 100644
--- a/process/files/moulette_get.pl
+++ b/process/files/moulette_get.pl
@@ -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);