#! /usr/bin/env perl
#
# Copyright (C) 2008-2022 Alexis Bienvenüe <paamc@passoire.fr>
#
# This file is part of Auto-Multiple-Choice
#
# Auto-Multiple-Choice is free software: you can redistribute it
# and/or modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation, either version 2 of
# the License, or (at your option) any later version.
#
# Auto-Multiple-Choice is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Auto-Multiple-Choice.  If not, see
# <http://www.gnu.org/licenses/>.

use warnings;
use 5.012;

use File::Copy;
use File::Spec::Functions
  qw/splitpath catpath splitdir catdir catfile rel2abs tmpdir/;
use File::Temp qw/ tempfile tempdir /;

use Module::Load;

use Getopt::Long;

use AMC::Basic;
use AMC::Gui::Avancement;
use AMC::Data;
use AMC::DataModule::scoring ':question';

use_gettext;
use_amc_plugins();

my $cmd_pid      = '';
my @output_files = ();

sub catch_signal {
    my $signame = shift;
    debug "*** AMC-prepare : signal $signame, transfered to $cmd_pid...";
    kill 9, $cmd_pid if ($cmd_pid);
    if (@output_files) {
        debug "Removing files that are beeing built: "
          . join( " ", @output_files );
        unlink(@output_files);
    }
    die "Killed";
}

$SIG{INT} = \&catch_signal;

# PARAMETERS

my $mode     = "mbs";
my $data_dir = "";
my $calage   = '';

my $latex_engine    = 'latex';
my @engine_args     = ();
my $engine_topdf    = '';
my $prefix          = '';
my $filter          = '';
my $filtered_source = '';
my $codedigit       = '';

my $latex_stdout = '';

my $n_procs          = 0;
my $number_of_copies = 0;

my $progress    = 1;
my $progress_id = '';

my $out_calage        = '';
my $out_sujet         = '';
my $out_corrige       = '';
my $out_corrige_indiv = '';
my $out_catalog       = '';

my $jobname = "amc-compiled";

my $source = '';
my $f_tex;

my $epoch = '';

GetProjectOptions(
    "mode=s"                                       => \$mode,
    ":moteur_latex|with=s"                         => \$latex_engine,
    ":data:dir|data=s"                             => \$data_dir,
    "calage=s"                                     => \$calage,
    ":texsrc:file|source=s"                        => \$source,
    ":doc_setting:file|out-calage=s"               => \$out_calage,
    ":doc_question:file|out-sujet=s"               => \$out_sujet,
    ":doc_solution:file|out-corrige=s"             => \$out_corrige,
    ":doc_indiv_solution:file|out-corrige-indiv=s" => \$out_corrige_indiv,
    ":doc_catalog:file|out-catalog=s"              => \$out_catalog,
    "latex-stdout!"                                => \$latex_stdout,
    "progression=s"                                => \$progress,
    "progression-id=s"                             => \$progress_id,
    ":project_dir|prefix=s"                        => \$prefix,
    "n-procs=s"                                    => \$n_procs,
    ":nombre_copies|n-copies=s"                    => \$number_of_copies,
    ":filter|filter=s"                             => \$filter,
    ":filtered_source:file|filtered-source=s"      => \$filtered_source,
    "codedigit=s"                                  => \$codedigit,
    "epoch=s"                                      => \$epoch,
);

$source = $ARGV[0] if ( !$source );

debug("AMC-prepare / DEBUG") if (get_debug());

my %global_opts = (qw/NoWatermarkExterne 1 NoHyperRef 1/);

# Split the LaTeX engine string, to get
#
# 1) the engine command $latex_engine (eg. pdflatex)
#
# 2) the engine arguments @engine_args to be passed to this command
#
# 3) the command used to make a PDF file from the engine output
# (eg. dvipdfmx)
#
# The LaTeX engine string is on the form
#   <latex_engine>[+<pdf_engine>] <engine_args>
#
# For exemple:
#
# pdflatex
# latex+dvipdfmx
# platex+dvipdfmx
# lualatex --shell-escape
# latex+dvipdfmx --shell-escape

sub split_latex_engine {
    my ($engine) = @_;

    $latex_engine = $engine if ($engine);

    if ( $latex_engine =~ /([^ ]+)\s+(.*)/ ) {
        $latex_engine = $1;
        @engine_args  = split( / +/, $2 );
    }

    if ( $latex_engine =~ /(.*)\+(.*)/ ) {
        $latex_engine = $1;
        $engine_topdf = $2;
    }
}

