AMC-prepare.pl

DENIS Sébastien, 12/06/2018 05:12 pm

Download (24.8 kB)

 
1
#! /usr/bin/perl
2
#
3
# Copyright (C) 2008-2016 Alexis Bienvenue <paamc@passoire.fr>
4
#
5
# This file is part of Auto-Multiple-Choice
6
#
7
# Auto-Multiple-Choice is free software: you can redistribute it
8
# and/or modify it under the terms of the GNU General Public License
9
# as published by the Free Software Foundation, either version 2 of
10
# the License, or (at your option) any later version.
11
#
12
# Auto-Multiple-Choice is distributed in the hope that it will be
13
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
14
# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15
# General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Auto-Multiple-Choice.  If not, see
19
# <http://www.gnu.org/licenses/>.
20
21
use encoding "utf-8";
22
use Encode qw(decode encode);
23
24
use File::Copy;
25
use File::Spec::Functions qw/splitpath catpath splitdir catdir catfile rel2abs tmpdir/;
26
use File::Temp qw/ tempfile tempdir /;
27
28
use Module::Load;
29
30
use Getopt::Long;
31
32
use AMC::Basic;
33
use AMC::Gui::Avancement;
34
use AMC::Data;
35
use AMC::DataModule::scoring ':question';
36
37
use_gettext;
38
use_amc_plugins();
39
40
my $cmd_pid='';
41
my @output_files=();
42
43
sub catch_signal {
44
    my $signame = shift;
45
    debug "*** AMC-prepare : signal $signame, transfered to $cmd_pid...";
46
    kill 9,$cmd_pid if($cmd_pid);
47
    if(@output_files) {
48
      debug "Removing files that are beeing built: ".join(" ",@output_files);
49
      unlink(@output_files);
50
    }
51
    die "Killed";
52
}
53
54
$SIG{INT} = \&catch_signal;
55
56
# PARAMETERS
57
58
my $mode="mbs";
59
my $data_dir="";
60
my $calage='';
61
62
my $latex_engine='latex';
63
my @engine_args=();
64
my $engine_topdf='';
65
my $prefix='';
66
my $filter='';
67
my $filtered_source='';
68
69
my $debug='';
70
my $latex_stdout='';
71
72
my $n_procs=0;
73
my $number_of_copies=0;
74
75
my $progress=1;
76
my $progress_id='';
77
78
my $out_calage='';
79
my $out_sujet='';
80
my $out_corrige='';
81
my $out_corrige_indiv='';
82
my $out_catalog='';
83
84
my $jobname="amc-compiled";
85
86
my $f_tex;
87
88
@ARGV=unpack_args(@ARGV);
89
90
GetOptions("mode=s"=>\$mode,
91
	   "with=s"=>\$latex_engine,
92
	   "data=s"=>\$data_dir,
93
	   "calage=s"=>\$calage,
94
	   "out-calage=s"=>\$out_calage,
95
	   "out-sujet=s"=>\$out_sujet,
96
	   "out-corrige=s"=>\$out_corrige,
97
	   "out-corrige-indiv=s"=>\$out_corrige_indiv,
98
	   "out-catalog=s"=>\$out_catalog,
99
	   "convert-opts=s"=>\$convert_opts,
100
	   "debug=s"=>\$debug,
101
	   "latex-stdout!"=>\$latex_stdout,
102
	   "progression=s"=>\$progress,
103
	   "progression-id=s"=>\$progress_id,
104
	   "prefix=s"=>\$prefix,
105
	   "n-procs=s"=>\$n_procs,
106
	   "n-copies=s"=>\$number_of_copies,
107
	   "filter=s"=>\$filter,
108
	   "filtered-source=s"=>\$filtered_source,
109
	   );
