1 | # -*- perl -*-
|
2 | #
|
3 | # Copyright (C) 2011-2022 Alexis Bienvenüe <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 warnings;
|
22 | use 5.012;
|
23 |
|
24 | package AMC::DataModule::scoring;
|
25 |
|
26 | # AMC scoring management.
|
27 |
|
28 | # This module is used to store (in a SQLite database) and handle all
|
29 | # data concerning data scoring (scoring strategies, scores and marks).
|
30 |
|
31 | # TERMINOLOGY NOTE:
|
32 | #
|
33 | # 'student' refers to the student number that is written at the top of
|
34 | # each page, in the format +<student>/<page>/<check>+
|
35 | #
|
36 | # If the questions are printed from AMC, and not photocopied, each
|
37 | # physical student has a different student number on his sheet.
|
38 | #
|
39 | # If some questions are photocopied before beeing distributed to the
|
40 | # students, several students can have the same student number. To make
|
41 | # a difference between their completed answer sheets, a 'copy' number
|
42 | # is added. 'copy' is 1 for the first student using a given student
|
43 | # number sheet, then 2, and so on.
|
44 | #
|
45 | # Hence, a completed answer sheet is identified by the (student,copy)
|
46 | # couple, and a printed sheet (and correct answers, scoring
|
47 | # strategies) is identified by the student number only.
|
48 | #
|
49 | # 'question' is a number associated by LaTeX with every different
|
50 | # question (based on the small text given as XXX in the
|
51 | # \begin{question}{XXX} or \begin{questionmult}{XXX} commands).
|
52 | #
|
53 | # 'answer' is the answer number, starting from 1 for each question,
|
54 | # before beeing shuffled.
|
55 |
|
56 | # TABLES:
|
57 | #
|
58 | # title contains the titles (argument of the \begin{question} and
|
59 | # \begin{questionmult} commands) of all the questions
|
60 | #
|
61 | # * question is the question number, as created by LaTeX and used in
|
62 | # the databases <layout>, <capture>.
|
63 | #
|
64 | # * title id the title of the question.
|
65 | #
|
66 | # default holds the default scoring strategies, as specified with the
|
67 | # \scoringDefaultM and \scoringDefaultS commands in the LaTeX source
|
68 | # file. This table contains 2 rows.
|
69 | #
|
70 | # * type is the question type, either QUESTION_SIMPLE or QUESTION_MULT
|
71 | # (these constants are defined in this module).
|
72 | #
|
73 | # * strategy is the default strategy string for this question type.
|
74 | #
|
75 | # main holds scoring strategies defined outside question/questionmult
|
76 | # environments, either outside the onecopy/examcopy data (with
|
77 | # student=-1), or inside (student=current student number).
|
78 | #
|
79 | # * student is the student number.
|
80 | #
|
81 | # * strategy is the strategy string given in the LaTeX file as an
|
82 | # argument of the \scoring command.
|
83 | #
|
84 | # question holds scoring strategies for questions.
|
85 | #
|
86 | # * student is the student number.
|
87 | #
|
88 | # * question is the question number.
|
89 | #
|
90 | # * type is the question type, either QUESTION_SIMPLE or
|
91 | # QUESTION_MULT
|
92 | #
|
93 | # * indicative is 1 if the question is indicative (the score is not
|
94 | # taken into account when computing the student mark).
|
95 | #
|
96 | # * strategy is the question scoring strategy string, given in the
|
97 | # LaTeX file inside the question/questionmult environment (but
|
98 | # before \correctchoice and \wrongchoice commands).
|
99 | #
|
100 | # answer holds scoring strategies concerning answers.
|
101 | #
|
102 | # * student is the student number.
|
103 | #
|
104 | # * question is the question number.
|
105 | #
|
106 | # * answer is the answer number, starting from 1 for each question.
|
107 | #
|
108 | # * correct is 1 if this choice is correct (use of \correctchoice).
|
109 | #
|
110 | # * strategy is the answer scoring strategy string, given in the LaTeX
|
111 | # file after the corresponding correctchoice/wrongchoice commands.
|
112 | #
|
113 | # score holds the questions scores for each student.
|
114 | #
|
115 | # * student is the student number.
|
116 | #
|
117 | # * copy is the copy number.
|
118 | #
|
119 | # * question is the question number.
|
120 | #
|
121 | # * score is the score resulting from applying the scoring strategy to
|
122 | # the student's answers.
|
123 | #
|
124 | # * why is a small string that is used to know when special cases has
|
125 | # been encountered:
|
126 | #
|
127 | # E means syntax error (several boxes ticked for a simple
|
128 | # question, or " none of the above" AND another box ticked for a
|
129 | # multiple question).
|
130 | #
|
131 | # V means that no box are ticked.
|
132 | #
|
133 | # P means that a floor has been applied.
|
134 | #
|
135 | # X means that an external score has been applied.
|
136 | #
|
137 | # * max is the question score associated to a copy where all answers
|
138 | # are correct (or 1 for indicative questions).
|
139 | #
|
140 | # external holds the question scores that are not computed by AMC, but
|
141 | # given from external data.
|
142 | #
|
143 | # * student, copy identifies the student.
|
144 | #
|
145 | # * question is the question number.
|
146 | #
|
147 | # * score is the score to be affected to this question.
|
148 | #
|
149 | # mark holds global marks of the students.
|
150 | #
|
151 | # * student is the student number.
|
152 | #
|
153 | # * copy is the copy number.
|
154 | #
|
155 | # * total is the total score (sum of the questions scores).
|
156 | #
|
157 | # * max is the total score associated to a perfect copy.
|
158 | #
|
159 | # * mark is the student mark.
|
160 | #
|
161 | # code holds the codes entered by the students (see \AMCcode).
|
162 | #
|
163 | # * student is the student number.
|
164 | #
|
165 | # * copy is the copy number.
|
166 | #
|
167 | # * code is the code name.
|
168 | #
|
169 | # * value is the code value.
|
170 | #
|
171 | # * direct is 1 if the score comes directly from a decoded zone image,
|
172 | # and 0 if it is computed while scoring.
|
173 |
|
174 | # VARIABLES:
|
175 | #
|
176 | # postcorrect_flag is 1 if the postcorrect mode is supposed to be used
|
177 | # (correct answers are not indicated in the LaTeX source, but will be
|
178 | # set from a teacher completed answer sheet).
|
179 | #
|
180 | # postcorrect_student
|
181 | # postcorrect_copy identify the sheet completed by the teacher.
|
182 | #
|
183 | # postcorrect_set_multiple (see postcorrect function)
|
184 | #
|
185 | # --- the following values are supplied in the Preferences window
|
186 | #
|
187 | # darkness_threshold and darkness_threshold_up are the parameters used
|
188 | # for determining wether a box is ticked or not.
|
189 | #
|
190 | # mark_floor is the minimum mark to be given to a student.
|
191 | #
|
192 | # mark_max is the mark to be given to a perfect completed answer
|
193 | # sheet.
|
194 | #
|
195 | # ceiling is true if AMC should put a ceiling on the students marks
|
196 | # (this can be useful if the SUF global scoring strategy is used).
|
197 | #
|
198 | # rounding is the rounding type to be used for the marks.
|
199 | #
|
200 | # granularity is the granularity for the marks rounding.
|
201 |
|
202 | use Exporter qw(import);
|
203 |
|
204 | use constant {
|
205 | QUESTION_SIMPLE => 1,
|
206 | QUESTION_MULT => 2,
|
207 |
|
208 | DIRECT_MARK => 0,
|
209 | DIRECT_NAMEFIELD => 1,
|
210 | };
|
211 |
|
212 | our @EXPORT_OK = qw(QUESTION_SIMPLE QUESTION_MULT DIRECT_MARK DIRECT_NAMEFIELD);
|
213 | our %EXPORT_TAGS = (
|
214 | question => [qw/QUESTION_SIMPLE QUESTION_MULT/],
|
215 | direct => [qw/DIRECT_MARK DIRECT_NAMEFIELD/],
|
216 | );
|
217 |
|
218 | use AMC::Basic;
|
219 | use AMC::DataModule;
|
220 | use AMC::DataModule::capture ':zone';
|
221 | use AMC::DataModule::layout ':flags';
|
222 |
|
223 | use XML::Simple;
|
224 |
|
225 | our @ISA = ("AMC::DataModule");
|
226 |
|
227 | sub version_current {
|
228 | return (3);
|
229 | }
|
230 |
|
231 | sub version_upgrade {
|
232 | my ( $self, $old_version ) = @_;
|
233 | if ( $old_version == 0 ) {
|
234 |
|
235 | # Upgrading from version 0 (empty database) to version 1 :
|
236 | # creates all the tables.
|
237 |
|
238 | debug "Creating scoring tables...";
|
239 | $self->sql_do( "CREATE TABLE IF NOT EXISTS "
|
240 | . $self->table("title")
|
241 | . " (question INTEGER, title TEXT)" );
|
242 | $self->sql_do( "CREATE TABLE IF NOT EXISTS "
|
243 | . $self->table("default")
|
244 | . " (type INTEGER, strategy TEXT)" );
|
245 | $self->sql_do( "CREATE TABLE IF NOT EXISTS "
|
246 | . $self->table("main")
|
247 | . " (student INTEGER, strategy TEXT)" );
|
248 | $self->sql_do( "CREATE TABLE IF NOT EXISTS "
|
249 | . $self->table("question")
|
250 | . " (student INTEGER, question INTEGER, type INTEGER, indicative INTEGER DEFAULT 0, strategy TEXT, PRIMARY KEY (student,question))"
|
251 | );
|
252 | $self->sql_do( "CREATE TABLE IF NOT EXISTS "
|
253 | . $self->table("answer")
|
254 | . " (student INTEGER, question INTEGER, answer INTEGER, correct INTEGER, strategy INTEGER, PRIMARY KEY (student,question,answer))"
|
255 | );
|
256 | $self->sql_do( "CREATE TABLE IF NOT EXISTS "
|
257 | . $self->table("alias")
|
258 | . " (student INTEGER,see INTEGER)" );
|
259 |
|
260 | $self->sql_do( "CREATE TABLE IF NOT EXISTS "
|
261 | . $self->table("score")
|
262 | . " (student INTEGER, copy INTEGER, question INTEGER, score REAL, why TEXT, max REAL, PRIMARY KEY (student,copy,question))"
|
263 | );
|
264 | $self->sql_do( "CREATE TABLE IF NOT EXISTS "
|
265 | . $self->table("mark")
|
266 | . " (student INTEGER, copy INTEGER, total REAL, max REAL, mark REAL, PRIMARY KEY (student,copy))"
|
267 | );
|
268 | $self->sql_do( "CREATE TABLE IF NOT EXISTS "
|
269 | . $self->table("code")
|
270 | . " (student INTEGER, copy INTEGER, code TEXT, value TEXT, direct INTEGER NOT NULL DEFAULT 0, PRIMARY KEY (student,copy,code))"
|
271 | );
|
272 |
|
273 | $self->statement('NEWdefault')->execute( QUESTION_SIMPLE, "" );
|
274 | $self->statement('NEWdefault')->execute( QUESTION_MULT, "" );
|
275 |
|
276 | $self->populate_from_xml;
|
277 |
|
278 | return (2);
|
279 | } elsif ( $old_version == 1 ) {
|
280 | $self->sql_do( "ALTER TABLE "
|
281 | . $self->table("code")
|
282 | . " ADD COLUMN direct INTEGER NOT NULL DEFAULT 0" );
|
283 | return (2);
|
284 | } elsif ( $old_version == 2) {
|
285 | $self->sql_do( "CREATE TABLE IF NOT EXISTS "
|
286 | . $self->table("external")
|
287 | . " (student INTEGER, copy INTEGER, question INTEGER, score REAL, PRIMARY KEY (student,copy,question))"
|
288 | );
|
289 | return (3);
|
290 | }
|
291 | return ('');
|
292 | }
|
293 |
|
294 | # populate_from_xml read the old format XML files (if any) and inserts
|
295 | # them in the new SQLite database
|
296 |
|
297 | sub populate_from_xml {
|
298 | my ($self) = @_;
|
299 | my $scoring_file = $self->{data}->directory;
|
300 | $scoring_file =~ s:/[^/]+/?$:/bareme.xml:;
|
301 | return if ( !-f $scoring_file );
|
302 |
|
303 | $self->progression( 'begin',
|
304 | __ "Fetching scoring data from old format XML files..." );
|
305 |
|
306 | my $xml = XMLin( $scoring_file, ForceArray => 1, KeyAttr => ['id'] );
|
307 |
|
308 | $self->main_strategy( -1, $xml->{main} );
|
309 | my @s = ( keys %{ $xml->{etudiant} } );
|
310 | my $frac = 0;
|
311 |
|
312 | for my $student (@s) {
|
313 | my $s = $xml->{etudiant}->{$student};
|
314 | if ( $student eq 'defaut' ) {
|
315 | $self->default_strategy( QUESTION_SIMPLE,
|
316 | $s->{question}->{S}->{bareme} );
|
317 | $self->default_strategy( QUESTION_MULT,
|
318 | $s->{question}->{M}->{bareme} );
|
319 | } elsif ( $student =~ /^[0-9]+$/ ) {
|
320 | $self->main_strategy( $student, $s->{main} );
|
321 | for my $question ( keys %{ $s->{question} } ) {
|
322 | if ( $question =~ /^[0-9]+$/ ) {
|
323 | my $q = $s->{question}->{$question};
|
324 | $self->question_title( $question, $q->{titre} );
|
325 | $self->new_question(
|
326 | $student,
|
327 | $question,
|
328 | ( $q->{multiple} ? QUESTION_MULT : QUESTION_SIMPLE ),
|
329 | ( $q->{indicative} ? 1 : 0 ),
|
330 | $q->{bareme}
|
331 | );
|
332 |
|
333 | if ( $q->{reponse} ) {
|
334 | if ( ref( $q->{reponse} ) eq 'HASH' ) {
|
335 | for my $answer ( keys %{ $q->{reponse} } ) {
|
336 | my $a = $q->{reponse}->{$answer};
|
337 | $self->new_answer(
|
338 | $student, $question, $answer,
|
339 | $a->{bonne}, $a->{bareme}
|
340 | );
|
341 | }
|
342 | } else {
|
343 | debug
|
344 | "WARNING: reponse is not a HASHREF for S=$student Q=$question";
|
345 | }
|
346 | }
|
347 | } else {
|
348 | debug "Unknown question id: <$question>";
|
349 | }
|
350 | }
|
351 | } else {
|
352 | debug "Unknown student id: <$student>";
|
353 | }
|
354 | $frac++;
|
355 | $self->progression( 'fraction', 0.5 * $frac / ( $#s + 1 ) );
|
356 | }
|
357 |
|
358 | $scoring_file = $self->{data}->directory;
|
359 | $scoring_file =~ s:/[^/]+/?$:/notes.xml:;
|
360 | return if ( !-f $scoring_file );
|
361 |
|
362 | $frac = 0;
|
363 |
|
364 | $xml = XMLin( $scoring_file, ForceArray => 1, KeyAttr => ['id'] );
|
365 |
|
366 | $self->variable( 'darkness_threshold', $xml->{seuil} );
|
367 | $self->variable( 'darkness_threshold_up', 1.0 );
|
368 | $self->variable( 'mark_floor', $xml->{notemin} );
|
369 | $self->variable( 'mark_max', $xml->{notemax} );
|
370 | $self->variable( 'ceiling', $xml->{plafond} );
|
371 | $self->variable( 'rounding', $xml->{arrondi} );
|
372 | $self->variable( 'granularity', $xml->{grain} );
|
373 |
|
374 | @s = ( keys %{ $xml->{copie} } );
|
375 | for my $student (@s) {
|
376 | my $s = $xml->{copie}->{$student};
|
377 |
|
378 | if ( $student =~ /^(moyenne|max)$/ ) {
|
379 | debug "Skipping student <$student>";
|
380 | } elsif ( $student =~ /^[0-9]+$/ ) {
|
381 | $self->statement('NEWMark')
|
382 | ->execute( $student, 0,
|
383 | map { $s->{total}->[0]->{$_} } (qw/total max note/) );
|
384 |
|
385 | for my $title ( keys %{ $s->{question} } ) {
|
386 | my $q = $s->{question}->{$title};
|
387 | my $question = $self->question_number($title);
|
388 | $self->statement('NEWScore')
|
389 | ->execute( $student, 0, $question, $q->{note}, $q->{max},
|
390 | $q->{raison} );
|
391 | }
|
392 |
|
393 | for my $code ( keys %{ $s->{code} } ) {
|
394 | $self->statement('NEWCode')
|
395 | ->execute( $student, 0, $code, $s->{code}->{$code}->{content},
|
396 | DIRECT_MARK );
|
397 | }
|
398 | } else {
|
399 | debug "WARNING: Unknown student <$student> importing XML marks";
|
400 | }
|
401 | $frac++;
|
402 | $self->progression( 'fraction', 0.5 * ( 1 + $frac / ( $#s + 1 ) ) );
|
403 | }
|
404 |
|
405 | $self->progression('end');
|
406 | }
|
407 |
|
408 | # defines all the SQL statements that will be used
|
409 |
|
410 | sub define_statements {
|
411 | my ($self) = @_;
|
412 | my $t_answer = $self->table("answer");
|
413 | my $t_default = $self->table("default");
|
414 | my $t_zone = $self->table( "zone", "capture" );
|
415 | $self->{statements} = {
|
416 | NEWdefault =>
|
417 | { sql => "INSERT INTO $t_default" . " (type,strategy) VALUES (?,?)" },
|
418 | getDefault =>
|
419 | { sql => "SELECT strategy FROM $t_default" . " WHERE type=?" },
|
420 | setDefault =>
|
421 | { sql => "UPDATE $t_default" . " SET strategy=? WHERE type=?" },
|
422 | noDefault => { sql => "UPDATE $t_default" . " SET strategy=''" },
|
423 | NEWMain => {
|
424 | sql => "INSERT INTO "
|
425 | . $self->table("main")
|
426 | . " (student,strategy) VALUES (?,?)"
|
427 | },
|
428 | getMain => {
|
429 | sql => "SELECT strategy FROM "
|
430 | . $self->table("main")
|
431 | . " WHERE student=?"
|
432 | },
|
433 | getAllMain => {
|
434 | sql => "SELECT strategy FROM "
|
435 | . $self->table("main")
|
436 | . " WHERE student=? OR student=-1 OR student=0 ORDER BY student"
|
437 | },
|
438 | setMain => {
|
439 | sql => "UPDATE "
|
440 | . $self->table("main")
|
441 | . " SET strategy=? WHERE student=?"
|
442 | },
|
443 | NEWTitle => {
|
444 | sql => "INSERT INTO "
|
445 | . $self->table("title")
|
446 | . " (question,title) VALUES (?,?)"
|
447 | },
|
448 | getTitle => {
|
449 | sql => "SELECT title FROM "
|
450 | . $self->table("title")
|
451 | . " WHERE question=?"
|
452 | },
|
453 | getQNumber => {
|
454 | sql => "SELECT question FROM "
|
455 | . $self->table("title")
|
456 | . " WHERE title=?"
|
457 | },
|
458 | getQLike => {
|
459 | sql => "SELECT title FROM "
|
460 | . $self->table("title")
|
461 | . " WHERE title LIKE ?"
|
462 | },
|
463 | setTitle => {
|
464 | sql => "UPDATE "
|
465 | . $self->table("title")
|
466 | . " SET title=? WHERE question=?"
|
467 | },
|
468 | NEWQuestion => {
|
469 | sql => "INSERT OR REPLACE INTO "
|
470 | . $self->table("question")
|
471 | . " (student,question,type,indicative,strategy)"
|
472 | . " VALUES (?,?,?,?,?)"
|
473 | },
|
474 | NEWAnswer => {
|
475 | sql => "INSERT OR REPLACE INTO "
|
476 | . $self->table("answer")
|
477 | . " (student,question,answer,correct,strategy)"
|
478 | . " VALUES (?,?,?,?,?)"
|
479 | },
|
480 | setAnswerStrat => {
|
481 | sql => "UPDATE "
|
482 | . $self->table("answer")
|
483 | . " SET strategy=? WHERE student=? AND question=? AND answer=?"
|
484 | },
|
485 | addAnswerStrat => {
|
486 | sql => "UPDATE "
|
487 | . $self->table("answer")
|
488 | . " SET strategy=strategy||? WHERE student=? AND question=? AND answer=?"
|
489 | },
|
490 | NEWAlias => {
|
491 | sql => "INSERT INTO "
|
492 | . $self->table("alias")
|
493 | . " (student,see) VALUES (?,?)"
|
494 | },
|
495 | getAlias => {
|
496 | sql => "SELECT see FROM "
|
497 | . $self->table("alias")
|
498 | . " WHERE student=?"
|
499 | },
|
500 | postCorrectNew => {
|
501 | sql => "CREATE TEMPORARY TABLE IF NOT EXISTS"
|
502 | . " pc_temp (q INTEGER, a INTEGER, c REAL, PRIMARY KEY(q,a))"
|
503 | },
|
504 | postCorrectClr => { sql => "DELETE FROM pc_temp" },
|
505 | postCorrectPop => {
|
506 | sql => "INSERT INTO pc_temp (q,a,c) "
|
507 | . " SELECT id_a,id_b,CASE"
|
508 | . " WHEN manual >= 0 THEN manual"
|
509 | . " WHEN total<=0 THEN -1"
|
510 | . " WHEN black >= ? * total AND black <= ? * total THEN 1"
|
511 | . " ELSE 0" . " END"
|
512 | . " FROM "
|
513 | . $self->table( "zone", "capture" )
|
514 | . " WHERE capture_zone.student=? AND capture_zone.copy=? AND capture_zone.type=?"
|
515 | },
|
516 | postCorrectMul => {
|
517 | sql => "UPDATE "
|
518 | . $self->table("question")
|
519 | . " SET type=CASE"
|
520 | . " WHEN (SELECT sum(c) FROM pc_temp"
|
521 | . " WHERE q=question)>1"
|
522 | . " THEN ?"
|
523 | . " ELSE ?" . " END"
|
524 | },
|
525 | postCorrectSet => {
|
526 | sql => "UPDATE "
|
527 | . $self->table("answer")
|
528 | . " SET correct=(SELECT c FROM pc_temp"
|
529 | . " WHERE q=question AND a=answer)"
|
530 | },
|
531 | NEWScore => {
|
532 | sql => "INSERT INTO "
|
533 | . $self->table("score")
|
534 | . " (student,copy,question,score,max,why)"
|
535 | . " VALUES (?,?,?,?,?,?)"
|
536 | },
|
537 | cancelScore => {
|
538 | sql => "UPDATE "
|
539 | . $self->table("score")
|
540 | . " SET why=? WHERE student=? AND copy=? AND question=?"
|
541 | },
|
542 | NEWMark => {
|
543 | sql => "INSERT INTO "
|
544 | . $self->table("mark")
|
545 | . " (student,copy,total,max,mark)"
|
546 | . " VALUES (?,?,?,?,?)"
|
547 | },
|
548 | NEWCode => {
|
549 | sql => "INSERT OR REPLACE INTO "
|
550 | . $self->table("code")
|
551 | . " (student,copy,code,value,direct)"
|
552 | . " VALUES (?,?,?,?,?)"
|
553 | },
|
554 |
|
555 | studentMark => {
|
556 | sql => "SELECT * FROM "
|
557 | . $self->table("mark")
|
558 | . " WHERE student=? AND copy=?"
|
559 | },
|
560 | marks => { sql => "SELECT * FROM " . $self->table("mark") },
|
561 | marksCount => { sql => "SELECT COUNT(*) FROM " . $self->table("mark") },
|
562 | codes => {
|
563 | sql => "SELECT code FROM "
|
564 | . $self->table("code")
|
565 | . " GROUP BY code ORDER BY code"
|
566 | },
|
567 | qStrat => {
|
568 | sql => "SELECT strategy FROM "
|
569 | . $self->table("question")
|
570 | . " WHERE student=? AND question=?"
|
571 | },
|
572 | aStrat => {
|
573 | sql => "SELECT strategy FROM "
|
574 | . $self->table("answer")
|
575 | . " WHERE student=? AND question=? AND answer=?"
|
576 | },
|
577 | answers => {
|
578 | sql => "SELECT answer FROM "
|
579 | . $self->table("answer")
|
580 | . " WHERE student=? AND question=?"
|
581 | . " ORDER BY answer"
|
582 | },
|
583 | studentQuestions => {
|
584 | sql => "SELECT question FROM "
|
585 | . $self->table("question")
|
586 | . " WHERE student=?"
|
587 | },
|
588 | questions => {
|
589 | sql => "SELECT question,title FROM "
|
590 | . $self->table("title")
|
591 | . " ORDER BY title"
|
592 | },
|
593 | qMaxMax => {
|
594 | sql => "SELECT MAX(max) FROM "
|
595 | . $self->table("score")
|
596 | . " WHERE question=?"
|
597 | },
|
598 | correct => {
|
599 | sql => "SELECT correct FROM "
|
600 | . $self->table("answer")
|
601 | . " WHERE student=? AND question=? AND answer=?"
|
602 | },
|
603 | correctChars => {
|
604 | sql => "SELECT char FROM "
|
605 | . " (SELECT answer FROM "
|
606 | . $self->table("answer")
|
607 | . " WHERE student=? AND question=? AND correct>0) AS correct,"
|
608 | . " (SELECT answer,char FROM "
|
609 | . $self->table( "box", "layout" )
|
610 | . " WHERE student=? AND question=? AND role=?) AS char"
|
611 | . " ON correct.answer=char.answer ORDER BY correct.answer"
|
612 | },
|
613 | correctForAll => {
|
614 | sql => "SELECT question,answer,"
|
615 | . " MIN(correct) AS correct_min,"
|
616 | . " MAX(correct) AS correct_max "
|
617 | . " FROM "
|
618 | . $self->table("answer")
|
619 | . " GROUP BY question,answer"
|
620 | },
|
621 | multiple => {
|
622 | sql => "SELECT type FROM "
|
623 | . $self->table("question")
|
624 | . " WHERE student=? AND question=?"
|
625 | },
|
626 | indicative => {
|
627 | sql => "SELECT indicative FROM "
|
628 | . $self->table("question")
|
629 | . " WHERE student=? AND question=?"
|
630 | },
|
631 | numQIndic => {
|
632 | sql => "SELECT COUNT(*) FROM"
|
633 | . " ( SELECT question FROM "
|
634 | . $self->table("question")
|
635 | . " WHERE indicatve=? GROUP BY question)"
|
636 | },
|
637 | oneIndic => {
|
638 | sql => "SELECT COUNT(*) FROM "
|
639 | . $self->table("question")
|
640 | . " WHERE question=? AND indicative=?"
|
641 | },
|
642 | getScore => {
|
643 | sql => "SELECT score FROM "
|
644 | . $self->table("score")
|
645 | . " WHERE student=? AND copy=? AND question=?"
|
646 | },
|
647 | getScoreC => {
|
648 | sql => "SELECT score,max,why FROM "
|
649 | . $self->table("score")
|
650 | . " WHERE student=? AND copy=? AND question=?"
|
651 | },
|
652 | getCode => {
|
653 | sql => "SELECT value FROM "
|
654 | . $self->table("code")
|
655 | . " WHERE student=? AND copy=? AND code=?"
|
656 | },
|
657 | multicodeValues => {
|
658 | sql => "SELECT student,copy,code,value FROM "
|
659 | . $self->table("code")
|
660 | . " WHERE code LIKE ?"
|
661 | },
|
662 | codesCounts => {
|
663 | sql => "SELECT student,copy,value,COUNT(*) as nb"
|
664 | . " FROM "
|
665 | . $self->table("code")
|
666 | . " WHERE code=? GROUP BY value"
|
667 | },
|
668 | preAssocCounts => {
|
669 | sql => "SELECT m.student,m.copy,l.id AS value,COUNT(*) AS nb"
|
670 | . " FROM "
|
671 | . $self->table("mark") . " AS m"
|
672 | . " , "
|
673 | . $self->table( "association", "layout" ) . " AS l"
|
674 | . " ON m.student=l.student AND m.copy=0"
|
675 | . " GROUP BY l.id"
|
676 | },
|
677 |
|
678 | avgMark => {
|
679 | sql => "SELECT AVG(mark) FROM "
|
680 | . $self->table("mark")
|
681 | . " WHERE NOT (student=? AND copy=?)"
|
682 | },
|
683 | avgQuest => {
|
684 | sql => "SELECT CASE"
|
685 | . " WHEN SUM(max)>0 THEN 100*SUM(score)/SUM(max)"
|
686 | . " ELSE '-' END"
|
687 | . " FROM "
|
688 | . $self->table("score")
|
689 | . " WHERE question=?"
|
690 | . " AND NOT (student=? AND copy=?)"
|
691 | },
|
692 | studentAnswersBase => {
|
693 | sql => "SELECT question,answer"
|
694 | . ",correct,strategy"
|
695 | . ",(SELECT CASE"
|
696 | . " WHEN manual >= 0 THEN manual"
|
697 | . " WHEN total<=0 THEN -1"
|
698 | . " WHEN black >= ? * total AND black <= ? * total THEN 1"
|
699 | . " ELSE 0"
|
700 | . " END FROM $t_zone"
|
701 | . " WHERE $t_zone.student=? AND $t_zone.copy=? AND $t_zone.type=?"
|
702 | . " AND $t_zone.id_a=$t_answer.question AND $t_zone.id_b=$t_answer.answer"
|
703 | . " ) AS ticked"
|
704 | . " FROM "
|
705 | . $self->table("answer")
|
706 | . " WHERE student=?"
|
707 | },
|
708 | 'studentSkillLevel'=>
|
709 | {'sql'=>"SELECT SUBSTR(t.title, 1, INSTR(t.title, ':')-1) AS skill, SUM(s.score)/SUM(s.max)"
|
710 | ." FROM ".$self->table("title"). " t"
|
711 | ." INNER JOIN ".$self->table("score")." s"
|
712 | ." ON s.question=t.question"
|
713 | ." WHERE t.title LIKE '%:%' AND s.student=? AND s.copy=?"
|
714 | ." GROUP BY s.copy, s.student, skill"},
|
715 | studentQuestionsBase => {
|
716 | sql => "SELECT q.question,q.type,q.indicative,q.strategy,t.title"
|
717 | . ",d.strategy AS default_strategy"
|
718 | . " FROM "
|
719 | . $self->table("question") . " q"
|
720 | . " LEFT OUTER JOIN "
|
721 | . $self->table("default") . " d"
|
722 | . " ON q.type=d.type"
|
723 | . " LEFT OUTER JOIN "
|
724 | . $self->table("title") . " t"
|
725 | . " ON q.question=t.question"
|
726 | . " WHERE student=?"
|
727 | },
|
728 | deleteScores => {
|
729 | sql => "DELETE FROM "
|
730 | . $self->table('score')
|
731 | . " WHERE student=? AND copy=?"
|
732 | },
|
733 | deleteMarks => {
|
734 | sql => "DELETE FROM "
|
735 | . $self->table('mark')
|
736 | . " WHERE student=? AND copy=?"
|
737 | },
|
738 | deleteCodes => {
|
739 | sql => "DELETE FROM "
|
740 | . $self->table('code')
|
741 | . " WHERE student=? AND copy=?"
|
742 | },
|
743 | pagesWhy => {
|
744 | sql =>
|
745 | "SELECT s.student,s.copy,GROUP_CONCAT(s.why) as why,b.page FROM "
|
746 | . $self->table('score') . " s"
|
747 | . " JOIN "
|
748 | . " ( SELECT student,page,question FROM "
|
749 | . $self->table( "box", "layout" )
|
750 | . " WHERE role=?"
|
751 | . " GROUP BY student,page,question )" . " b"
|
752 | . " ON s.student=b.student AND s.question=b.question"
|
753 | . " GROUP BY s.student,b.page,s.copy"
|
754 | },
|
755 | clearDirect =>
|
756 | { sql => "DELETE FROM " . $self->table("code") . " WHERE direct=?" },
|
757 |
|
758 | setExternal => {
|
759 | sql => "INSERT OR REPLACE INTO "
|
760 | . $self->table("external")
|
761 | . " (student,copy,question,score) VALUES (?,?,?,?)"
|
762 | },
|
763 | getExternal => {
|
764 | sql => "SELECT score FROM "
|
765 | . $self->table("external")
|
766 | . " WHERE student=? AND copy=? AND question=?"
|
767 | },
|
768 | deleteExternal => {
|
769 | sql => "DELETE FROM "
|
770 | . $self->table("external")
|
771 | },
|
772 | nExternal => {
|
773 | sql => "SELECT count(*) as n,count(DISTINCT student) as ns"
|
774 | . " FROM ".$self->table("external")
|
775 | },
|
776 | QnAnswers => {
|
777 | sql => "SELECT a.question, t.title, MAX(a.answer) as nanswers"
|
778 | . " FROM ".$self->table("answer")." AS a"
|
779 | . " ,".$self->table("title")." AS t"
|
780 | . " WHERE a.question=t.question"
|
781 | . " GROUP BY a.question"
|
782 | },
|
783 | QfirstStudent => {
|
784 | sql => "SELECT MIN(student)"
|
785 | . " FROM ".$self->table("question")
|
786 | . " WHERE question=?"
|
787 | },
|
788 | Qall => {
|
789 | sql => "SELECT type,indicative,strategy"
|
790 | . " FROM ".$self->table("question")
|
791 | . " WHERE student=? AND question=?"
|
792 | },
|
793 | Ainfo => {
|
794 | sql => "SELECT answer,correct,strategy"
|
795 | . " FROM ".$self->table("answer")
|
796 | . " WHERE student=? AND question=?"
|
797 | . " ORDER BY answer"
|
798 | },
|
799 | };
|
800 | }
|
801 |
|
802 | # page_why() returns a list of items like
|
803 | # {student=>1,copy=>0,page=>1,why=>',V,E,,'}
|
804 | # that collects all 'why' attributes for questions that are on each page.
|
805 |
|
806 | sub pages_why {
|
807 | my ($self) = @_;
|
808 | return (
|
809 | @{
|
810 | $self->dbh->selectall_arrayref(
|
811 | $self->statement('pagesWhy'), { Slice => {} },
|
812 | BOX_ROLE_ANSWER
|
813 | )
|
814 | }
|
815 | );
|
816 | }
|
817 |
|
818 | # default_strategy($type) returns the default scoring strategy string
|
819 | # to be used for questions with type $type (QUESTION_SIMPLE or
|
820 | # QUESTION_MULT).
|
821 | #
|
822 | # default_strategy($type,$strategy) sets the default strategy string
|
823 | # for questions with type $type.
|
824 |
|
825 | sub default_strategy {
|
826 | my ( $self, $type, $strategy ) = @_;
|
827 | if ( defined($strategy) ) {
|
828 | $self->statement('setDefault')->execute( $strategy, $type );
|
829 | } else {
|
830 | return ( $self->sql_single( $self->statement('getDefault'), $type ) );
|
831 | }
|
832 | }
|
833 |
|
834 | # main_strategy($student) returns the main scoring strategy string for
|
835 | # student $student. If $student<=0 (-1 in the database), this refers
|
836 | # to the argument of the \scoring command used outside the
|
837 | # onecopy/examcopy loop. If $student>0, this refers to the argument of
|
838 | # the \scoring command used inside the onecopy/examcopy loop, but
|
839 | # outside question/questionmult environments.
|
840 | #
|
841 | # main_strategy($student,$strategy) sets the main scoring strategy
|
842 | # string.
|
843 |
|
844 | sub main_strategy {
|
845 | my ( $self, $student, $strategy ) = @_;
|
846 | $student = -1 if ( $student <= 0 );
|
847 | if ( defined($strategy) ) {
|
848 | if ( defined( $self->main_strategy($student) ) ) {
|
849 | $self->statement('setMain')->execute( $strategy, $student );
|
850 | } else {
|
851 | $self->statement('NEWMain')->execute( $student, $strategy );
|
852 | }
|
853 | } else {
|
854 | return ( $self->sql_single( $self->statement('getMain'), $student ) );
|
855 | }
|
856 | }
|
857 |
|
858 | #add_main_strategy($student,$strategy) adds the strategy string at the
|
859 | #end of the student's main strategy string.
|
860 |
|
861 | sub add_main_strategy {
|
862 | my ( $self, $student, $strategy ) = @_;
|
863 | $student = -1 if ( $student <= 0 );
|
864 | my $old = $self->main_strategy($student);
|
865 | if ( defined($old) ) {
|
866 | $self->statement('setMain')
|
867 | ->execute( $old . ',' . $strategy, $student );
|
868 | } else {
|
869 | $self->statement('NEWMain')->execute( $student, $strategy );
|
870 | }
|
871 | }
|
872 |
|
873 | # main_strategy_all($student) returns a concatenation of the the main
|
874 | # strategies for student=-1, student=0 and student=$student.
|
875 |
|
876 | sub main_strategy_all {
|
877 | my ( $self, $student ) = @_;
|
878 | return (
|
879 | join(
|
880 | ',', $self->sql_list( $self->statement('getAllMain'), $student )
|
881 | )
|
882 | );
|
883 | }
|
884 |
|
885 | # new_question($student,$question,$type,$indicative,$strategy) adds a
|
886 | # question in the database, giving its characteristics. If the
|
887 | # question already exists, it is updated with no error.
|
888 |
|
889 | sub new_question {
|
890 | my ( $self, $student, $question, $type, $indicative, $strategy ) = @_;
|
891 | $self->statement('NEWQuestion')
|
892 | ->execute( $student, $question, $type, $indicative, $strategy );
|
893 | }
|
894 |
|
895 | # question_strategy($student,$question) returns the scoring strategy
|
896 | # string for a particlar question: argument of the \scoring command
|
897 | # used inside a question/questionmult environment, before the
|
898 | # \correctchoice and \wrongchoice commands.
|
899 |
|
900 | sub question_strategy {
|
901 | my ( $self, $student, $question ) = @_;
|
902 | return (
|
903 | $self->sql_single( $self->statement('qStrat'), $student, $question ) );
|
904 | }
|
905 |
|
906 | # new_answer($student,$question,$answer,$correct,$strategy) adds an
|
907 | # answer in the database, giving its characteristics. If the answer
|
908 | # already exists, it is updated with no error.
|
909 |
|
910 | sub new_answer {
|
911 | my ( $self, $student, $question, $answer, $correct, $strategy ) = @_;
|
912 | $self->statement('NEWAnswer')
|
913 | ->execute( $student, $question, $answer, $correct, $strategy );
|
914 | }
|
915 |
|
916 | # answer_strategy($student,$question,$answer) returns the scoring
|
917 | # strategy string for a particular answer: argument of the \scoring
|
918 | # command used after \correctchoice and \wrongchoice commands.
|
919 |
|
920 | sub answer_strategy {
|
921 | my ( $self, $student, $question, $answer ) = @_;
|
922 | return (
|
923 | $self->sql_single(
|
924 | $self->statement('aStrat'),
|
925 | $student, $question, $answer
|
926 | )
|
927 | );
|
928 | }
|
929 |
|
930 | # answers($student,$question) returns an ordered list of answers
|
931 | # numbers for a particular question. Answer number 0, placed at the
|
932 | # end, corresponds to the answer "None of the above", when present.
|
933 |
|
934 | sub answers {
|
935 | my ( $self, $student, $question ) = @_;
|
936 | my @a = $self->sql_list( $self->statement('answers'), $student, $question );
|
937 | if ( $a[0] == 0 ) {
|
938 | shift @a;
|
939 | push @a, 0;
|
940 | }
|
941 | return (@a);
|
942 | }
|
943 |
|
944 | # correct_answer($student,$question,$answer) returns 1 if the
|
945 | # corresponding box has to be ticked (the answer is a correct one),
|
946 | # and 0 if not.
|
947 |
|
948 | sub correct_answer {
|
949 | my ( $self, $student, $question, $answer ) = @_;
|
950 | return (
|
951 | $self->sql_single(
|
952 | $self->statement('correct'),
|
953 | $student, $question, $answer
|
954 | )
|
955 | );
|
956 | }
|
957 |
|
958 | # correct_chars($student,$question) returns the list of the chars
|
959 | # written inside (or beside) the boxes corresponding to correct
|
960 | # answers for a particular question
|
961 |
|
962 | sub correct_chars {
|
963 | my ( $self, $student, $question ) = @_;
|
964 | $self->{data}->require_module('layout');
|
965 | return (
|
966 | $self->sql_list(
|
967 | $self->statement('correctChars'), $student,
|
968 | $question, $student,
|
969 | $question, BOX_ROLE_ANSWER
|
970 | )
|
971 | );
|
972 | }
|
973 |
|
974 | # Same as correct_chars, but paste the chars if they all exist, and
|
975 | # return undef otherwise
|
976 |
|
977 | sub correct_chars_pasted {
|
978 | my ( $self, @args ) = @_;
|
979 | my @c = $self->correct_chars(@args);
|
980 | if ( grep { !defined($_) } @c ) {
|
981 | return (undef);
|
982 | } else {
|
983 | return ( join( "", @c ) );
|
984 | }
|
985 | }
|
986 |
|
987 | # correct_for_all() returns a reference to an array like
|
988 | #
|
989 | # [{question=>1,answer=>1,correct_min=>0,correct_max=>0},
|
990 | # {question=>1,answer=>2,correct_min=>1,correct_max=>1},
|
991 | # ]
|
992 | #
|
993 | # This gives, for each question/answer, the minumum and maximum of the
|
994 | # <correct> column for all students. Usualy, minimum and maximum are
|
995 | # equal because the answer is either correct for all students either
|
996 | # not correct for all students, but one can also encounter
|
997 | # correct_min=0 and correct_max=1, in situations where the answers are
|
998 | # not the same for all students (for example for questions with random
|
999 | # numerical values).
|
1000 |
|
1001 | sub correct_for_all {
|
1002 | my ( $self, $question, $answer ) = @_;
|
1003 | return (
|
1004 | $self->dbh->selectall_arrayref(
|
1005 | $self->statement('correctForAll'),
|
1006 | { Slice => {} }
|
1007 | )
|
1008 | );
|
1009 | }
|
1010 |
|
1011 | # multiple($student,$question) returns 1 if the corresponding
|
1012 | # question is multiple (type=QUESTION_MULT), and 0 if not.
|
1013 |
|
1014 | sub multiple {
|
1015 | my ( $self, $student, $question ) = @_;
|
1016 | return (
|
1017 | $self->sql_single( $self->statement('multiple'), $student, $question )
|
1018 | == QUESTION_MULT );
|
1019 | }
|
1020 |
|
1021 | # correct_answer($student,$question) returns 1 if the corresponding
|
1022 | # question is indicative (use of \QuestionIndicative), and 0 if not.
|
1023 |
|
1024 | sub indicative {
|
1025 | my ( $self, $student, $question ) = @_;
|
1026 | return (
|
1027 | $self->sql_single(
|
1028 | $self->statement('indicative'), $student, $question
|
1029 | )
|
1030 | );
|
1031 | }
|
1032 |
|
1033 | # one_indicative($question,$indic) returns the number of students for
|
1034 | # which the question has indicative=$indic. In fact, a single question
|
1035 | # SHOULD be indicative for all students, or for none...
|
1036 |
|
1037 | sub one_indicative {
|
1038 | my ( $self, $question, $indic ) = @_;
|
1039 | $indic = 1 if ( !defined($indic) );
|
1040 | return (
|
1041 | $self->sql_single( $self->statement('oneIndic'), $question, $indic ) );
|
1042 | }
|
1043 |
|
1044 | # num_questions_indic($i) returns the number of questions that have
|
1045 | # indicative=$i ($i is 0 or 1).
|
1046 |
|
1047 | sub num_questions_indic {
|
1048 | my ( $self, $indicative ) = @_;
|
1049 | return ( $self->sql_single( $self->statement('numQIndic'), $indicative ) );
|
1050 | }
|
1051 |
|
1052 | # question_title($question) returns a question title.
|
1053 | #
|
1054 | # question_title($question,$title) sets a question title.
|
1055 |
|
1056 | sub question_title {
|
1057 | my ( $self, $question, $title ) = @_;
|
1058 | if ( defined($title) ) {
|
1059 | if ( defined( $self->question_title($question) ) ) {
|
1060 | $self->statement('setTitle')->execute( $title, $question );
|
1061 | } else {
|
1062 | $self->statement('NEWTitle')->execute( $question, $title );
|
1063 | }
|
1064 | } else {
|
1065 | return ( $self->sql_single( $self->statement('getTitle'), $question ) );
|
1066 | }
|
1067 | }
|
1068 |
|
1069 | # question_number($title) returns the question number corresponding to
|
1070 | # the given title.
|
1071 |
|
1072 | sub question_number {
|
1073 | my ( $self, $title ) = @_;
|
1074 | return ( $self->sql_single( $self->statement('getQNumber'), $title ) );
|
1075 | }
|
1076 |
|
1077 | # multicode_registered($code_base) returns TRUE if a multicode is
|
1078 | # registered in curent scoring.
|
1079 |
|
1080 | sub multicode_registered {
|
1081 | my ( $self, $code_base, $code_digit_pattern ) = @_;
|
1082 | $code_digit_pattern = '.*' if ( !$code_digit_pattern );
|
1083 | my @titles = grep { /^$code_base\*[0-9]+$code_digit_pattern$/ } (
|
1084 | @{
|
1085 | $self->dbh->selectcol_arrayref( $self->statement('getQLike'),
|
1086 | {}, $code_base . '*%' )
|
1087 | }
|
1088 | );
|
1089 | return ( 0 + @titles );
|
1090 | }
|
1091 |
|
1092 | # question_maxmax($question) returns the maximum of the max value for
|
1093 | # question $question accross all students sheets
|
1094 |
|
1095 | sub question_maxmax {
|
1096 | my ( $self, $question ) = @_;
|
1097 | return ( $self->sql_single( $self->statement('qMaxMax'), $question ) );
|
1098 | }
|
1099 |
|
1100 | # clear_strategy clears all data concerning the scoring strategy of
|
1101 | # the exam.
|
1102 |
|
1103 | sub clear_strategy {
|
1104 | my ($self) = @_;
|
1105 | $self->clear_variables;
|
1106 | $self->statement('noDefault')->execute;
|
1107 | for my $t (qw/title main question answer alias/) {
|
1108 | $self->sql_do( "DELETE FROM " . $self->table($t) );
|
1109 | }
|
1110 | }
|
1111 |
|
1112 | # clear_score clears all data concerning the scores/marks of the
|
1113 | # students.
|
1114 |
|
1115 | sub clear_score {
|
1116 | my ($self) = @_;
|
1117 | for my $t (qw/score mark/) {
|
1118 | $self->sql_do( "DELETE FROM " . $self->table($t) );
|
1119 | }
|
1120 | $self->clear_code_direct(DIRECT_MARK);
|
1121 | }
|
1122 |
|
1123 | sub clear_code_direct {
|
1124 | my ( $self, $category ) = @_;
|
1125 | $self->statement('clearDirect')->execute($category);
|
1126 | }
|
1127 |
|
1128 | # set_answer_strategy($student,$question,$answer,$strategy) sets the
|
1129 | # scoring strategy string associated to a particular answer.
|
1130 |
|
1131 | sub set_answer_strategy {
|
1132 | my ( $self, $student, $question, $answer, $strategy ) = @_;
|
1133 | $self->statement('setAnswerStrat')
|
1134 | ->execute( $strategy, $student, $question, $answer );
|
1135 | }
|
1136 |
|
1137 | # add_answer_strategy($student,$question,$answer,$strategy) adds the
|
1138 | # scoring strategy string to a particular answer's one.
|
1139 |
|
1140 | sub add_answer_strategy {
|
1141 | my ( $self, $student, $question, $answer, $strategy ) = @_;
|
1142 | $self->statement('addAnswerStrat')
|
1143 | ->execute( "," . $strategy, $student, $question, $answer );
|
1144 | }
|
1145 |
|
1146 | # replicate($see,$student) tells that the scoring strategy used for
|
1147 | # student $see has to be also used for student $student. This can be
|
1148 | # used only when the questions/answers are not different from a sheet
|
1149 | # to another (contrary to the use of random numerical values for
|
1150 | # exemple).
|
1151 |
|
1152 | sub replicate {
|
1153 | my ( $self, $see, $student ) = @_;
|
1154 | $self->statement('NEWAlias')->execute( $student, $see );
|
1155 | }
|
1156 |
|
1157 | # unalias($student) gives the student number where to find scoring
|
1158 | # strategy for student $student (following a replicate path if
|
1159 | # present -- see previous method).
|
1160 |
|
1161 | sub unalias {
|
1162 | my ( $self, $student ) = @_;
|
1163 | my $s = $student;
|
1164 | do {
|
1165 | $student = $s;
|
1166 | $s = $self->sql_single( $self->statement('getAlias'), $student );
|
1167 | } while ( defined($s) );
|
1168 | return ($student);
|
1169 | }
|
1170 |
|
1171 | # postcorrect($student,$copy,$darkness_threshold,$darkness_threshold_up,$set_multiple)
|
1172 | # uses the ticked values from the copy ($student,$copy) (filled by a
|
1173 | # teacher) to determine which answers are correct for all sheets. This
|
1174 | # can be used only when the questions/answers are not different from a
|
1175 | # sheet to another (contrary to the use of random numerical values for
|
1176 | # exemple).
|
1177 | #
|
1178 | # If $set_multiple is true, postcorrect also sets the type of all
|
1179 | # questions for which 2 or more answers are ticked on the
|
1180 | # ($student,$copy) answer sheet to be QUESTION_MULT, ans the type of
|
1181 | # all other questions to QUESTION_SIMPLE.
|
1182 |
|
1183 | sub postcorrect {
|
1184 | my ( $self, $student, $copy,
|
1185 | $darkness_threshold, $darkness_threshold_up, $set_multiple )
|
1186 | = @_;
|
1187 | die "Missing parameters in postcorrect call"
|
1188 | if ( !defined($darkness_threshold_up) );
|
1189 | $self->{data}->require_module('capture');
|
1190 | $self->statement('postCorrectNew')->execute();
|
1191 | $self->statement('postCorrectClr')->execute();
|
1192 | $self->statement('postCorrectPop')
|
1193 | ->execute( $darkness_threshold, $darkness_threshold_up, $student, $copy,
|
1194 | ZONE_BOX );
|
1195 | $self->statement('postCorrectMul')
|
1196 | ->execute( QUESTION_MULT, QUESTION_SIMPLE )
|
1197 | if ($set_multiple);
|
1198 | $self->statement('postCorrectSet')->execute();
|
1199 | }
|
1200 |
|
1201 | # new_score($student,$copy,$question,$score,$score_max,$why) adds a
|
1202 | # question score row.
|
1203 |
|
1204 | sub new_score {
|
1205 | my ( $self, $student, $copy, $question, $score, $score_max, $why ) = @_;
|
1206 | $self->statement('NEWScore')
|
1207 | ->execute( $student, $copy, $question, $score, $score_max, $why );
|
1208 | }
|
1209 |
|
1210 | # cancel_score($student,$copy,$question) cancels scoring (sets the
|
1211 | # score and maximum score to zero) for this question.
|
1212 |
|
1213 | sub cancel_score {
|
1214 | my ( $self, $student, $copy, $question ) = @_;
|
1215 | $self->statement('cancelScore')->execute( 'C', $student, $copy, $question );
|
1216 | }
|
1217 |
|
1218 | # new_mark($student,$copy,$total,$max,$mark) adds a mark row.
|
1219 |
|
1220 | sub new_mark {
|
1221 | my ( $self, $student, $copy, $total, $max, $mark ) = @_;
|
1222 | $self->statement('NEWMark')
|
1223 | ->execute( $student, $copy, $total, $max, $mark );
|
1224 | }
|
1225 |
|
1226 | # new_code($student,$copy,$code,$value) adds a code row.
|
1227 |
|
1228 | sub new_code {
|
1229 | my ( $self, $student, $copy, $code, $value, $direct ) = @_;
|
1230 | $direct = 0 if ( !$direct );
|
1231 | $self->statement('NEWCode')
|
1232 | ->execute( $student, $copy, $code, $value, $direct );
|
1233 | }
|
1234 |
|
1235 | # student_questions($student) returns a list of the question numbers
|
1236 | # used in the sheets for student number $student.
|
1237 |
|
1238 | sub student_questions {
|
1239 | my ( $self, $student ) = @_;
|
1240 | return (
|
1241 | $self->sql_list( $self->statement('studentQuestions'), $student ) );
|
1242 | }
|
1243 |
|
1244 | # questions returns an array of pointers (one for each question) to
|
1245 | # hashes (question=><question_number>,title=>'question_title').
|
1246 |
|
1247 | sub questions {
|
1248 | my ($self) = @_;
|
1249 | return (
|
1250 | @{
|
1251 | $self->dbh->selectall_arrayref( $self->statement('questions'),
|
1252 | { Slice => {} } )
|
1253 | }
|
1254 | );
|
1255 | }
|
1256 |
|
1257 | # average_mark returns the average mark from all students marks.
|
1258 |
|
1259 | sub average_mark {
|
1260 | my ($self) = @_;
|
1261 | my @pc = $self->postcorrect_sc;
|
1262 | return ( $self->sql_single( $self->statement('avgMark'), @pc ) );
|
1263 | }
|
1264 |
|
1265 | # codes returns a list of codes names.
|
1266 |
|
1267 | sub codes {
|
1268 | my ($self) = @_;
|
1269 | return ( $self->sql_list( $self->statement('codes') ) );
|
1270 | }
|
1271 |
|
1272 | # marks returns a pointer to an array of pointers (one for each
|
1273 | # student) to hashes giving all information from the mark table.
|
1274 |
|
1275 | sub marks {
|
1276 | my ($self) = @_;
|
1277 | return (
|
1278 | @{
|
1279 | $self->dbh->selectall_arrayref( $self->statement('marks'),
|
1280 | { Slice => {} } )
|
1281 | }
|
1282 | );
|
1283 | }
|
1284 |
|
1285 | # marks_count returns the nmber of marks computed.
|
1286 |
|
1287 | sub marks_count {
|
1288 | my ($self) = @_;
|
1289 | return ( $self->sql_single( $self->statement('marksCount') ) );
|
1290 | }
|
1291 |
|
1292 | # question_score($student,$copy,$question) returns the score of a
|
1293 | # particular student for a particular question.
|
1294 |
|
1295 | sub question_score {
|
1296 | my ( $self, $student, $copy, $question ) = @_;
|
1297 | return (
|
1298 | $self->sql_single(
|
1299 | $self->statement('getScore'),
|
1300 | $student, $copy, $question
|
1301 | )
|
1302 | );
|
1303 | }
|
1304 |
|
1305 | # question_result($student,$copy,$question) returns a pointer to a
|
1306 | # hash (score=>XXX,max=>XXX,why=>XXX) extracted from the
|
1307 | # question table.
|
1308 |
|
1309 | sub question_result {
|
1310 | my ( $self, $student, $copy, $question ) = @_;
|
1311 | my $sth = $self->statement('getScoreC');
|
1312 | $sth->execute( $student, $copy, $question );
|
1313 | return ( $sth->fetchrow_hashref );
|
1314 | }
|
1315 |
|
1316 | # student_code($student,$copy,$code) returns the value of the code
|
1317 | # named $code entered by a particular student.
|
1318 |
|
1319 | sub student_code {
|
1320 | my ( $self, $student, $copy, $code ) = @_;
|
1321 | return (
|
1322 | $self->sql_single(
|
1323 | $self->statement('getCode'), $student, $copy, $code
|
1324 | )
|
1325 | );
|
1326 | }
|
1327 |
|
1328 | # multicode_values($code_base) returns a list of code $code_base*NN (codes derivated
|
1329 | # from the multi code option) values for all the different students
|
1330 |
|
1331 | sub multicode_values {
|
1332 | my ( $self, $code_base ) = @_;
|
1333 | return (
|
1334 | grep { $_->{code} =~ /^$code_base\*[0-9]+$/ }
|
1335 | @{
|
1336 | $self->dbh->selectall_arrayref(
|
1337 | $self->statement('multicodeValues'), { Slice => {} },
|
1338 | $code_base.'*%'
|
1339 | )
|
1340 | }
|
1341 | );
|
1342 | }
|
1343 |
|
1344 | # postcorrect_sc returns (postcorrect_student,postcorrect_copy), or
|
1345 | # (0,0) if not in postcorrect mode.
|
1346 |
|
1347 | sub postcorrect_sc {
|
1348 | my ($self) = @_;
|
1349 | return (
|
1350 | $self->variable('postcorrect_student') || 0,
|
1351 | $self->variable('postcorrect_copy') || 0
|
1352 | );
|
1353 | }
|
1354 |
|
1355 | # question_average($question) returns the average (as a percentage of
|
1356 | # the maximum score, from 0 to 100) of the scores for a particular
|
1357 | # question.
|
1358 |
|
1359 | sub question_average {
|
1360 | my ( $self, $question ) = @_;
|
1361 | my @pc = $self->postcorrect_sc;
|
1362 | return (
|
1363 | $self->sql_single( $self->statement('avgQuest'), $question, @pc ) );
|
1364 | }
|
1365 |
|
1366 | # student_global($student,$copy) returns a pointer to a hash
|
1367 | # (student=>XXX,copy=>XXX,total=>XXX,max=>XXX,mark=>XXX)
|
1368 | # extracted from the mark table.
|
1369 |
|
1370 | sub student_global {
|
1371 | my ( $self, $student, $copy ) = @_;
|
1372 | my $sth = $self->statement('studentMark');
|
1373 | $sth->execute( $student, $copy );
|
1374 | return ( $sth->fetchrow_hashref );
|
1375 | }
|
1376 |
|
1377 | # student_scoring_base($student,$copy,$darkness_threshold,$darkness_threshold_up)
|
1378 | # returns useful data to compute questions scores for a particular
|
1379 | # student (identified by $student and $copy), as a reference to a hash
|
1380 | # grouping questions and answers. For exemple :
|
1381 | #
|
1382 | # 'main_strategy'=>"",
|
1383 | # 'questions'=>
|
1384 | # { 1 =>{ question=>1,
|
1385 | # 'title' => 'questionID',
|
1386 | # 'type'=>1,
|
1387 | # 'indicative'=>0,
|
1388 | # 'strategy'=>'',
|
1389 | # 'external'=>1.5,
|
1390 | # 'answers'=>[ { question=>1, answer=>1,
|
1391 | # correct=>1, ticked=>0, strategy=>"b=2" },
|
1392 | # {question=>1, answer=>2,
|
1393 | # correct=>0, ticked=>0, strategy=>"" },
|
1394 | # ],
|
1395 | # },
|
1396 | # ...
|
1397 | # }
|
1398 |
|
1399 | sub student_scoring_base {
|
1400 | my ( $self, $student, $copy, $darkness_threshold, $darkness_threshold_up )
|
1401 | = @_;
|
1402 | die "Missing parameters in student_scoring_base call"
|
1403 | if ( !defined($darkness_threshold_up) );
|
1404 | $self->{data}->require_module('capture');
|
1405 | my $student_strategy = $self->unalias($student);
|
1406 | my $r = {
|
1407 | student_alias => $student_strategy,
|
1408 | questions => {},
|
1409 | main_strategy => $self->main_strategy_all($student_strategy)
|
1410 | };
|
1411 | my @sid = ($student);
|
1412 | push @sid, $student_strategy if ( $student != $student_strategy );
|
1413 | for my $s (@sid) {
|
1414 | my $sth;
|
1415 | $sth = $self->statement('studentQuestionsBase');
|
1416 | $sth->execute($s);
|
1417 | while ( my $qa = $sth->fetchrow_hashref ) {
|
1418 | $self->add_question_external_score( $student, $copy, $qa );
|
1419 | $r->{questions}->{ $qa->{question} } = $qa;
|
1420 | }
|
1421 | $sth = $self->statement('studentAnswersBase');
|
1422 | $sth->execute( $darkness_threshold, $darkness_threshold_up,
|
1423 | $student, $copy, ZONE_BOX, $s );
|
1424 | while ( my $qa = $sth->fetchrow_hashref ) {
|
1425 | push @{ $r->{questions}->{ $qa->{question} }->{answers} }, $qa;
|
1426 | }
|
1427 | }
|
1428 | return ($r);
|
1429 | }
|
1430 |
|
1431 | # student_scoring_base_sorted(...) organizes the data from
|
1432 | # student_scoring_base to get sorted questions, relative to their IDs
|
1433 | # (lexicographic order)
|
1434 | #
|
1435 | # 'main_strategy'=>"",
|
1436 | # 'questions'=>
|
1437 | # [ { question=>1,
|
1438 | # 'title' => 'questionID',
|
1439 | # 'type'=>1,
|
1440 | # 'indicative'=>0,
|
1441 | # 'strategy'=>'',
|
1442 | # 'answers'=>[ { question=>1, answer=>1,
|
1443 | # 'correct'=>1, ticked=>0, strategy=>"b=2" },
|
1444 | # {question=>1, answer=>2,
|
1445 | # 'correct'=>0, ticked=>0, strategy=>"" },
|
1446 | # ],
|
1447 | # },
|
1448 | # ...
|
1449 | # ]
|
1450 |
|
1451 | sub student_scoring_base_sorted {
|
1452 | my ( $self, @args ) = @_;
|
1453 |
|
1454 | my $ssb = $self->student_scoring_base(@args);
|
1455 | my @n = sort {
|
1456 | $ssb->{questions}->{$a}->{title}
|
1457 | cmp $ssb->{questions}->{$b}->{title}
|
1458 | } ( keys %{ $ssb->{questions} } );
|
1459 | my $sorted_q = [ map { $ssb->{questions}->{$_} } (@n) ];
|
1460 | $ssb->{questions} = $sorted_q;
|
1461 |
|
1462 | return ($ssb);
|
1463 | }
|
1464 |
|
1465 | # delete_scoring_data($student,$copy) deletes all scoring data
|
1466 | # relative to a particular answer sheet.
|
1467 |
|
1468 | sub delete_scoring_data {
|
1469 | my ( $self, $student, $copy ) = @_;
|
1470 | for my $part (qw/Scores Marks Codes/) {
|
1471 | $self->statement( 'delete' . $part )->execute( $student, $copy );
|
1472 | }
|
1473 | }
|
1474 |
|
1475 | # set_external_score($student, $copy, $question, $score) sets a score
|
1476 | # to a particular question, from external data.
|
1477 |
|
1478 | sub set_external_score {
|
1479 | my ( $self, $student, $copy, $question, $score ) = @_;
|
1480 | $self->statement('setExternal')
|
1481 | ->execute( $student, $copy, $question, $score );
|
1482 | }
|
1483 |
|
1484 | # get_external_score($student, $copy, $question) gets the external
|
1485 | # score associated with a particular question.
|
1486 |
|
1487 | sub get_external_score {
|
1488 | my ( $self, $student, $copy, $question ) = @_;
|
1489 | return (
|
1490 | $self->sql_single(
|
1491 | $self->statement('getExternal'),
|
1492 | $student, $copy, $question
|
1493 | )
|
1494 | );
|
1495 | }
|
1496 |
|
1497 | # n_external() returns an array containing the number of external
|
1498 | # scores, and the number of students with external scores.
|
1499 |
|
1500 | sub n_external {
|
1501 | my ($self) = @_;
|
1502 | return (
|
1503 | @{
|
1504 | $self->dbh->selectall_arrayref( $self->statement('nExternal'), {} )
|
1505 | ->[0]
|
1506 | }
|
1507 | );
|
1508 | }
|
1509 |
|
1510 | # delete_external() deletes all external scoring data
|
1511 |
|
1512 | sub delete_external {
|
1513 | my ($self) = @_;
|
1514 | $self->statement('deleteExternal')->execute();
|
1515 | }
|
1516 |
|
1517 | # forget_marks() deletes all scoring data from all students
|
1518 |
|
1519 | sub forget_marks {
|
1520 | my ($self) = @_;
|
1521 | for my $t (qw/mark code score external/) {
|
1522 | $self->sql_do("DELETE FROM ".$self->table($t));
|
1523 | }
|
1524 | }
|
1525 |
|
1526 | # add_question_external_score($q) adds the external score to a
|
1527 | # question hashref
|
1528 |
|
1529 | sub add_question_external_score {
|
1530 | my ( $self, $student, $copy, $q ) = @_;
|
1531 | my $x = $self->get_external_score( $student, $copy, $q->{question} );
|
1532 | if ( defined($x) && $x ne '' ) {
|
1533 | $q->{external} = $x;
|
1534 | }
|
1535 | }
|
1536 |
|
1537 | # questions_n_answers returns an array of hashrefs with, for each
|
1538 | # question, the question number ({question}), the question id
|
1539 | # ({title}) and the maximum number of answers ({nanswers}, not
|
1540 | # counting the "None of the above")
|
1541 |
|
1542 | sub questions_n_answers {
|
1543 | my ( $self ) = @_;
|
1544 | return (
|
1545 | @{
|
1546 | $self->dbh->selectall_arrayref(
|
1547 | $self->statement('QnAnswers'), { Slice => {} },
|
1548 | )
|
1549 | }
|
1550 | );
|
1551 | }
|
1552 |
|
1553 | # question_first_student(qid) returns the first student number that
|
1554 | # includes this question
|
1555 |
|
1556 | sub question_first_student {
|
1557 | my ( $self, $question ) = @_;
|
1558 | return (
|
1559 | $self->sql_single( $self->statement('QfirstStudent'), $question )
|
1560 | );
|
1561 | }
|
1562 |
|
1563 | # question_info($student,$question) returns type, indicative, strategy
|
1564 | # for one particular question.
|
1565 |
|
1566 | sub question_info {
|
1567 | my ( $self, $student, $question ) = @_;
|
1568 | return (
|
1569 | $self->dbh->selectrow_array( $self->statement('Qall'), {},
|
1570 | $student, $question )
|
1571 | );
|
1572 | }
|
1573 |
|
1574 | # answers_info($student, $question) returns an arrayref to hashrefs
|
1575 | # with info (answer, correct, strategy) for each answer corresponding
|
1576 | # to a particular question.
|
1577 |
|
1578 | sub answers_info {
|
1579 | my ( $self, $student, $question ) = @_;
|
1580 | return (
|
1581 | $self->dbh->selectall_arrayref(
|
1582 | $self->statement('Ainfo'),
|
1583 | { Slice => {} },
|
1584 | $student, $question
|
1585 | )
|
1586 | );
|
1587 | }
|
1588 |
|
1589 | 1;
|