split_latex_engine();

sub set_filtered_source {
    my ($filtered_source) = @_;

    # change directory where the $filtered_source is, and set $f_base to
    # the $filtered_source without path and without extension

    my ( $v, $d, $f_base );

    ( $v, $d, $f_tex ) = splitpath($filtered_source);
    chdir( catpath( $v, $d, "" ) );
    $f_base = $f_tex;
    $f_base =~ s/\.tex$//i;

    # AMC usualy sets $prefix to "DOC-", but if $prefix is empty, uses
    # the base name

    $prefix = $f_base . "-" if ( !$prefix );
}

# Uses an AMC::Gui::Avancement object to tell regularly the calling
# program how much work we have done so far.

my $avance = AMC::Gui::Avancement::new( $progress, id => $progress_id );

# Test the source file

die "Nonexistent source file: $source" if ( !-f $source );

# $base is the source file base name (with the path but without
# extension).

my $base = $source;
$base =~ s/\.[a-zA-Z0-9]{1,4}$//gi;

# $filtered_source is the LaTeX fil made from the source file by the
# filter (for exemple, LaTeX or AMC-TXT).

$filtered_source = $base . '_filtered.tex' if ( !$filtered_source );

# default $data_dir value (hardly ever used):

$data_dir = "$base-data" if ( !$data_dir );

# make these filenames global

for ( \$data_dir, \$source, \$filtered_source ) {
    $$_ = rel2abs($$_);
}

my $data = AMC::Data->new($data_dir);

set_filtered_source($filtered_source);

# set environment variables for reproducible output

if ($epoch) {
    $ENV{SOURCE_DATE_EPOCH}                = $epoch;
    $ENV{SOURCE_DATE_EPOCH_TEX_PRIMITIVES} = 1;
    $ENV{FORCE_SOURCE_DATE}                = 1;
}

# These variables are used to track errors from LaTeX compiling

my $a_errors;    # the number of errors
my @errors_msg   = ();    # errors messages (questions specifications problems)
my @latex_errors = ();    # LaTeX compilation errors

sub flush_errors {
    debug(@errors_msg);
    print join( '', @errors_msg );
    @errors_msg = ();
}

# %info_vars collects the variables values that LaTeX wants to give us

my %info_vars = ();

sub relay_info_vars {

    # Relays variables to calling process

    print "Variables :\n";
    for my $k ( keys %info_vars ) {
        print "VAR: $k=" . $info_vars{$k} . "\n";
    }
}

sub exit_with_error {
    relay_info_vars();
    exit(1);
}

# check_question checks that, if the question question is a simple
# one, the number of correct answers is exactly one.

sub check_question {
    my ($q) = @_;

    my $t = $q->{etu} . ":" . $q->{titre};

    # if postcorrection is used, this check cannot be made as we will
    # only know which answers are correct after having captured the
    # teacher's copy.
    return () if ( $info_vars{postcorrect} );

    # if is_alias is true, the questions has already been checked...
    return if ( $q->{is_alias} );

    $q = $q->{q};

    if ($q) {

        # For multiple questions, no problem. $q->{partial} means that
        # all the question answers have not yet been parsed (this can
        # happen when using AMCnumericChoices or AMCOpen, because the
        # answers are only given in the separate answer sheet).
        if ( !( $q->{mult} || $q->{partial} ) ) {
            my $n_correct = 0;
            my $n_total   = 0;
            for my $i ( grep { /^R/ } ( keys %$q ) ) {
                $n_total++;
                $n_correct++ if ( $q->{$i} );
            }
            if ( $n_correct != 1 && !$q->{indicative} ) {
                $a_errors++;
                push @errors_msg,
                  "ERR: "
                  . sprintf(
                    __("%d/%d good answers not coherent for a simple question")
                      . " [%s]\n",
                    $n_correct, $n_total, $t );
            }
        }
    }
}

# analyse_cslog get the chars written in the boxes from the catalog
# build, and updates the layout_char database accordingly

sub analyse_cslog {
    my ($cslog_file) = @_;

    my $layout = $data->module('layout');

    $layout->begin_transaction('Char');
    $layout->clear_char();
    open( CSLOG, $cslog_file ) or die "Unable to open $cslog_file: $!";
    while (<CSLOG>) {
        if (/\\answer\{.*:(\d+),(\d+)\}\{(.*)\}$/) {
            my $question = $1;
            my $answer   = $2;
            my $char     = $3;
            $layout->char( $question, $answer, $char );
        }
    }
    close(CSLOG);
    $layout->end_transaction('Char');
}