110
111
set_debug($debug);
112
113
debug("AMC-prepare / DEBUG") if($debug);
114
115
# Split the LaTeX engine string, to get
116
#
117
# 1) the engine command $latex_engine (eg. pdflatex)
118
#
119
# 2) the engine arguments @engine_args to be passed to this command
120
#
121
# 3) the command used to make a PDF file from the engine output
122
# (eg. dvipdfmx)
123
#
124
# The LaTeX engine string is on the form
125
#   <latex_engine>[+<pdf_engine>] <engine_args>
126
#
127
# For exemple:
128
#
129
# pdflatex
130
# latex+dvipdfmx
131
# platex+dvipdfmx
132
# lualatex --shell-escape
133
# latex+dvipdfmx --shell-escape
134
135
sub split_latex_engine {
136
  my ($engine)=@_;
137
138
  $latex_engine=$engine if($engine);
139
140
  if($latex_engine =~ /([^ ]+)\s+(.*)/) {
141
    $latex_engine=$1;
142
    @engine_args=split(/ +/,$2);
143
  }
144
145
  if($latex_engine =~ /(.*)\+(.*)/) {
146
    $latex_engine=$1;
147
    $engine_topdf=$2;
148
  }
149
}
150
151
split_latex_engine();
152
153
sub set_filtered_source {
154
  my ($filtered_source)=@_;
155
156
  # change directory where the $filtered_source is, and set $f_base to
157
  # the $filtered_source without path and without extension
158
159
  ($v,$d,$f_tex)=splitpath($filtered_source);
160
  chdir(catpath($v,$d,""));
161
  $f_base=$f_tex;
162
  $f_base =~ s/\.tex$//i;
163
164
  # AMC usualy sets $prefix to "DOC-", but if $prefix is empty, uses
165
  # the base name
166
167
  $prefix=$f_base."-" if(!$prefix);
168
}
169
170
# Uses an AMC::Gui::Avancement object to tell regularly the calling
171
# program how much work we have done so far.
172
173
my $avance=AMC::Gui::Avancement::new($progress,'id'=>$progress_id);
174
175
# Get and test the source file
176
177
my $source=$ARGV[0];
178
179
die "Nonexistent source file: $source" if(! -f $source);
180
181
# $base is the source file base name (with the path but without
182
# extension).
183
184
my $base=$source;
185
$base =~ s/\.[a-zA-Z0-9]{1,4}$//gi;
186
187
# $filtered_source is the LaTeX fil made from the source file by the
188
# filter (for exemple, LaTeX or AMC-TXT).
189
190
$filtered_source=$base.'_filtered.tex' if(!$filtered_source);
191
192
# default $data_dir value (hardly ever used):
193
194
$data_dir="$base-data" if(!$data_dir);
195
196
# make these filenames global
197
198
for(\$data_dir,\$source,\$filtered_source) {
199
    $$_=rel2abs($$_);
200
}
201
202
set_filtered_source($filtered_source);
203
204
# These variables are used to track errors from LaTeX compiling
205
206
my $a_errors; # the number of errors
207
my @errors_msg=(); # errors messages (questions specifications problems)
208
my @latex_errors=(); # LaTeX compilation errors
209
210
sub flush_errors {
211
  debug(@errors_msg);
212
  print join('',@errors_msg);
213
  @errors_msg=();
214
}
215
216
217
# %info_vars collects the variables values that LaTeX wants to give us
218
219
my %info_vars=();
220
221
# check_question checks that, if the question question is a simple
222
# one, the number of correct answers is exactly one.
223
224
sub check_question {
225
    my ($q,$t)=@_;
226
227
    # if postcorrection is used, this check cannot be made as we will
228
    # only know which answers are correct after having captured the
229
    # teacher's copy.
230
    return() if($info_vars{'postcorrect'});
231
232
    if($q) {
233
      # For multiple questions, no problem. $q->{partial} means that
234
      # all the question answers have not yet been parsed (this can
235
      # happen when using AMCnumericChoices or AMCOpen, because the
236
      # answers are only given in the separate answer sheet).
237
	if(!($q->{'mult'} || $q->{'partial'})) {
238
	    my $n_correct=0;
239
	    my $n_total=0;
240
	    for my $i (grep { /^R/ } (keys %$q)) {
241
		$n_total++;
242
		$n_correct++ if($q->{$i});
243
	    }
244
	    if($n_correct!=1 && !$q->{'indicative'}) {
245
		$a_errors++;
246
		push @errors_msg,"ERR: "
247
		    .sprintf(__("%d/%d good answers not coherent for a simple question")." [%s]\n",$n_correct,$n_total,$t);
248
	    }
249
	}
250
    }
251
}
252
253
# analyse_amclog checks common errors in LaTeX about questions:
254
#
255
# * same question ID used multiple times for the same paper, or same
256
# answer ID used multiple times for the same question
257
#
258
# * simple questions with number of good answers != 1
259
#
260
# * answer given outside a question
261
#
262
# These errors can be detected parsing the *.amc log file produced by
263
# LaTeX compilation, through AUTOQCM[...] messages.
264
265
sub analyse_amclog {
266
  my ($amclog_file)=@_;
267
268
  my %analyse_data=();
269
  my %titres=();
270
  @errors_msg=();
271
272
  debug("Check AMC log : $amclog_file");
273
274
  open(AMCLOG,$amclog_file) or die "Unable to open $amclog_file: $!";
275
  while (<AMCLOG>) {
276
277
    # AUTOQCM[Q=N] tells that we begin with question number N
278
279
    if (/AUTOQCM\[Q=([0-9]+)\]/) {
280
281
      # first check that the previous question is ok:
282
      check_question($analyse_data{'q'},$analyse_data{'etu'}.":".$analyse_data{'titre'});
283
284
      # then clear current question data:
285
      $analyse_data{'q'}={};
286
287
      # if this question has already be seen for current student...
288
      if ($analyse_data{'qs'}->{$1}) {
289
290
	if ($analyse_data{'qs'}->{$1}->{'partial'}) {
291
	  # if the question was partial (answers was not given in the
292
	  # question, but are now given in the answer sheet), it's
293
	  # ok. Simply get back the data already processed, and clear
294
	  # 'partial' and 'closed' flags:
295
296
	  $analyse_data{'q'}=$analyse_data{'qs'}->{$1};
297
	  for my $flag (qw/partial closed/) {
298
	    delete($analyse_data{'q'}->{$flag});
299
	  }
300
	} else {
301
	  # if the question was NOT partial, this is an error!
302
303
	  $a_errors++;
304
	  push @errors_msg,"ERR: "
305
	    .sprintf(__("question ID used several times for the same paper: \"%s\"")." [%s]\n",$titres{$1},$analyse_data{'etu'});
306
	}
307
      }
308
309
      # register question data
310
      $analyse_data{'titre'}=$titres{$1};
311
      $analyse_data{'qs'}->{$1}=$analyse_data{'q'};
312
    }
313
314
    # AUTOQCM[QPART] tells that we end with a question without having
315
    # given all the answers
316
317
    if (/AUTOQCM\[QPART\]/) {
318
      $analyse_data{'q'}->{'partial'}=1;
319
    }
320
321
    # AUTOQCM[FQ] tells that we have finished with the current question
322
323
    if (/AUTOQCM\[FQ\]/) {
324
      $analyse_data{'q'}->{'closed'}=1;
325
    }
326
327
    # AUTOQCM[ETU=N] tells that we begin with student number N.
328
329
    if (/AUTOQCM\[ETU=([0-9]+)\]/) {
330
      # first check the last question from preceding student is ok:
331
332
      check_question($analyse_data{'q'},$analyse_data{'etu'}.":".$analyse_data{'titre'});
333
334
      # then clear all %analyse_data to begin with this student:
335
336
      %analyse_data=('etu'=>$1,'qs'=>{});
337
    }
338
339
    # AUTOACM[NUM=N=ID] tells that question number N (internal
340
    # question number, not the question number shown on the sheet)
341
    # refers to ID (question name, string given as an argument to
342
    # question environment)
343
344
    if (/AUTOQCM\[NUM=([0-9]+)=(.+)\]/) {
345
      # stores this association (two-way)
346
347
      $titres{$1}=$2;
348
      $analyse_data{'titres'}->{$2}=1;
349
    }
350
351
    # AUTOQCM[MULT] tells that current question is a multiple question
352
353
    if (/AUTOQCM\[MULT\]/) {
354
      $analyse_data{'q'}->{'mult'}=1;
355
    }
356
357
    # AUTOQCM[INDIC] tells that current question is an indicative
358
    # question
359
360
    if (/AUTOQCM\[INDIC\]/) {
361
      $analyse_data{'q'}->{'indicative'}=1;
362
    }
363
364
    # AUTOQCM[REP=N:S] tells that answer number N is S (S can be 'B'
365
    # for 'correct' or 'M' for wrong)
366
367
    if (/AUTOQCM\[REP=([0-9]+):([BM])\]/) {
368
      my $rep="R".$1;
369
370
      if ($analyse_data{'q'}->{'closed'}) {
371
	# If current question is already closed, this is an error!
372
373
	$a_errors++;
374
	push @errors_msg,"ERR: "
375
	  .sprintf(__("An answer appears to be given outside a question environment, after question \"%s\"")." [%s]\n",
376
		   $analyse_data{'titre'},$analyse_data{'etu'});
377
      }
378
379
      if (defined($analyse_data{'q'}->{$rep})) {
380
	# if we already saw an answer with the same N, this is an error!
381
382
	$a_errors++;
383
	push @errors_msg,"ERR: "
384
	  .sprintf(__("Answer number ID used several times for the same question: %s")." [%s]\n",$1,$analyse_data{'titre'});
385
      }
386
387
      # stores the answer's status
388
      $analyse_data{'q'}->{$rep}=($2 eq 'B' ? 1 : 0);
389
    }
390
391
    # AUTOQCM[VAR:N=V] tells that variable named N has value V
392
393
    if (/AUTOQCM\[VAR:([0-9a-zA-Z.-]+)=([^\]]+)\]/) {
394
      $info_vars{$1}=$2;
395
    }
396
397
  }