# analyse_amclog checks common errors in LaTeX about questions:
#
# * same question ID used multiple times for the same paper, or same
# answer ID used multiple times for the same question
#
# * simple questions with number of good answers != 1
#
# * answer given outside a question
#
# These errors can be detected parsing the *.amc log file produced by
# LaTeX compilation, through \message{...} messages.

sub analyse_amclog {
    my ($amclog_file) = @_;

    my $analyse_data = { etu => 0, titre => '', qs => {} };
    my %titres       = ();
    @errors_msg = ();

    debug("Check AMC log : $amclog_file");

    open( AMCLOG, $amclog_file ) or die "Unable to open $amclog_file: $!";
    while (<AMCLOG>) {

        # Q=N tells that we begin with question number N

        if (/\\message\{Q=([0-9]+)\}/) {

            # first check that the previous question is ok:
            check_question($analyse_data);

            # then clear current question data:
            $analyse_data->{q} = {};

            # if this question has already be seen for current student...
            if ( $analyse_data->{qs}->{$1} ) {

                if ( $analyse_data->{qs}->{$1}->{partial} ) {

                    # if the question was partial (answers was not given in the
                    # question, but are now given in the answer sheet), it's
                    # ok. Simply get back the data already processed, and clear
                    # 'partial' and 'closed' flags:

                    $analyse_data->{q} = $analyse_data->{qs}->{$1};
                    for my $flag (qw/partial closed/) {
                        delete( $analyse_data->{q}->{$flag} );
                    }
                } else {

                    # if the question was NOT partial, this is an error!

                    $a_errors++;
                    push @errors_msg,
                      "ERR: "
                      . sprintf(
                        __(
"question ID used several times for the same paper: \"%s\""
                          )
                          . " [%s]\n",
                        $titres{$1},
                        $analyse_data->{etu}
                      );
                }
            }

            # register question data
            $analyse_data->{titre} = $titres{$1};
            $analyse_data->{titre} = 'unknown'
              if ( !defined( $analyse_data->{titre} ) );
            $analyse_data->{qs}->{$1} = $analyse_data->{q};
        }

        # QPART tells that we end with a question without having
        # given all the answers

        if (/\\message\{QPART\}/) {
            $analyse_data->{q}->{partial} = 1;
        }

        # FQ tells that we have finished with the current question

        if (/\\message\{FQ\}/) {
            $analyse_data->{q}->{closed} = 1;
        }

        # ETU=N tells that we begin with student number N.

        if (/\\message\{ETU=([0-9]+)\}/) {
            my $student = $1;

            # first check the last question from preceding student is ok:

            check_question($analyse_data);

            # then clear all $analyse_data to begin with this student:

            $analyse_data = { etu => $student, titre => '', qs => {} };
        }

        # BR=N tells that this student is a replicate of student N

        if (/\\message\{BR=([0-9]+)\}/) {
            my $alias = $1;

            $analyse_data->{is_alias} = 1;
            $analyse_data->{alias}    = $alias;    # unused ;)
        }

        # NUM=N=ID tells that question number N (internal
        # question number, not the question number shown on the sheet)
        # refers to ID (question name, string given as an argument to
        # question environment)

        if (/\\message\{NUM=([0-9]+)=(.+)\}/) {

            # stores this association (two-way)

            $titres{$1} = $2;
            $analyse_data->{titres}->{$2} = 1;
        }

        # MULT tells that current question is a multiple question

        if (/\\message\{MULT\}/) {
            $analyse_data->{q}->{mult} = 1;
        }

        # INDIC tells that current question is an indicative
        # question

        if (/\\message\{INDIC\}/) {
            $analyse_data->{q}->{indicative} = 1;
        }

        # REP=N:S tells that answer number N is S (S can be 'B'
        # for 'correct' or 'M' for wrong)

        if (/\\message\{REP=([0-9]+):([BM])\}/) {
            my $rep = "R" . $1;

            if ( $analyse_data->{q}->{closed} ) {

                # If current question is already closed, this is an error!

                $a_errors++;
                push @errors_msg,
                  "ERR: "
                  . sprintf(
                    __(
"An answer appears to be given outside a question environment, after question \"%s\""
                      )
                      . " [%s]\n",
                    $analyse_data->{titre},
                    $analyse_data->{etu}
                  );
            }

            if ( defined( $analyse_data->{q}->{$rep} ) ) {

                # if we already saw an answer with the same N, this is an error!

                $a_errors++;
                push @errors_msg,
                  "ERR: "
                  . sprintf(
                    __(
"Answer number ID used several times for the same question: %s"
                      )
                      . " [%s]\n",
                    $1,
                    $analyse_data->{titre}
                  );
            }

            # stores the answer's status
            $analyse_data->{q}->{$rep} = ( $2 eq 'B' ? 1 : 0 );
        }

        # VAR:N=V tells that variable named N has value V

        if (/\\message\{VAR:([0-9a-zA-Z.:-]+)=(.+)\}/) {
            $info_vars{$1} = $2;
        }

    }
    close(AMCLOG);

    # check that the last question from the last student is ok:

    check_question($analyse_data);

    # Send error messages to the calling program through STDOUT

    flush_errors();

    debug("AMC log $amclog_file : $a_errors errors.");
}

# execute(%oo) launches the LaTeX engine with the right arguments, call it
# again if needed (for exemple when a second run is necessary to get
# references right), and then produces a PDF file from LaTeX output.
#
# $oo{command_opts} should be the options to be passed to latex_cmd, to
# build the LaTeX command to run, with all necessary arguments

my $filter_engine;

sub execute {
    my %oo   = (@_);
    my $errs = 0;

    prepare_filter();

    # gives the processing command to the filter
    $oo{command}  = [ latex_cmd( @{ $oo{command_opts} } ) ];
    $ENV{AMC_CMD} = join( ' ', @{ $oo{command} } );

    if ($filter) {
        if (  !$filter_engine->get_filter_result('done')
            || $filter_engine->get_filter_result('jobspecific') )
        {
            $errs = do_filter();
            $filter_engine->set_filter_result( 'done', 1 ) if ( !$errs );
        }
    }

    # first removes previous run's outputs

    for my $ext (qw/pdf dvi ps/) {
        if ( -f "$jobname.$ext" ) {
            debug "Removing old $ext";
            unlink("$jobname.$ext");
        }
    }

    exit_with_error() if ($errs);

    # the filter could have changed the latex engine, so update it
    $oo{command}  = [ latex_cmd( @{ $oo{command_opts} } ) ];
    $ENV{AMC_CMD} = join( ' ', @{ $oo{command} } );

    check_engine();

    my $min_runs = 1;     # minimum number of runs
    my $max_runs = 2;     # maximum number of runs
    my $n_run    = 0;     # number of runs so far
    my $rerun    = 0;     # has to re-run?
    my $delta    = 0;
    my $format   = '';    # output format

    do {

        $n_run++;

        $avance->text( $oo{text} . ( $oo{once} ? "" : " ($n_run)" ) );
        $avance->progres(0.1);

        # clears errors from previous run

        $a_errors     = 0;
        @latex_errors = ();

        debug "%%% Compiling: pass $n_run";

        # lauches the command

        debug "COMMAND: $ENV{AMC_CMD}";

        $cmd_pid = open( EXEC, "-|", @{ $oo{command} } );
        die "Can't exec " . join( ' ', @{ $oo{command} } ) if ( !$cmd_pid );

        # parses the output

        EXEC->autoflush(1);

        while (<EXEC>) {

            # progression...
            if (/^AMC:copies:total=([0-9]+)/) {
                my $nc = $1;
                if ( $nc > 0 ) {
                    $delta = 0.9 / $nc;
                }
            }
            if (/^AMC:copies:add=([0-9]+)/) {
                $avance->progres( $1 * $delta );
            }

            # LaTeX Warning: Label(s) may have changed. Rerun to get
            # cross-references right. -> has to re-run

            $rerun = 1
              if (/^LaTeX Warning:.*Rerun to get cross-references right/);
            $min_runs = 2
              if (/Warning: .*run twice/);

            # Output written on jobname.pdf (10 pages) -> output
            # format is pdf

            $format = $1 if (/^Output written on .*\.([a-z]+) \(/);

            # Lines beginning with '!' are errors: collect them

            if (/^\!\s*(.*)$/) {
                my $e = $1;
                $e .= "..." if ( $e !~ /\.$/ );
                push @latex_errors, $e;
            }

            # detect style file path

            if (m=\(((?:[^\)]+/)?automultiplechoice.sty)(\)|$)=) {
                $info_vars{stypath} = $1;
            }

            # detect style file version

            if (/^AMC version: (.*)/) {
                $info_vars{styversion} = $1;
            }

            # Relays LaTeX log to calling program

            print STDERR $_ if (/^.+$/);
            print $_ if ( $latex_stdout && /^.+$/ );
        }
        close(EXEC);
        $cmd_pid = '';

    } while ( ( ( $n_run < $min_runs ) || ( $rerun && $n_run < $max_runs ) )
        && !$oo{once} );

    # For these engines, we already know what is the output format:
    # override detected one

    $format = 'dvi' if ( $latex_engine eq 'latex' );
    $format = 'pdf' if ( $latex_engine eq 'pdflatex' );
    $format = 'pdf' if ( $latex_engine eq 'xelatex' );

    print "Output format: $format\n";
    debug "Output format: $format\n";

    # Now converts output to PDF. Output format can be DVI or PDF. If
    # PDF, nothing has to be done...

    if ( $format eq 'dvi' ) {
        if ( $oo{latex_only} ) {
            debug "No need to build the PDF file.";
        } elsif ( -f "$jobname.dvi" ) {

            # default DVI->PDF engine is dvipdfmx

            $engine_topdf = 'dvipdfm'
              if ( !$engine_topdf );

            # if the choosend DVI->PDF engine is not present, try to get
            # another one

            if ( !commande_accessible($engine_topdf) ) {
                debug_and_stderr "WARNING: command $engine_topdf not available";
                $engine_topdf =
                  choose_command( 'dvipdfmx', 'dvipdfm', 'xdvipdfmx',
                    'dvipdf' );
            }

            if ($engine_topdf) {

                # Now, convert DVI to PDF

                debug "Converting DVI to PDF with $engine_topdf ...";
                if ( $engine_topdf eq 'dvipdf' ) {
                    system_debug( cmd =>
                          [ $engine_topdf, "$jobname.dvi", "$jobname.pdf" ] );
                } else {
                    system_debug(
                        cmd => [
                            $engine_topdf,  "-o",
                            "$jobname.pdf", "$jobname.dvi"
                        ]
                    );
                }
            } else {

                # No available DVI->PDF engine!

                debug_and_stderr
                  "ERROR: I can't find dvipdf/dvipdfm/xdvipdfmx command !";
            }
        } else {
            debug "No DVI";
        }
    }

}