398
  close(AMCLOG);
399
400
  # check that the last question from the last student is ok:
401
402
  check_question($analyse_data{'q'},$analyse_data{'etu'}.":".$analyse_data{'titre'});
403
404
  # Send error messages to the calling program through STDOUT
405
406
  flush_errors();
407
408
  debug("AMC log $amclog_file : $a_errors errors.");
409
}
410
411
# execute(%oo) launches the LaTeX engine with the right arguments, call it
412
# again if needed (for exemple when a second run is necessary to get
413
# references right), and then produces a PDF file from LaTeX output.
414
#
415
# $oo{command_opts} should be the options to be passed to latex_cmd, to
416
# build the LaTeX command to run, with all necessary arguments
417
418
my $filter_engine;
419
420
sub execute {
421
    my %oo=(@_);
422
    my $errs=0;
423
424
    prepare_filter();
425
426
    # gives the processing command to the filter
427
    $oo{command}=[latex_cmd(@{$oo{command_opts}})];
428
    $ENV{AMC_CMD}=join(' ',@{$oo{command}});
429
430
    if($filter) {
431
      if(!$filter_engine->get_filter_result('done')
432
	 || $filter_engine->get_filter_result('jobspecific')) {
433
	$errs=do_filter();
434
	$filter_engine->set_filter_result('done',1) if(!$errs);
435
      }
436
    }
437
438
    # first removes previous run's outputs
439
440
    for my $ext (qw/pdf dvi ps/) {
441
	if(-f "$jobname.$ext") {
442
	    debug "Removing old $ext";
443
	    unlink("$jobname.$ext");
444
	}
445
    }
446
447
    exit 1 if($errs);
448
449
    # the filter could have changed the latex engine, so update it
450
    $oo{command}=[latex_cmd(@{$oo{command_opts}})];
451
    $ENV{AMC_CMD}=join(' ',@{$oo{command}});
452
453
    check_engine();
454
455
    my $min_runs=1; # minimum number of runs
456
    my $max_runs=2; # maximum number of runs
457
    my $n_run=0; # number of runs so far
458
    my $rerun=0; # has to re-run?
459
    my $format=''; # output format
460
461
    do {
462
463
	$n_run++;
464
465
	# clears errors from previous run
466
467
	$a_errors=0;
468
	@latex_errors=();
469
470
	debug "%%% Compiling: pass $n_run";
471
472
	# lauches the command
473
474
	$cmd_pid=open(EXEC,"-|",@{$oo{'command'}});
475
	die "Can't exec ".join(' ',@{$oo{'command'}}) if(!$cmd_pid);
476
477
	# parses the output
478
479
	while(<EXEC>) {
480
	    # LaTeX Warning: Label(s) may have changed. Rerun to get
481
	    # cross-references right. -> has to re-run
482
483
	    $rerun=1
484
	      if(/^LaTeX Warning:.*Rerun to get cross-references right/);
485
	    $min_runs=2
486
	      if(/Warning: .*run twice/);
487
488
	    # Output written on jobname.pdf (10 pages) -> output
489
	    # format is pdf
490
491
	    $format=$1 if(/^Output written on .*\.([a-z]+) \(/);
492
493
	    # Lines beginning with '!' are errors: collect them
494
495
	    if(/^\!\s*(.*)$/) {
496
	      my $e=$1;
497
	      $e .= "..." if($e !~ /\.$/);
498
	      push @latex_errors,$e;
499
	    }
500
501
	    # Relays LaTeX log to calling program
502
503
	    print STDERR $_ if(/^.+$/);
504
	    print $_ if($latex_stdout && /^.+$/);
505
	}
506
	close(EXEC);
507
	$cmd_pid='';
508
509
    } while( (($n_run<$min_runs) || ($rerun && $n_run<$max_runs)) && ! $oo{'once'});
510
511
    # For these engines, we already know what is the output format:
512
    # override detected one
513
514
    $format='dvi' if($latex_engine eq 'latex');
515
    $format='pdf' if($latex_engine eq 'pdflatex');
516
    $format='pdf' if($latex_engine eq 'xelatex');
517
518
    print "Output format: $format\n";
519
    debug "Output format: $format\n";
520
521
    # Now converts output to PDF. Output format can be DVI or PDF. If
522
    # PDF, nothing has to be done...
523
524
    if($format eq 'dvi') {
525
	if(-f "$jobname.dvi") {
526
527
	  # default DVI->PDF engine is dvipdfmx
528
529
	  $engine_topdf='dvipdfm'
530
	    if(!$engine_topdf);
531
532
	  # if the choosend DVI->PDF engine is not present, try to get
533
	  # another one
534
535
	  if(!commande_accessible($engine_topdf)) {
536
	    debug_and_stderr
537
	      "WARNING: command $engine_topdf not available";
538
	    $engine_topdf=choose_command('dvipdfmx','dvipdfm','xdvipdfmx',
539
					 'dvipdf');
540
	  }
541
542
	  if($engine_topdf) {
543
	    # Now, convert DVI to PDF
544
545
	    debug "Converting DVI to PDF with $engine_topdf ...";
546
	    if($engine_topdf eq 'dvipdf') {
547
	      system($engine_topdf,"$jobname.dvi","$jobname.pdf");
548
	    } else {
549
	      system($engine_topdf,"-o","$jobname.pdf","$jobname.dvi");
550
	    }
551
	    debug_and_stderr "ERROR $engine_topdf: $?" if($?);
552
	  } else {
553
	    # No available DVI->PDF engine!
554
555
	    debug_and_stderr
556
	      "ERROR: I can't find dvipdf/dvipdfm/xdvipdfmx command !";
557
	  }
558
	} else {
559
	    debug "No DVI";
560
	}
561
    }
562
563
}
564
565
# do_filter() converts the source file to LaTeX format, using the
566
# right AMC::Filter::* module
567
568
sub prepare_filter {
569
  if($filter) {
570
    if(!$filter_engine) {
571
      load("AMC::Filter::$filter");
572
      $filter_engine="AMC::Filter::$filter"->new(jobname=>$jobname);
573
      $filter_engine->pre_filter($source);
574
575
      # sometimes the filter says that the source file don't need to
576
      # be changed
577
578
      set_filtered_source($source)
579
	if($filter_engine->unchanged);
580
    }
581
  } else {
582
    # Empty filter: the source is already a LaTeX file
583
    set_filtered_source($source);
584
  }
585
}
586
587
sub do_filter {
588
  my $f_base;
589
  my $v;
590
  my $d;
591
  my $n_err=0;
592
593
  if($filter) {
594
    # Loads and call appropriate filter to convert $source to
595
    # $filtered_source
596
597
    prepare_filter();
598
    $filter_engine->filter($source,$filtered_source);
599
600
    # show conversion errors
601
602
    for($filter_engine->errors()) {
603
      print "ERR: $_\n";
604
      $n_err++;
605
    }
606
607
    # sometimes the filter asks to override the LaTeX engine
608
609
    split_latex_engine($filter_engine->{'project_options'}->{'moteur_latex_b'})
610
      if($filter_engine->{'project_options'}->{'moteur_latex_b'});
611
612
  }
613
614
  return($n_err);
615
}
616
617
# give_latex_errors($context) Relay suitably formatted LaTeX errors to
618
# calling program (usualy AMC GUI). $context is the name of the
619
# document we are building.
620
621
sub give_latex_errors {
622
    my ($context)=@_;
623
    if(@latex_errors) {
624
	print "ERR: <i>"
625
	    .sprintf(__("%d errors during LaTeX compiling")." (%s)</i>\n",(1+$#latex_errors),$context);
626
	for(@latex_errors) {
627
	    print "ERR>$_\n";
628
	}
629
	exit(1);
630
    }
631
}
632
633
# transfer($orig,$dest) moves $orig to $dest, removing $dest if $orig
634
# does not exist
635
636
sub transfer {
637
    my ($orig,$dest)=@_;
638
    if(-f $orig) {
639
	debug "Moving $orig --> $dest";
640
	move($orig,$dest);
641
    } else {
642
	debug "No source: removing $dest";
643
	unlink($dest);
644
    }
645
}
646
647
# latex_cmd(%o) builds the LaTeX command and arguments to be passed to
648
# the execute command, using the engine specifications and extra
649
# options %o to pass to LaTeX: for each name=>value from %o, a LaTeX
650
# command '\def\name{value}' is passed to LaTeX. This allows to relay
651
# some options to LaTeX (number of copies, document needed for
652
# exemple).
653
654
sub latex_cmd {
655
    my (%o)=@_;
656
657
    $o{'AMCNombreCopies'}=$number_of_copies if($number_of_copies>0);
658
659
    return($latex_engine,
660
	   "--jobname=".$jobname,
661
	   @engine_args,
662
	   "\\nonstopmode"
663
	   .join('',map { "\\def\\".$_."{".$o{$_}."}"; } (keys %o) )
664
	   ." \\input{\"$f_tex\"}");
665
}
666
667
# check_engine() checks that the requeted LaTeX engine is available on
668
# the system
669
670
sub check_engine {
671
    if(!commande_accessible($latex_engine)) {
672
	print "ERR: ".sprintf(__("LaTeX command configured is not present (%s). Install it or change configuration, and then rerun."),$latex_engine)."\n";
673
	exit(1);
674
    }
675
}
676
677
# the $mode option passed to AMC-prepare contains characters that
678
# explains what is to be prepared...
679
680
my %to_do=();
681
while($mode =~ s/^[^a-z]*([a-z])(\[[a-z]*\])?//i) {
682
  $to_do{$1}=(defined($2) ? $2 : 1);
683
}
684
685
############################################################################
686
# MODE f: filter source file to LaTeX format
687
############################################################################
688
689
if($to_do{f}) {
690
  # FILTER
691
  do_filter();
692
}
693
694
############################################################################
695
# MODE s: builds the subject and a solution (with all the answers for
696
# questions, but with a different layout)
697
############################################################################
698
699
if($to_do{s}) {
700
  $to_do{s}='[sc]' if($to_do{s} eq '1');
701
702
  @output_files=($out_sujet,$out_calage,$out_corrige,$out_catalog);
703
704
    my %opts=(qw/NoWatermarkExterne 1 NoHyperRef 1/);
705
706
    $out_calage=$prefix."calage.xy" if(!$out_calage);
707
    $out_corrige=$prefix."corrige.pdf" if(!$out_corrige);
708
    $out_catalog=$prefix."catalog.pdf" if(!$out_catalog);
709
    $out_sujet=$prefix."sujet.pdf" if(!$out_sujet);
710
711
    for my $f ($out_calage,$out_corrige,$out_corrige_indiv,$out_sujet,$out_catalog) {
712
	if(-f $f) {
713
	    debug "Removing already existing file: $f";
714
	    unlink($f);
715
	}
716
    }
717
718
    # 1) SUBJECT
719
720
    execute('command_opts'=>[%opts,'SujetExterne'=>1]);
721
    analyse_amclog("$jobname.amc");
722
    give_latex_errors(__"question sheet");
723
724
    exit(1) if($a_errors>0);
725
726
    transfer("$jobname.pdf",$out_sujet);
727
    transfer("$jobname.xy",$out_calage);
728
729
  # Looks for accents problems in question IDs...
730
731
  my %qids=();
732
  my $unknown_qid=0;
733
  if(open(XYFILE,$out_calage)) {
734
    binmode(XYFILE);
735
    while(<XYFILE>) {
736
      if(!utf8::decode($_) || /\\IeC/) {
737
	if(/\\tracepos\{[^:]*:[^:]*:(.+):[^:]*\}\{([+-]?[0-9.]+[a-z]*)\}\{([+-]?[0-9.]+[a-z]*)\}(?:\{([a-zA-Z]*)\})?$/) {
738
	  $qids{$1}=1;
739
	} else {
740
	  $unknown_qid=1;
741
	}
742
      }
743
    }
744
    close(XYFILE);
745
    if(%qids) {
746
      push @errors_msg,
747
	map { "WARN: ".sprintf(__("please remove accentuated or non-standard characters from the following question ID: \"%s\""),$_)."\n" } (sort { $a cmp $b } (keys %qids));
748
    } elsif($unknown_qid) {
749
      push @errors_msg,"WARN: ".__("some question IDs seems to have accentuated or non-standard characters. This may break future processings.")."\n";
750
    }
751
  }
752
  flush_errors();
753
754
    # Relays variables to calling process
755
756
    print "Variables :\n";
757
    for my $k (keys %info_vars) {
758
	print "VAR: $k=".$info_vars{$k}."\n";
759
    }
760
761
    # 2) SOLUTION
762
763
  if($to_do{s}=~/s/) {
764
    execute('command_opts'=>[%opts,'CorrigeExterne'=>1]);
765
    transfer("$jobname.pdf",$out_corrige);
766
    give_latex_errors(__"solution");
767
  } else {
768
    debug "Solution not requested: removing $out_corrige";
769
    unlink($out_corrige);
770
  }
771
772
    # 3) CATALOG
773
774
  if($to_do{s}=~/c/) {
775
    execute('command_opts'=>[%opts,'CatalogExterne'=>1]);
776
    transfer("$jobname.pdf",$out_catalog);
777
    give_latex_errors(__"catalog");
778
  } else {
779
    debug "Catalog not requested: removing $out_catalog";
780
    unlink($out_catalog);
781
  }
782
}
783
784
############################################################################
785
# MODE k: builds individual corrected answer sheets (exactly the same
786
# sheets as for the students, but with correct answers ticked).
787
############################################################################
788
789
if($to_do{k}) {
790
791
  my $of=$out_corrige_indiv;
792
  $of=$out_corrige if(!$of && !$to_do{s});
793
  $of=$prefix."corrige.pdf" if(!$of);
794
795
  if(-f $of) {
796
    debug "Removing already existing file: $of";
797
    unlink($of);
798
  }
799
800
  @output_files=($of);
801
802
  execute('command_opts'=>[qw/NoWatermarkExterne 1 NoHyperRef 1 CorrigeIndivExterne 1/]);
803
  transfer("$jobname.pdf",$of);
804
  give_latex_errors(__"individual solution");
805
}
806
807
############################################################################
808
# MODE b: extracts the scoring strategy to the scoring database,
809
# parsing the AUTOQCM[...] messages from the LaTeX output.
810
############################################################################
811
812
if($to_do{b}) {
813
814
    print "********** Making marks scale...\n";
815
816
    my %bs=();
817
    my %titres=();
818
819
    my $quest='';
820
    my $rep='';
821
    my $outside_quest='';
822
    my $etu=0;
823
824
    my $delta=0;
825
826
    # Launches the LaTeX engine
827
828
    execute('command_opts'=>[qw/ScoringExterne 1 NoHyperRef 1/],
829
	    'once'=>1);
830
831
    open(AMCLOG,"$jobname.amc") or die "Unable to open $jobname.amc : $!";
832
833
    # Opens a connection with the database
834
835
    my $data=AMC::Data->new($data_dir);
836
    my $scoring=$data->module('scoring');
837
    my $capture=$data->module('capture');
838
839
    my $qs={};
840
    my $current_q={};
841
842
    # and parse the log...
843
844
    $scoring->begin_transaction('ScEx');
845
    annotate_source_change($capture);
846
    $scoring->clear_strategy;
847
848
    while(<AMCLOG>) {
849
	debug($_) if($_);
850
851
	# AUTOQCM[TOTAL=N] tells that the total number of sheets is
852
	# N. This will allow us to relay the progression of the
853
	# process to the calling process.
854
855
	if(/AUTOQCM\[TOTAL=([\s0-9]+)\]/) {
856
	    my $t=$1;
857
	    $t =~ s/\s//g;
858
	    if($t>0) {
859
		$delta=1/$t;
860
	    } else {
861
		print "*** TOTAL=$t ***\n";
862
	    }
863
	}
864
865
	if(/AUTOQCM\[FQ\]/) {
866
	  # end of question: register it (or update it)
867
	  $scoring->new_question($etu,$quest,
868
				 ($current_q->{'multiple'}
869
				  ? QUESTION_MULT : QUESTION_SIMPLE),
870
				 $current_q->{'indicative'},
871
				 $current_q->{'strategy'});
872
	  $qs->{$quest}=$current_q;
873
	  $outside_quest=$quest;
874
	  $quest='';
875
	  $rep='';
876
	}
877
878
	if(/AUTOQCM\[Q=([0-9]+)\]/) {
879
	  # beginning of question
880
	  $quest=$1;
881
	  $rep='';
882
	  if($qs->{$quest}) {
883
	      $current_q=$qs->{$quest};
884
	  } else {
885
	      $current_q={'multiple'=>0,
886
			  'indicative'=>0,
887
			  'strategy'=>'',
888
	      };
889
	  }
890
	}
891
892
	if(/AUTOQCM\[ETU=([0-9]+)\]/) {
893
	  # beginning of student sheet
894
	  $avance->progres($delta) if($etu ne '');
895
	  $etu=$1;
896
	  print "Sheet $etu...\n";
897
	  debug "Sheet $etu...\n";
898
	  $qs={};
899
	}
900
901
	if(/AUTOQCM\[NUM=([0-9]+)=(.+)\]/) {
902
	  # association question-number<->question-title
903
	  # $scoring->question_title($1,$2);
904
+	  $scoring->question_title($1,decode('UTF-8', $2));
905
	}
906
907
	if(/AUTOQCM\[MULT\]/) {
908
	  # this question is a multiple-style one
909
	  $current_q->{'multiple'}=1;
910
	}
911
912
	if(/AUTOQCM\[INDIC\]/) {
913
	  # this question is an indicative one
914
	  $current_q->{'indicative'}=1;
915
	}
916
917
	if(/AUTOQCM\[REP=([0-9]+):([BM])\]/) {
918
	  # answer
919
	  $rep=$1;
920
	  my $qq=$quest;
921
	  if($outside_quest && !$qq) {
922
	    $qq=$outside_quest;
923
	    debug_and_stderr "WARNING: answer outside questions for student $etu (after question $qq)";
924
	  }
925
	  $scoring->new_answer
926
	    ($etu,$qq,$rep,($2 eq 'B' ? 1 : 0),'');
927
	}
928
929
	# AUTOQCM[BR=N] tells that this student is a replicate of student N
930
931
	if(/AUTOQCM\[BR=([0-9]+)\]/) {
932
	  my $alias=$1;
933
	  $scoring->replicate($alias,$etu);
934
	  $etu=$alias;
935
	}
936
937
	if(/AUTOQCM\[B=([^\]]+)\]/) {
938
	  # scoring strategy string
939
	  if($quest) {
940
	    if($rep) {
941
	      # associated to an answer
942
	      $scoring->add_answer_strategy($etu,$quest,$rep,$1);
943
	    } else {
944
	      # associated to a question
945
	      $current_q->{'strategy'}=
946
		  ($current_q->{'strategy'}
947
		   ? $current_q->{'strategy'}.',' : '').$1;
948
	    }
949
	  } else {
950
	    # global scoring strategy, associated to a student if
951
	    # $etu>0, or to all students if $etu==0
952
	    $scoring->add_main_strategy($etu,$1);
953
	  }
954
	}
955
956
	# AUTOQCM[BDS=string] gives us the default scoring stragety
957
	# for simple questions
958
	# AUTOQCM[BDM=string] gives us the default scoring stragety
959
	# for multiple questions
960
961
	if(/AUTOQCM\[BD(S|M)=([^\]]+)\]/) {
962
	  $scoring->default_strategy(($1 eq 'S' ? QUESTION_SIMPLE : QUESTION_MULT),
963
				  $2);
964
	}
965
966
	if(/AUTOQCM\[VAR:([0-9a-zA-Z.-]+)=([^\]]+)\]/) {
967
	  # variables
968
	  my $name=$1;
969
	  my $value=$2;
970
	  $name='postcorrect_flag' if ($name eq 'postcorrect');
971
	  $scoring->variable($name,$value);
972
	}
973
    }
974
    close(AMCLOG);
975
976
    $scoring->end_transaction('ScEx');
977
}
978
979
$avance->fin();