# do_filter() converts the source file to LaTeX format, using the
# right AMC::Filter::* module

sub prepare_filter {
    if ($filter) {
        if ( !$filter_engine ) {
            load("AMC::Filter::$filter");
            $filter_engine = "AMC::Filter::$filter"->new( jobname => $jobname );
            $filter_engine->pre_filter($source);

            # sometimes the filter says that the source file don't need to
            # be changed

            set_filtered_source($source)
              if ( $filter_engine->unchanged );
        }
    } else {

        # Empty filter: the source is already a LaTeX file
        set_filtered_source($source);
    }
}

sub do_filter {
    my $n_err = 0;

    if ($filter) {

        # Loads and call appropriate filter to convert $source to
        # $filtered_source

        prepare_filter();
        $filter_engine->filter( $source, $filtered_source );

        # show conversion errors

        for ( $filter_engine->errors() ) {
            print "ERR: $_\n";
            $n_err++;
        }

        # sometimes the filter asks to override the LaTeX engine

        split_latex_engine(
            $filter_engine->{project_options}->{moteur_latex_b} )
          if ( $filter_engine->{project_options}->{moteur_latex_b} );

        # or to set the number of copies to a particular value

        $number_of_copies =
          $filter_engine->{project_options}->{'nombre_copies'}
          if (
            exists(
                $filter_engine->{project_options}->{'nombre_copies'}
            )
          );

    }

    return ($n_err);
}

# give_latex_errors($context) Relay suitably formatted LaTeX errors to
# calling program (usualy AMC GUI). $context is the name of the
# document we are building.

sub give_latex_errors {
    my ($context) = @_;
    if (@latex_errors) {
        print "ERR: <i>"
          . sprintf( __("%d errors during LaTeX compiling") . " (%s)</i>\n",
            ( 1 + $#latex_errors ), $context );
        for (@latex_errors) {
            print "ERR>$_\n";
        }
        exit_with_error();
    }
}

# transfer($orig,$dest) moves $orig to $dest, removing $dest if $orig
# does not exist

sub transfer {
    my ( $orig, $dest ) = @_;
    if ( -f $orig ) {
        debug "Moving $orig --> $dest";
        move( $orig, $dest );
    } else {
        debug "No source: removing $dest";
        unlink($dest);
    }
}

# latex_reprocucible_commands($engine) returns commands suitable for
# the given engine to get reproducible output.

sub latex_reproducible_commands {
    my ($engine) = @_;
    if ( $engine eq 'pdflatex' ) {
        return ("\\pdfinfo{ /Producer (LaTeX) /Creator () }\\pdfsuppressptexinfo=-1\\pdftrailerid{}");
    } else {
        return ("");
    }
}

# latex_cmd(%o) builds the LaTeX command and arguments to be passed to
# the execute command, using the engine specifications and extra
# options %o to pass to LaTeX: for each name=>value from %o, a LaTeX
# command '\def\name{value}' is passed to LaTeX through the
# jobname-config.tex, that will be read by the automultiplechoice
# package. This allows to relay some options to LaTeX (number of
# copies, document needed for exemple).

sub latex_cmd {
    my (%o) = @_;

    $o{AMCNombreCopies} = $number_of_copies if ( $number_of_copies > 0 );

    # build a configuration tex file, that will be read by the
    # autoultiplechoice LaTeX package, from the %o options:
    open( CONFIG, ">:utf8", "$jobname-config.tex" )
      or die "Unable to open config file: $!";
    print CONFIG latex_reproducible_commands($latex_engine) if ($epoch);
    for my $k ( keys %o ) {
        print CONFIG "\\def\\" . $k . "{" . $o{$k} . "}";
    }
    print CONFIG "\n";
    close(CONFIG);

    return ( $latex_engine, "--jobname=" . $jobname,
        "-interaction=nonstopmode", @engine_args, $f_tex );
}

# check_engine() checks that the requeted LaTeX engine is available on
# the system

sub check_engine {
    if ( !commande_accessible($latex_engine) ) {
        print "ERR: "
          . sprintf(
            __(
"LaTeX command configured is not present (%s). Install it or change configuration, and then rerun."
            ),
            $latex_engine
          ) . "\n";
        exit_with_error();
    }
}

# the $mode option passed to AMC-prepare contains characters that
# explains what is to be prepared...

my %to_do = ();
while ( $mode =~ s/^[^a-z]*([a-z])(\[[a-z]*\])?//i ) {
    $to_do{$1} = ( defined($2) ? $2 : 1 );
}

############################################################################
# MODE f: filter source file to LaTeX format
############################################################################

if ( $to_do{f} ) {

    # FILTER
    do_filter();
}

############################################################################
# MODE S: builds the solution
############################################################################

sub build_solution {
    execute(
        command_opts => [ %global_opts, CorrigeExterne => 1 ],
        text         => __ "Building the solution"
    );
    transfer( "$jobname.pdf", $out_corrige );
    give_latex_errors( __ "solution" );
}

if ( $to_do{S} ) {
    build_solution();
}

############################################################################
# MODE C: builds the catalog
############################################################################

sub build_catalog {
    execute(
        command_opts => [ %global_opts, CatalogExterne => 1 ],
        text         => __ "Building the catalog"
    );
    transfer( "$jobname.pdf", $out_catalog );
    analyse_cslog("$jobname.amc");
    give_latex_errors( __ "catalog" );
}

if ( $to_do{C} ) {
    build_catalog();
}

############################################################################
# MODE s: builds the subject and a solution (with all the answers for
# questions, but with a different layout)
############################################################################

if ( $to_do{s} ) {
    $to_do{s} = '[sc]' if ( $to_do{s} eq '1' );

    @output_files = ( $out_sujet, $out_calage, $out_corrige, $out_catalog );

    $out_calage  = $prefix . "calage.xy"   if ( !$out_calage );
    $out_corrige = $prefix . "corrige.pdf" if ( !$out_corrige );
    $out_catalog = $prefix . "catalog.pdf" if ( !$out_catalog );
    $out_sujet   = $prefix . "sujet.pdf"   if ( !$out_sujet );

    for my $f ( $out_calage, $out_corrige, $out_corrige_indiv, $out_sujet,
        $out_catalog )
    {
        if ( -f $f ) {
            debug "Removing already existing file: $f";
            unlink($f);
        }
    }

    # 1) SUBJECT

    my $report = $data->module('report');

    $report->begin_transaction("prtX");
    $report->printed_clear();
    $report->end_transaction("prtX");

    execute(
        command_opts => [ %global_opts, SujetExterne => 1 ],
        text         => __ "Building the question sheet"
    );
    analyse_amclog("$jobname.amc");
    give_latex_errors( __ "question sheet" );

    if ( $a_errors > 0 ) {
        debug("$a_errors errors detected: EXIT");
        exit_with_error();
    }

    transfer( "$jobname.pdf", $out_sujet );
    transfer( "$jobname.xy",  $out_calage );

    # Looks for accents problems in question IDs...

    my %qids        = ();
    my $unknown_qid = 0;
    if ( open( XYFILE, $out_calage ) ) {
        binmode(XYFILE);
        while (<XYFILE>) {
            if ( !utf8::decode($_) || /\\IeC/ ) {
                if (
/\\tracepos\{[^:]*:[^:]*:(.+):[^:]*\}\{([+-]?[0-9.]+[a-z]*)\}\{([+-]?[0-9.]+[a-z]*)\}(?:\{([a-zA-Z]*)\})?$/
                  )
                {
                    $qids{$1} = 1;
                } else {
                    $unknown_qid = 1;
                }
            }
        }
        close(XYFILE);
        if (%qids) {
            push @errors_msg, map {
                "WARN: "
                  . sprintf(
                    __(
"please remove accentuated or non-standard characters from the following question ID: \"%s\""
                    ),
                    $_
                  )
                  . "\n"
            } ( sort { $a cmp $b } ( keys %qids ) );
        } elsif ($unknown_qid) {
            push @errors_msg,
              "WARN: "
              . __(
"some question IDs seems to have accentuated or non-standard characters. This may break future processings."
              ) . "\n";
        }
    }
    flush_errors();

    # 2) SOLUTION

    if ( $to_do{s} =~ /s/ ) {
        build_solution();
    } else {
        debug "Solution not requested: removing $out_corrige";
        unlink($out_corrige);
    }

    # 3) CATALOG

    if ( $to_do{s} =~ /c/ ) {
        build_catalog();
    } else {
        debug "Catalog not requested: removing $out_catalog";
        unlink($out_catalog);
    }
}

############################################################################
# MODE k: builds individual corrected answer sheets (exactly the same
# sheets as for the students, but with correct answers ticked).
############################################################################

if ( $to_do{k} ) {

    my $of = $out_corrige_indiv;
    $of = $out_corrige            if ( !$of && !$to_do{s} );
    $of = $prefix . "corrige.pdf" if ( !$of );

    if ( -f $of ) {
        debug "Removing already existing file: $of";
        unlink($of);
    }

    @output_files = ($of);

    execute(
        command_opts => [ %global_opts, qw/CorrigeIndivExterne 1/ ],
        text         => __ "Building the individual solution"
    );
    transfer( "$jobname.pdf", $of );
    give_latex_errors( __ "individual solution" );
}

############################################################################
# MODE b: extracts the scoring strategy to the scoring database,
# parsing the \message{...} messages from the LaTeX output.
############################################################################

if ( $to_do{b} ) {

    print "********** Making marks scale...\n";

    my %bs     = ();
    my %titres = ();

    my $quest         = '';
    my $rep           = '';
    my $outside_quest = '';
    my $etu           = 0;

    my $delta = 0;

    # Opens a connection with the database

    my $scoring = $data->module('scoring');
    my $capture = $data->module('capture');

    # Launches the LaTeX engine

    my @opts = (qw/ScoringExterne 1 NoHyperRef 1/);

    if ( !$codedigit ) {

        # if not explicitly given, uses the same codedigit convention
        # as recorded from the 'extract layout' phase
        my $layout = $data->module('layout');
        $codedigit = $layout->variable_transaction('build:codedigit');
        $codedigit = 'dot' if ( !$codedigit );    # old AMC versions
    }
    if ($codedigit) {
        push @opts, "codeDigitExterne", $codedigit;
    }

    execute(
        command_opts => [@opts],
        once         => 1,
        latex_only   => 1,
        text         => __ "Processing the source file"
    );

    open( AMCLOG, "$jobname.amc" ) or die "Unable to open $jobname.amc : $!";

    my $qs                    = {};
    my $qs0                   = {}; # memory for student 0 (when using AMCformS)
    my $current_q             = {};
    my $qs0_count             = 0;
    my $finished_with_student = 0;

    # and parse the log...

    $avance->text( __ "Extracting marking scale..." );

    $scoring->begin_transaction('ScEx');
    annotate_source_change($capture);
    $scoring->clear_strategy;

  PARSELOG: while (<AMCLOG>) {
        debug($_) if ($_);

        # TOTAL=N tells that the total number of sheets is
        # N. This will allow us to relay the progression of the
        # process to the calling process.

        if (/\\message\{TOTAL=([\s0-9]+)\}/) {
            my $t = $1;
            $t =~ s/\s//g;
            if ( $t > 0 ) {
                $delta = 1 / $t;
            } else {
                print "*** TOTAL=$t ***\n";
            }
        }

        if (/\\message\{ETU=([0-9]+)\}/) {

            # save if student 0
            $qs0 = $qs if ( $etu == 0 );

            # beginning of student sheet
            $avance->progres($delta) if ( $etu ne '' );
            $etu = $1;
            print "Sheet $etu...\n";
            debug "Sheet $etu...\n";
            $qs                    = {};
            $finished_with_student = 0;
        }

        next PARSELOG if ($finished_with_student);

        if (/\\message\{FQ\}/) {

            # end of question: register it (or update it)
            $scoring->new_question(
                $etu,
                $quest,
                ( $current_q->{multiple} ? QUESTION_MULT : QUESTION_SIMPLE ),
                $current_q->{indicative},
                $current_q->{strategy}
            );
            $qs->{$quest}  = $current_q;
            $outside_quest = $quest;
            $quest         = '';
            $rep           = '';
        }

        if (/\\message\{Q=([0-9]+)\}/) {

            # beginning of question
            $quest = $1;
            $rep   = '';
            if ( $qs->{$quest} ) {
                $current_q = $qs->{$quest};
            } else {
                $current_q = {
                    multiple   => 0,
                    indicative => 0,
                    strategy   => '',
                };
            }
        }

        if (/\\message\{NUM=([0-9]+)=(.+)\}/) {

            # association question-number<->question-title
            $scoring->question_title( $1, $2 );
        }

        if (/\\message\{MULT\}/) {

            # this question is a multiple-style one
            $current_q->{multiple} = 1;
        }

        if (/\\message\{INDIC\}/) {

            # this question is an indicative one
            $current_q->{indicative} = 1;
        }

        if (/\\message\{REP=([0-9]+):([BM])\}/) {

            # answer
            $rep = $1;
            my $qq = $quest;
            if ( $outside_quest && !$qq ) {
                $qq = $outside_quest;
                debug_and_stderr
"WARNING: answer outside questions for student $etu (after question $qq)";
            }
            $scoring->new_answer( $etu, $qq, $rep, ( $2 eq 'B' ? 1 : 0 ), '' );
        }

        # BR=N tells that this student is a replicate of student N

        if (/\\message\{BR=([0-9]+)\}/) {
            my $alias = $1;

            $scoring->replicate( $alias, $etu );
            $etu                   = $alias;
            $qs                    = $qs0 if ( $etu == 0 );
            $finished_with_student = 1 if ( $qs0_count > 0 );
            $qs0_count++;
        }

        if (/\\message\{B=(.+)\}/) {

            # scoring strategy string
            if ($quest) {
                if ($rep) {

                    # associated to an answer
                    $scoring->add_answer_strategy( $etu, $quest, $rep, $1 );
                } else {

                    # associated to a question
                    $current_q->{strategy} = (
                          $current_q->{strategy}
                        ? $current_q->{strategy} . ','
                        : ''
                    ) . $1;
                }
            } else {

                # global scoring strategy, associated to a student if
                # $etu>0, or to all students if $etu==0
                $scoring->add_main_strategy( $etu, $1 );
            }
        }

        # BDS=string gives us the default scoring stragety
        # for simple questions
        # BDM=string gives us the default scoring stragety
        # for multiple questions

        if (/\\message\{BD(S|M)=(.+)\}/) {
            $scoring->default_strategy(
                ( $1 eq 'S' ? QUESTION_SIMPLE : QUESTION_MULT ), $2 );
        }

        if (/\\message\{VAR:([0-9a-zA-Z.-]+)=(.+)\}/) {

            # variables
            my $name  = $1;
            my $value = $2;
            $name = 'postcorrect_flag' if ( $name eq 'postcorrect' );
            $scoring->variable( $name, $value );
        }
    }
    close(AMCLOG);

    $scoring->variable('extracted', time());

    $scoring->end_transaction('ScEx');
}

relay_info_vars();

$avance->fin();
