# -*- perl -*-

#

# Copyright (C) 2011-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;

package AMC::DataModule::scoring;

# AMC scoring management.

# This module is used to store (in a SQLite database) and handle all

# data concerning data scoring (scoring strategies, scores and marks).

# TERMINOLOGY NOTE:

#

# 'student' refers to the student number that is written at the top of

# each page, in the format +<student>/<page>/<check>+

#

# If the questions are printed from AMC, and not photocopied, each

# physical student has a different student number on his sheet.

#

# If some questions are photocopied before beeing distributed to the

# students, several students can have the same student number. To make

# a difference between their completed answer sheets, a 'copy' number

# is added. 'copy' is 1 for the first student using a given student

# number sheet, then 2, and so on.

#

# Hence, a completed answer sheet is identified by the (student,copy)

# couple, and a printed sheet (and correct answers, scoring

# strategies) is identified by the student number only.

#

# 'question' is a number associated by LaTeX with every different

# question (based on the small text given as XXX in the

# \begin{question}{XXX} or \begin{questionmult}{XXX} commands).

#

# 'answer' is the answer number, starting from 1 for each question,

# before beeing shuffled.

# TABLES:

#

# title contains the titles (argument of the \begin{question} and

# \begin{questionmult} commands) of all the questions

#

# * question is the question number, as created by LaTeX and used in

#   the databases <layout>, <capture>.

#

# * title id the title of the question.

#

# default holds the default scoring strategies, as specified with the

# \scoringDefaultM and \scoringDefaultS commands in the LaTeX source

# file. This table contains 2 rows.

#

# * type is the question type, either QUESTION_SIMPLE or QUESTION_MULT

#   (these constants are defined in this module).

#

# * strategy is the default strategy string for this question type.

#

# main holds scoring strategies defined outside question/questionmult

# environments, either outside the onecopy/examcopy data (with

# student=-1), or inside (student=current student number).

#

# * student is the student number.

#

# * strategy is the strategy string given in the LaTeX file as an

#   argument of the \scoring command.

#

# question holds scoring strategies for questions.

#

# * student is the student number.

#

# * question is the question number.

#

# * type is the question type, either QUESTION_SIMPLE or

#   QUESTION_MULT

#

# * indicative is 1 if the question is indicative (the score is not

#   taken into account when computing the student mark).

#

# * strategy is the question scoring strategy string, given in the

#   LaTeX file inside the question/questionmult environment (but

#   before \correctchoice and \wrongchoice commands).

#

# answer holds scoring strategies concerning answers.

#

# * student is the student number.

#

# * question is the question number.

#

# * answer is the answer number, starting from 1 for each question.

#

# * correct is 1 if this choice is correct (use of \correctchoice).

#

# * strategy is the answer scoring strategy string, given in the LaTeX

#   file after the corresponding correctchoice/wrongchoice commands.

#

# score holds the questions scores for each student.

#

# * student is the student number.

#

# * copy is the copy number.

#

# * question is the question number.

#

# * score is the score resulting from applying the scoring strategy to

#   the student's answers.

#

# * why is a small string that is used to know when special cases has

#   been encountered:

#

#     E means syntax error (several boxes ticked for a simple

#     question, or " none of the above" AND another box ticked for a

#     multiple question).

#

#     V means that no box are ticked.

#

#     P means that a floor has been applied.

#

#     X means that an external score has been applied.

#

# * max is the question score associated to a copy where all answers

#   are correct (or 1 for indicative questions).

#

# external holds the question scores that are not computed by AMC, but

# given from external data.

#

# * student, copy identifies the student.

#

# * question is the question number.

#

# * score is the score to be affected to this question.

#

# mark holds global marks of the students.

#

# * student is the student number.

#

# * copy is the copy number.

#

# * total is the total score (sum of the questions scores).

#

# * max is the total score associated to a perfect copy.

#

# * mark is the student mark.

#

# code holds the codes entered by the students (see \AMCcode).

#

# * student is the student number.

#

# * copy is the copy number.

#

# * code is the code name.

#

# * value is the code value.

#

# * direct is 1 if the score comes directly from a decoded zone image,

#   and 0 if it is computed while scoring.

# VARIABLES:

#

# postcorrect_flag is 1 if the postcorrect mode is supposed to be used

# (correct answers are not indicated in the LaTeX source, but will be

# set from a teacher completed answer sheet).

#

# postcorrect_student

# postcorrect_copy    identify the sheet completed by the teacher.

#

# postcorrect_set_multiple (see postcorrect function)

#

# --- the following values are supplied in the Preferences window

#

# darkness_threshold and darkness_threshold_up are the parameters used

# for determining wether a box is ticked or not.

#

# mark_floor is the minimum mark to be given to a student.

#

# mark_max is the mark to be given to a perfect completed answer

# sheet.

#

# ceiling is true if AMC should put a ceiling on the students marks

# (this can be useful if the SUF global scoring strategy is used).

#

# rounding is the rounding type to be used for the marks.

#

# granularity is the granularity for the marks rounding.

use Exporter qw(import);

use constant {

    QUESTION_SIMPLE => 1,

    QUESTION_MULT   => 2,

    DIRECT_MARK      => 0,

    DIRECT_NAMEFIELD => 1,

};

our @EXPORT_OK = qw(QUESTION_SIMPLE QUESTION_MULT DIRECT_MARK DIRECT_NAMEFIELD);

our %EXPORT_TAGS = (

    question => [qw/QUESTION_SIMPLE QUESTION_MULT/],

    direct   => [qw/DIRECT_MARK DIRECT_NAMEFIELD/],

);

use AMC::Basic;

use AMC::DataModule;

use AMC::DataModule::capture ':zone';

use AMC::DataModule::layout ':flags';

use XML::Simple;

our @ISA = ("AMC::DataModule");

sub version_current {

    return (3);

}

sub version_upgrade {

    my ( $self, $old_version ) = @_;

    if ( $old_version == 0 ) {

        # Upgrading from version 0 (empty database) to version 1 :

        # creates all the tables.

        debug "Creating scoring tables...";

        $self->sql_do( "CREATE TABLE IF NOT EXISTS "

              . $self->table("title")

              . " (question INTEGER, title TEXT)" );

        $self->sql_do( "CREATE TABLE IF NOT EXISTS "

              . $self->table("default")

              . " (type INTEGER, strategy TEXT)" );

        $self->sql_do( "CREATE TABLE IF NOT EXISTS "

              . $self->table("main")

              . " (student INTEGER, strategy TEXT)" );

        $self->sql_do( "CREATE TABLE IF NOT EXISTS "

              . $self->table("question")

              . " (student INTEGER, question INTEGER, type INTEGER, indicative INTEGER DEFAULT 0, strategy TEXT, PRIMARY KEY (student,question))"

        );

        $self->sql_do( "CREATE TABLE IF NOT EXISTS "

              . $self->table("answer")

              . " (student INTEGER, question INTEGER, answer INTEGER, correct INTEGER, strategy INTEGER, PRIMARY KEY (student,question,answer))"

        );

        $self->sql_do( "CREATE TABLE IF NOT EXISTS "

              . $self->table("alias")

              . " (student INTEGER,see INTEGER)" );

        $self->sql_do( "CREATE TABLE IF NOT EXISTS "

              . $self->table("score")

              . " (student INTEGER, copy INTEGER, question INTEGER, score REAL, why TEXT, max REAL, PRIMARY KEY (student,copy,question))"

        );

        $self->sql_do( "CREATE TABLE IF NOT EXISTS "

              . $self->table("mark")

              . " (student INTEGER, copy INTEGER, total REAL, max REAL, mark REAL, PRIMARY KEY (student,copy))"

        );

        $self->sql_do( "CREATE TABLE IF NOT EXISTS "

              . $self->table("code")

              . " (student INTEGER, copy INTEGER, code TEXT, value TEXT, direct INTEGER NOT NULL DEFAULT 0, PRIMARY KEY (student,copy,code))"

        );

        $self->statement('NEWdefault')->execute( QUESTION_SIMPLE, "" );

        $self->statement('NEWdefault')->execute( QUESTION_MULT,   "" );

        $self->populate_from_xml;

        return (2);

    } elsif ( $old_version == 1 ) {

        $self->sql_do( "ALTER TABLE "

              . $self->table("code")

              . " ADD COLUMN direct INTEGER NOT NULL DEFAULT 0" );

        return (2);

    } elsif ( $old_version == 2) {

        $self->sql_do( "CREATE TABLE IF NOT EXISTS "

                       . $self->table("external")

                       . " (student INTEGER, copy INTEGER, question INTEGER, score REAL, PRIMARY KEY (student,copy,question))"

        );

        return (3);

    }

    return ('');

}

# populate_from_xml read the old format XML files (if any) and inserts

# them in the new SQLite database

sub populate_from_xml {

    my ($self) = @_;

    my $scoring_file = $self->{data}->directory;

    $scoring_file =~ s:/[^/]+/?$:/bareme.xml:;

    return if ( !-f $scoring_file );

    $self->progression( 'begin',

        __ "Fetching scoring data from old format XML files..." );

    my $xml = XMLin( $scoring_file, ForceArray => 1, KeyAttr => ['id'] );

    $self->main_strategy( -1, $xml->{main} );

    my @s    = ( keys %{ $xml->{etudiant} } );

    my $frac = 0;

    for my $student (@s) {

        my $s = $xml->{etudiant}->{$student};

        if ( $student eq 'defaut' ) {

            $self->default_strategy( QUESTION_SIMPLE,

                $s->{question}->{S}->{bareme} );

            $self->default_strategy( QUESTION_MULT,

                $s->{question}->{M}->{bareme} );

        } elsif ( $student =~ /^[0-9]+$/ ) {

            $self->main_strategy( $student, $s->{main} );

            for my $question ( keys %{ $s->{question} } ) {

                if ( $question =~ /^[0-9]+$/ ) {

                    my $q = $s->{question}->{$question};

                    $self->question_title( $question, $q->{titre} );

                    $self->new_question(

                        $student,

                        $question,

                        ( $q->{multiple}   ? QUESTION_MULT : QUESTION_SIMPLE ),

                        ( $q->{indicative} ? 1             : 0 ),

                        $q->{bareme}

                    );

                    if ( $q->{reponse} ) {

                        if ( ref( $q->{reponse} ) eq 'HASH' ) {

                            for my $answer ( keys %{ $q->{reponse} } ) {

                                my $a = $q->{reponse}->{$answer};

                                $self->new_answer(

                                    $student,    $question, $answer,

                                    $a->{bonne}, $a->{bareme}

                                );

                            }

                        } else {

                            debug

"WARNING: reponse is not a HASHREF for S=$student Q=$question";

                        }

                    }

                } else {

                    debug "Unknown question id: <$question>";

                }

            }

        } else {

            debug "Unknown student id: <$student>";

        }

        $frac++;

        $self->progression( 'fraction', 0.5 * $frac / ( $#s + 1 ) );

    }

    $scoring_file = $self->{data}->directory;

    $scoring_file =~ s:/[^/]+/?$:/notes.xml:;

    return if ( !-f $scoring_file );

    $frac = 0;

    $xml = XMLin( $scoring_file, ForceArray => 1, KeyAttr => ['id'] );

    $self->variable( 'darkness_threshold',    $xml->{seuil} );

    $self->variable( 'darkness_threshold_up', 1.0 );

    $self->variable( 'mark_floor',            $xml->{notemin} );

    $self->variable( 'mark_max',              $xml->{notemax} );

    $self->variable( 'ceiling',               $xml->{plafond} );

    $self->variable( 'rounding',              $xml->{arrondi} );

    $self->variable( 'granularity',           $xml->{grain} );

    @s = ( keys %{ $xml->{copie} } );

    for my $student (@s) {

        my $s = $xml->{copie}->{$student};

        if ( $student =~ /^(moyenne|max)$/ ) {

            debug "Skipping student <$student>";

        } elsif ( $student =~ /^[0-9]+$/ ) {

            $self->statement('NEWMark')

              ->execute( $student, 0,

                map { $s->{total}->[0]->{$_} } (qw/total max note/) );

            for my $title ( keys %{ $s->{question} } ) {

                my $q        = $s->{question}->{$title};

                my $question = $self->question_number($title);

                $self->statement('NEWScore')

                  ->execute( $student, 0, $question, $q->{note}, $q->{max},

                    $q->{raison} );

            }

            for my $code ( keys %{ $s->{code} } ) {

                $self->statement('NEWCode')

                  ->execute( $student, 0, $code, $s->{code}->{$code}->{content},

                    DIRECT_MARK );

            }

        } else {

            debug "WARNING: Unknown student <$student> importing XML marks";

        }

        $frac++;

        $self->progression( 'fraction', 0.5 * ( 1 + $frac / ( $#s + 1 ) ) );

    }

    $self->progression('end');

}

# defines all the SQL statements that will be used

sub define_statements {

    my ($self)    = @_;

    my $t_answer  = $self->table("answer");

    my $t_default = $self->table("default");

    my $t_zone = $self->table( "zone", "capture" );

    $self->{statements} = {

        NEWdefault =>

          { sql => "INSERT INTO $t_default" . " (type,strategy) VALUES (?,?)" },

        getDefault =>

          { sql => "SELECT strategy FROM $t_default" . " WHERE type=?" },

        setDefault =>

          { sql => "UPDATE $t_default" . " SET strategy=? WHERE type=?" },

        noDefault => { sql => "UPDATE $t_default" . " SET strategy=''" },

        NEWMain   => {

                sql => "INSERT INTO "

              . $self->table("main")

              . " (student,strategy) VALUES (?,?)"

        },

        getMain => {

                sql => "SELECT strategy FROM "

              . $self->table("main")

              . " WHERE student=?"

        },

        getAllMain => {

                sql => "SELECT strategy FROM "

              . $self->table("main")

              . " WHERE student=? OR student=-1 OR student=0 ORDER BY student"

        },

        setMain => {

                sql => "UPDATE "

              . $self->table("main")

              . " SET strategy=? WHERE student=?"

        },

        NEWTitle => {

                sql => "INSERT INTO "

              . $self->table("title")

              . " (question,title) VALUES (?,?)"

        },

        getTitle => {

                sql => "SELECT title FROM "

              . $self->table("title")

              . " WHERE question=?"

        },

        getQNumber => {

                sql => "SELECT question FROM "

              . $self->table("title")

              . " WHERE title=?"

        },

        getQLike => {

                sql => "SELECT title FROM "

              . $self->table("title")

              . " WHERE title LIKE ?"

        },

        setTitle => {

                sql => "UPDATE "

              . $self->table("title")

              . " SET title=? WHERE question=?"

        },

        NEWQuestion => {

                sql => "INSERT OR REPLACE INTO "

              . $self->table("question")

              . " (student,question,type,indicative,strategy)"

              . " VALUES (?,?,?,?,?)"

        },

        NEWAnswer => {

                sql => "INSERT OR REPLACE INTO "

              . $self->table("answer")

              . " (student,question,answer,correct,strategy)"

              . " VALUES (?,?,?,?,?)"

        },

        setAnswerStrat => {

                sql => "UPDATE "

              . $self->table("answer")

              . " SET strategy=? WHERE student=? AND question=? AND answer=?"

        },

        addAnswerStrat => {

                sql => "UPDATE "

              . $self->table("answer")

              . " SET strategy=strategy||? WHERE student=? AND question=? AND answer=?"

        },

        NEWAlias => {

                sql => "INSERT INTO "

              . $self->table("alias")

              . " (student,see) VALUES (?,?)"

        },

        getAlias => {

                sql => "SELECT see FROM "

              . $self->table("alias")

              . " WHERE student=?"

        },

        postCorrectNew => {

            sql => "CREATE TEMPORARY TABLE IF NOT EXISTS"

              . " pc_temp (q INTEGER, a INTEGER, c REAL, PRIMARY KEY(q,a))"

        },

        postCorrectClr => { sql => "DELETE FROM pc_temp" },

        postCorrectPop => {

                sql => "INSERT INTO pc_temp (q,a,c) "

              . " SELECT id_a,id_b,CASE"

              . "   WHEN manual >= 0 THEN manual"

              . "   WHEN total<=0 THEN -1"

              . "   WHEN black >= ? * total AND black <= ? * total THEN 1"

              . "   ELSE 0" . " END"

              . " FROM "

              . $self->table( "zone", "capture" )

              . " WHERE capture_zone.student=? AND capture_zone.copy=? AND capture_zone.type=?"

        },

        postCorrectMul => {

                sql => "UPDATE "

              . $self->table("question")

              . " SET type=CASE"

              . "   WHEN (SELECT sum(c) FROM pc_temp"

              . "          WHERE q=question)>1"

              . "   THEN ?"

              . "   ELSE ?" . " END"

        },

        postCorrectSet => {

                sql => "UPDATE "

              . $self->table("answer")

              . " SET correct=(SELECT c FROM pc_temp"

              . "     WHERE q=question AND a=answer)"

        },

        NEWScore => {

                sql => "INSERT INTO "

              . $self->table("score")

              . " (student,copy,question,score,max,why)"

              . " VALUES (?,?,?,?,?,?)"

        },

        cancelScore => {

                sql => "UPDATE "

              . $self->table("score")

              . " SET why=? WHERE student=? AND copy=? AND question=?"

        },

        NEWMark => {

                sql => "INSERT INTO "

              . $self->table("mark")

              . " (student,copy,total,max,mark)"

              . " VALUES (?,?,?,?,?)"

        },

        NEWCode => {

                sql => "INSERT OR REPLACE INTO "

              . $self->table("code")

              . " (student,copy,code,value,direct)"

              . " VALUES (?,?,?,?,?)"

        },

        studentMark => {

                sql => "SELECT * FROM "

              . $self->table("mark")

              . " WHERE student=? AND copy=?"

        },

        marks      => { sql => "SELECT * FROM " . $self->table("mark") },

        marksCount => { sql => "SELECT COUNT(*) FROM " . $self->table("mark") },

        codes      => {

                sql => "SELECT code FROM "

              . $self->table("code")

              . " GROUP BY code ORDER BY code"

        },

        qStrat => {

                sql => "SELECT strategy FROM "

              . $self->table("question")

              . " WHERE student=? AND question=?"

        },

        aStrat => {

                sql => "SELECT strategy FROM "

              . $self->table("answer")

              . " WHERE student=? AND question=? AND answer=?"

        },

        answers => {

                sql => "SELECT answer FROM "

              . $self->table("answer")

              . " WHERE student=? AND question=?"

              . " ORDER BY answer"

        },

        studentQuestions => {

                sql => "SELECT question FROM "

              . $self->table("question")

              . " WHERE student=?"

        },

        questions => {

                sql => "SELECT question,title FROM "

              . $self->table("title")

              . " ORDER BY title"

        },

        qMaxMax => {

                sql => "SELECT MAX(max) FROM "

              . $self->table("score")

              . " WHERE question=?"

        },

        correct => {

                sql => "SELECT correct FROM "

              . $self->table("answer")

              . " WHERE student=? AND question=? AND answer=?"

        },

        correctChars => {

                sql => "SELECT char FROM "

              . " (SELECT answer FROM "

              . $self->table("answer")

              . "  WHERE student=? AND question=? AND correct>0) AS correct,"

              . " (SELECT answer,char FROM "

              . $self->table( "box", "layout" )

              . "  WHERE student=? AND question=? AND role=?) AS char"

              . " ON correct.answer=char.answer ORDER BY correct.answer"

        },

        correctForAll => {

                sql => "SELECT question,answer,"

              . " MIN(correct) AS correct_min,"

              . " MAX(correct) AS correct_max "

              . " FROM "

              . $self->table("answer")

              . " GROUP BY question,answer"

        },

        multiple => {

                sql => "SELECT type FROM "

              . $self->table("question")

              . " WHERE student=? AND question=?"

        },

        indicative => {

                sql => "SELECT indicative FROM "

              . $self->table("question")

              . " WHERE student=? AND question=?"

        },

        numQIndic => {

                sql => "SELECT COUNT(*) FROM"

              . " ( SELECT question FROM "

              . $self->table("question")

              . " WHERE indicatve=? GROUP BY question)"

        },

        oneIndic => {

                sql => "SELECT COUNT(*) FROM "

              . $self->table("question")

              . " WHERE question=? AND indicative=?"

        },

        getScore => {

                sql => "SELECT score FROM "

              . $self->table("score")

              . " WHERE student=? AND copy=? AND question=?"

        },

        getScoreC => {

                sql => "SELECT score,max,why FROM "

              . $self->table("score")

              . " WHERE student=? AND copy=? AND question=?"

        },

        getCode => {

                sql => "SELECT value FROM "

              . $self->table("code")

              . " WHERE student=? AND copy=? AND code=?"

        },

        multicodeValues => {

                sql => "SELECT student,copy,code,value FROM "

              . $self->table("code")

              . " WHERE code LIKE ?"

        },

        codesCounts => {

                sql => "SELECT student,copy,value,COUNT(*) as nb"

              . " FROM "

              . $self->table("code")

              . " WHERE code=? GROUP BY value"

        },

        preAssocCounts => {

                sql => "SELECT m.student,m.copy,l.id AS value,COUNT(*) AS nb"

              . " FROM "

              . $self->table("mark") . " AS m"

              . "      , "

              . $self->table( "association", "layout" ) . " AS l"

              . " ON m.student=l.student AND m.copy=0"

              . " GROUP BY l.id"

        },

        avgMark => {

                sql => "SELECT AVG(mark) FROM "

              . $self->table("mark")

              . " WHERE NOT (student=? AND copy=?)"

        },

        avgQuest => {

                sql => "SELECT CASE"

              . " WHEN SUM(max)>0 THEN 100*SUM(score)/SUM(max)"

              . " ELSE '-' END"

              . " FROM "

              . $self->table("score")

              . " WHERE question=?"

              . " AND NOT (student=? AND copy=?)"

        },

        studentAnswersBase => {

                sql => "SELECT question,answer"

              . ",correct,strategy"

              . ",(SELECT CASE"

              . "         WHEN manual >= 0 THEN manual"

              . "         WHEN total<=0 THEN -1"

              . "         WHEN black >= ? * total AND black <= ? * total THEN 1"

              . "         ELSE 0"

              . "  END FROM $t_zone"

              . "  WHERE $t_zone.student=? AND $t_zone.copy=? AND $t_zone.type=?"

              . "        AND $t_zone.id_a=$t_answer.question AND $t_zone.id_b=$t_answer.answer"

              . " ) AS ticked"

              . " FROM "

              . $self->table("answer")

              . " WHERE student=?"

        },

             'studentSkillLevel'=>

     {'sql'=>"SELECT SUBSTR(t.title, 1, INSTR(t.title, ':')-1) AS skill, SUM(s.score)/SUM(s.max)" 

      ." FROM ".$self->table("title"). " t" 

      ." INNER JOIN ".$self->table("score")." s" 

      ." ON s.question=t.question" 

      ." WHERE t.title LIKE '%:%' AND s.student=? AND s.copy=?" 

      ." GROUP BY s.copy, s.student, skill"},

        studentQuestionsBase => {

            sql => "SELECT q.question,q.type,q.indicative,q.strategy,t.title"

              . ",d.strategy AS default_strategy"

              . " FROM "

              . $self->table("question") . " q"

              . " LEFT OUTER JOIN "

              . $self->table("default") . " d"

              . " ON q.type=d.type"

              . " LEFT OUTER JOIN "

              . $self->table("title") . " t"

              . " ON q.question=t.question"

              . " WHERE student=?"

        },

        deleteScores => {

                sql => "DELETE FROM "

              . $self->table('score')

              . " WHERE student=? AND copy=?"

        },

        deleteMarks => {

                sql => "DELETE FROM "

              . $self->table('mark')

              . " WHERE student=? AND copy=?"

        },

        deleteCodes => {

                sql => "DELETE FROM "

              . $self->table('code')

              . " WHERE student=? AND copy=?"

        },

        pagesWhy => {

            sql =>

              "SELECT s.student,s.copy,GROUP_CONCAT(s.why) as why,b.page FROM "

              . $self->table('score') . " s"

              . " JOIN "

              . " ( SELECT student,page,question FROM "

              . $self->table( "box", "layout" )

              . "   WHERE role=?"

              . "   GROUP BY student,page,question )" . " b"

              . " ON s.student=b.student AND s.question=b.question"

              . " GROUP BY s.student,b.page,s.copy"

        },

        clearDirect =>

          { sql => "DELETE FROM " . $self->table("code") . " WHERE direct=?" },

        setExternal => {

                sql => "INSERT OR REPLACE INTO "

              . $self->table("external")

              . " (student,copy,question,score) VALUES (?,?,?,?)"

        },

        getExternal => {

                sql => "SELECT score FROM "

              . $self->table("external")

              . " WHERE student=? AND copy=? AND question=?"

        },

        deleteExternal => {

                sql => "DELETE FROM "

              . $self->table("external")

        },

        nExternal => {

            sql => "SELECT count(*) as n,count(DISTINCT student) as ns"

                . " FROM ".$self->table("external")

        },

        QnAnswers => {

            sql => "SELECT a.question, t.title, MAX(a.answer) as nanswers"

                . " FROM ".$self->table("answer")." AS a"

                . "     ,".$self->table("title")." AS t"

                . " WHERE a.question=t.question"

                . " GROUP BY a.question"

        },

        QfirstStudent => {

            sql => "SELECT MIN(student)"

                . " FROM ".$self->table("question")

                . " WHERE question=?"

        },

        Qall => {

            sql => "SELECT type,indicative,strategy"

                . " FROM ".$self->table("question")

                . " WHERE student=? AND question=?"

        },

        Ainfo => {

            sql => "SELECT answer,correct,strategy"

                . " FROM ".$self->table("answer")

                . " WHERE student=? AND question=?"

                . " ORDER BY answer"

        },

    };

}

# page_why() returns a list of items like

# {student=>1,copy=>0,page=>1,why=>',V,E,,'}

# that collects all 'why' attributes for questions that are on each page.

sub pages_why {

    my ($self) = @_;

    return (

        @{

            $self->dbh->selectall_arrayref(

                $self->statement('pagesWhy'), { Slice => {} },

                BOX_ROLE_ANSWER

            )

        }

    );

}

# default_strategy($type) returns the default scoring strategy string

# to be used for questions with type $type (QUESTION_SIMPLE or

# QUESTION_MULT).

#

# default_strategy($type,$strategy) sets the default strategy string

# for questions with type $type.

sub default_strategy {

    my ( $self, $type, $strategy ) = @_;

    if ( defined($strategy) ) {

        $self->statement('setDefault')->execute( $strategy, $type );

    } else {

        return ( $self->sql_single( $self->statement('getDefault'), $type ) );

    }

}

# main_strategy($student) returns the main scoring strategy string for

# student $student. If $student<=0 (-1 in the database), this refers

# to the argument of the \scoring command used outside the

# onecopy/examcopy loop. If $student>0, this refers to the argument of

# the \scoring command used inside the onecopy/examcopy loop, but

# outside question/questionmult environments.

#

# main_strategy($student,$strategy) sets the main scoring strategy

# string.

sub main_strategy {

    my ( $self, $student, $strategy ) = @_;

    $student = -1 if ( $student <= 0 );

    if ( defined($strategy) ) {

        if ( defined( $self->main_strategy($student) ) ) {

            $self->statement('setMain')->execute( $strategy, $student );

        } else {

            $self->statement('NEWMain')->execute( $student, $strategy );

        }

    } else {

        return ( $self->sql_single( $self->statement('getMain'), $student ) );

    }

}

#add_main_strategy($student,$strategy) adds the strategy string at the

#end of the student's main strategy string.

sub add_main_strategy {

    my ( $self, $student, $strategy ) = @_;

    $student = -1 if ( $student <= 0 );

    my $old = $self->main_strategy($student);

    if ( defined($old) ) {

        $self->statement('setMain')

          ->execute( $old . ',' . $strategy, $student );

    } else {

        $self->statement('NEWMain')->execute( $student, $strategy );

    }

}

# main_strategy_all($student) returns a concatenation of the the main

# strategies for student=-1, student=0 and student=$student.

sub main_strategy_all {

    my ( $self, $student ) = @_;

    return (

        join(

            ',', $self->sql_list( $self->statement('getAllMain'), $student )

        )

    );

}

# new_question($student,$question,$type,$indicative,$strategy) adds a

# question in the database, giving its characteristics. If the

# question already exists, it is updated with no error.

sub new_question {

    my ( $self, $student, $question, $type, $indicative, $strategy ) = @_;

    $self->statement('NEWQuestion')

      ->execute( $student, $question, $type, $indicative, $strategy );

}

# question_strategy($student,$question) returns the scoring strategy

# string for a particlar question: argument of the \scoring command

# used inside a question/questionmult environment, before the

# \correctchoice and \wrongchoice commands.

sub question_strategy {

    my ( $self, $student, $question ) = @_;

    return (

        $self->sql_single( $self->statement('qStrat'), $student, $question ) );

}

# new_answer($student,$question,$answer,$correct,$strategy) adds an

# answer in the database, giving its characteristics. If the answer

# already exists, it is updated with no error.

sub new_answer {

    my ( $self, $student, $question, $answer, $correct, $strategy ) = @_;

    $self->statement('NEWAnswer')

      ->execute( $student, $question, $answer, $correct, $strategy );

}

# answer_strategy($student,$question,$answer) returns the scoring

# strategy string for a particular answer: argument of the \scoring

# command used after \correctchoice and \wrongchoice commands.

sub answer_strategy {

    my ( $self, $student, $question, $answer ) = @_;

    return (

        $self->sql_single(

            $self->statement('aStrat'),

            $student, $question, $answer

        )

    );

}

# answers($student,$question) returns an ordered list of answers

# numbers for a particular question. Answer number 0, placed at the

# end, corresponds to the answer "None of the above", when present.

sub answers {

    my ( $self, $student, $question ) = @_;

    my @a = $self->sql_list( $self->statement('answers'), $student, $question );

    if ( $a[0] == 0 ) {

        shift @a;

        push @a, 0;

    }

    return (@a);

}

# correct_answer($student,$question,$answer) returns 1 if the

# corresponding box has to be ticked (the answer is a correct one),

# and 0 if not.

sub correct_answer {

    my ( $self, $student, $question, $answer ) = @_;

    return (

        $self->sql_single(

            $self->statement('correct'),

            $student, $question, $answer

        )

    );

}

# correct_chars($student,$question) returns the list of the chars

# written inside (or beside) the boxes corresponding to correct

# answers for a particular question

sub correct_chars {

    my ( $self, $student, $question ) = @_;

    $self->{data}->require_module('layout');

    return (

        $self->sql_list(

            $self->statement('correctChars'), $student,

            $question,                        $student,

            $question,                        BOX_ROLE_ANSWER

        )

    );

}

# Same as correct_chars, but paste the chars if they all exist, and

# return undef otherwise

sub correct_chars_pasted {

    my ( $self, @args ) = @_;

    my @c = $self->correct_chars(@args);

    if ( grep { !defined($_) } @c ) {

        return (undef);

    } else {

        return ( join( "", @c ) );

    }

}

# correct_for_all() returns a reference to an array like

#

# [{question=>1,answer=>1,correct_min=>0,correct_max=>0},

#  {question=>1,answer=>2,correct_min=>1,correct_max=>1},

# ]

#

# This gives, for each question/answer, the minumum and maximum of the

# <correct> column for all students. Usualy, minimum and maximum are

# equal because the answer is either correct for all students either

# not correct for all students, but one can also encounter

# correct_min=0 and correct_max=1, in situations where the answers are

# not the same for all students (for example for questions with random

# numerical values).

sub correct_for_all {

    my ( $self, $question, $answer ) = @_;

    return (

        $self->dbh->selectall_arrayref(

            $self->statement('correctForAll'),

            { Slice => {} }

        )

    );

}

# multiple($student,$question) returns 1 if the corresponding

# question is multiple (type=QUESTION_MULT), and 0 if not.

sub multiple {

    my ( $self, $student, $question ) = @_;

    return (

        $self->sql_single( $self->statement('multiple'), $student, $question )

          == QUESTION_MULT );

}

# correct_answer($student,$question) returns 1 if the corresponding

# question is indicative (use of \QuestionIndicative), and 0 if not.

sub indicative {

    my ( $self, $student, $question ) = @_;

    return (

        $self->sql_single(

            $self->statement('indicative'), $student, $question

        )

    );

}

# one_indicative($question,$indic) returns the number of students for

# which the question has indicative=$indic. In fact, a single question

# SHOULD be indicative for all students, or for none...

sub one_indicative {

    my ( $self, $question, $indic ) = @_;

    $indic = 1 if ( !defined($indic) );

    return (

        $self->sql_single( $self->statement('oneIndic'), $question, $indic ) );

}

# num_questions_indic($i) returns the number of questions that have

# indicative=$i ($i is 0 or 1).

sub num_questions_indic {

    my ( $self, $indicative ) = @_;

    return ( $self->sql_single( $self->statement('numQIndic'), $indicative ) );

}

# question_title($question) returns a question title.

#

# question_title($question,$title) sets a question title.

sub question_title {

    my ( $self, $question, $title ) = @_;

    if ( defined($title) ) {

        if ( defined( $self->question_title($question) ) ) {

            $self->statement('setTitle')->execute( $title, $question );

        } else {

            $self->statement('NEWTitle')->execute( $question, $title );

        }

    } else {

        return ( $self->sql_single( $self->statement('getTitle'), $question ) );

    }

}

# question_number($title) returns the question number corresponding to

# the given title.

sub question_number {

    my ( $self, $title ) = @_;

    return ( $self->sql_single( $self->statement('getQNumber'), $title ) );

}

# multicode_registered($code_base) returns TRUE if a multicode is

# registered in curent scoring.

sub multicode_registered {

    my ( $self, $code_base, $code_digit_pattern ) = @_;

    $code_digit_pattern = '.*' if ( !$code_digit_pattern );

    my @titles = grep { /^$code_base\*[0-9]+$code_digit_pattern$/ } (

        @{

            $self->dbh->selectcol_arrayref( $self->statement('getQLike'),

                {}, $code_base . '*%' )

        }

    );

    return ( 0 + @titles );

}

# question_maxmax($question) returns the maximum of the max value for

# question $question accross all students sheets

sub question_maxmax {

    my ( $self, $question ) = @_;

    return ( $self->sql_single( $self->statement('qMaxMax'), $question ) );

}

# clear_strategy clears all data concerning the scoring strategy of

# the exam.

sub clear_strategy {

    my ($self) = @_;

    $self->clear_variables;

    $self->statement('noDefault')->execute;

    for my $t (qw/title main question answer alias/) {

        $self->sql_do( "DELETE FROM " . $self->table($t) );

    }

}

# clear_score clears all data concerning the scores/marks of the

# students.

sub clear_score {

    my ($self) = @_;

    for my $t (qw/score mark/) {

        $self->sql_do( "DELETE FROM " . $self->table($t) );

    }

    $self->clear_code_direct(DIRECT_MARK);

}

sub clear_code_direct {

    my ( $self, $category ) = @_;

    $self->statement('clearDirect')->execute($category);

}

# set_answer_strategy($student,$question,$answer,$strategy) sets the

# scoring strategy string associated to a particular answer.

sub set_answer_strategy {

    my ( $self, $student, $question, $answer, $strategy ) = @_;

    $self->statement('setAnswerStrat')

      ->execute( $strategy, $student, $question, $answer );

}

# add_answer_strategy($student,$question,$answer,$strategy) adds the

# scoring strategy string to a particular answer's one.

sub add_answer_strategy {

    my ( $self, $student, $question, $answer, $strategy ) = @_;

    $self->statement('addAnswerStrat')

      ->execute( "," . $strategy, $student, $question, $answer );

}

# replicate($see,$student) tells that the scoring strategy used for

# student $see has to be also used for student $student. This can be

# used only when the questions/answers are not different from a sheet

# to another (contrary to the use of random numerical values for

# exemple).

sub replicate {

    my ( $self, $see, $student ) = @_;

    $self->statement('NEWAlias')->execute( $student, $see );

}

# unalias($student) gives the student number where to find scoring

# strategy for student $student (following a replicate path if

# present -- see previous method).

sub unalias {

    my ( $self, $student ) = @_;

    my $s = $student;

    do {

        $student = $s;

        $s       = $self->sql_single( $self->statement('getAlias'), $student );

    } while ( defined($s) );

    return ($student);

}

# postcorrect($student,$copy,$darkness_threshold,$darkness_threshold_up,$set_multiple)

# uses the ticked values from the copy ($student,$copy) (filled by a

# teacher) to determine which answers are correct for all sheets. This

# can be used only when the questions/answers are not different from a

# sheet to another (contrary to the use of random numerical values for

# exemple).

#

# If $set_multiple is true, postcorrect also sets the type of all

# questions for which 2 or more answers are ticked on the

# ($student,$copy) answer sheet to be QUESTION_MULT, ans the type of

# all other questions to QUESTION_SIMPLE.

sub postcorrect {

    my ( $self, $student, $copy,

        $darkness_threshold, $darkness_threshold_up, $set_multiple )

      = @_;

    die "Missing parameters in postcorrect call"

      if ( !defined($darkness_threshold_up) );

    $self->{data}->require_module('capture');

    $self->statement('postCorrectNew')->execute();

    $self->statement('postCorrectClr')->execute();

    $self->statement('postCorrectPop')

      ->execute( $darkness_threshold, $darkness_threshold_up, $student, $copy,

        ZONE_BOX );

    $self->statement('postCorrectMul')

      ->execute( QUESTION_MULT, QUESTION_SIMPLE )

      if ($set_multiple);

    $self->statement('postCorrectSet')->execute();

}

# new_score($student,$copy,$question,$score,$score_max,$why) adds a

# question score row.

sub new_score {

    my ( $self, $student, $copy, $question, $score, $score_max, $why ) = @_;

    $self->statement('NEWScore')

      ->execute( $student, $copy, $question, $score, $score_max, $why );

}

# cancel_score($student,$copy,$question) cancels scoring (sets the

# score and maximum score to zero) for this question.

sub cancel_score {

    my ( $self, $student, $copy, $question ) = @_;

    $self->statement('cancelScore')->execute( 'C', $student, $copy, $question );

}

# new_mark($student,$copy,$total,$max,$mark) adds a mark row.

sub new_mark {

    my ( $self, $student, $copy, $total, $max, $mark ) = @_;

    $self->statement('NEWMark')

      ->execute( $student, $copy, $total, $max, $mark );

}

# new_code($student,$copy,$code,$value) adds a code row.

sub new_code {

    my ( $self, $student, $copy, $code, $value, $direct ) = @_;

    $direct = 0 if ( !$direct );

    $self->statement('NEWCode')

      ->execute( $student, $copy, $code, $value, $direct );

}

# student_questions($student) returns a list of the question numbers

# used in the sheets for student number $student.

sub student_questions {

    my ( $self, $student ) = @_;

    return (

        $self->sql_list( $self->statement('studentQuestions'), $student ) );

}

# questions returns an array of pointers (one for each question) to

# hashes (question=><question_number>,title=>'question_title').

sub questions {

    my ($self) = @_;

    return (

        @{

            $self->dbh->selectall_arrayref( $self->statement('questions'),

                { Slice => {} } )

        }

    );

}

# average_mark returns the average mark from all students marks.

sub average_mark {

    my ($self) = @_;

    my @pc = $self->postcorrect_sc;

    return ( $self->sql_single( $self->statement('avgMark'), @pc ) );

}

# codes returns a list of codes names.

sub codes {

    my ($self) = @_;

    return ( $self->sql_list( $self->statement('codes') ) );

}

# marks returns a pointer to an array of pointers (one for each

# student) to hashes giving all information from the mark table.

sub marks {

    my ($self) = @_;

    return (

        @{

            $self->dbh->selectall_arrayref( $self->statement('marks'),

                { Slice => {} } )

        }

    );

}

# marks_count returns the nmber of marks computed.

sub marks_count {

    my ($self) = @_;

    return ( $self->sql_single( $self->statement('marksCount') ) );

}

# question_score($student,$copy,$question) returns the score of a

# particular student for a particular question.

sub question_score {

    my ( $self, $student, $copy, $question ) = @_;

    return (

        $self->sql_single(

            $self->statement('getScore'),

            $student, $copy, $question

        )

    );

}

# question_result($student,$copy,$question) returns a pointer to a

# hash (score=>XXX,max=>XXX,why=>XXX) extracted from the

# question table.

sub question_result {

    my ( $self, $student, $copy, $question ) = @_;

    my $sth = $self->statement('getScoreC');

    $sth->execute( $student, $copy, $question );

    return ( $sth->fetchrow_hashref );

}

# student_code($student,$copy,$code) returns the value of the code

# named $code entered by a particular student.

sub student_code {

    my ( $self, $student, $copy, $code ) = @_;

    return (

        $self->sql_single(

            $self->statement('getCode'), $student, $copy, $code

        )

    );

}

# multicode_values($code_base) returns a list of code $code_base*NN (codes derivated

# from the multi code option) values for all the different students

sub multicode_values {

    my ( $self, $code_base ) = @_;

    return (

        grep { $_->{code} =~ /^$code_base\*[0-9]+$/ }

        @{

            $self->dbh->selectall_arrayref(

                $self->statement('multicodeValues'), { Slice => {} },

                $code_base.'*%'

            )

        }

    );

}

# postcorrect_sc returns (postcorrect_student,postcorrect_copy), or

# (0,0) if not in postcorrect mode.

sub postcorrect_sc {

    my ($self) = @_;

    return (

        $self->variable('postcorrect_student') || 0,

        $self->variable('postcorrect_copy') || 0

    );

}

# question_average($question) returns the average (as a percentage of

# the maximum score, from 0 to 100) of the scores for a particular

# question.

sub question_average {

    my ( $self, $question ) = @_;

    my @pc = $self->postcorrect_sc;

    return (

        $self->sql_single( $self->statement('avgQuest'), $question, @pc ) );

}

# student_global($student,$copy) returns a pointer to a hash

# (student=>XXX,copy=>XXX,total=>XXX,max=>XXX,mark=>XXX)

# extracted from the mark table.

sub student_global {

    my ( $self, $student, $copy ) = @_;

    my $sth = $self->statement('studentMark');

    $sth->execute( $student, $copy );

    return ( $sth->fetchrow_hashref );

}

# student_scoring_base($student,$copy,$darkness_threshold,$darkness_threshold_up)

# returns useful data to compute questions scores for a particular

# student (identified by $student and $copy), as a reference to a hash

# grouping questions and answers. For exemple :

#

# 'main_strategy'=>"",

# 'questions'=>

# { 1 =>{ question=>1,

#         'title' => 'questionID',

#         'type'=>1,

#         'indicative'=>0,

#         'strategy'=>'',

#         'external'=>1.5,

#         'answers'=>[ { question=>1, answer=>1,

#                        correct=>1, ticked=>0, strategy=>"b=2" },

#                      {question=>1, answer=>2,

#                        correct=>0, ticked=>0, strategy=>"" },

#                    ],

#       },

#  ...

# }

sub student_scoring_base {

    my ( $self, $student, $copy, $darkness_threshold, $darkness_threshold_up )

      = @_;

    die "Missing parameters in student_scoring_base call"

      if ( !defined($darkness_threshold_up) );

    $self->{data}->require_module('capture');

    my $student_strategy = $self->unalias($student);

    my $r                = {

        student_alias => $student_strategy,

        questions     => {},

        main_strategy => $self->main_strategy_all($student_strategy)

    };

    my @sid = ($student);

    push @sid, $student_strategy if ( $student != $student_strategy );

    for my $s (@sid) {

        my $sth;

        $sth = $self->statement('studentQuestionsBase');

        $sth->execute($s);

        while ( my $qa = $sth->fetchrow_hashref ) {

            $self->add_question_external_score( $student, $copy, $qa );

            $r->{questions}->{ $qa->{question} } = $qa;

        }

        $sth = $self->statement('studentAnswersBase');

        $sth->execute( $darkness_threshold, $darkness_threshold_up,

            $student, $copy, ZONE_BOX, $s );

        while ( my $qa = $sth->fetchrow_hashref ) {

            push @{ $r->{questions}->{ $qa->{question} }->{answers} }, $qa;

        }

    }

    return ($r);

}

# student_scoring_base_sorted(...) organizes the data from

# student_scoring_base to get sorted questions, relative to their IDs

# (lexicographic order)

#

# 'main_strategy'=>"",

# 'questions'=>

# [ { question=>1,

#     'title' => 'questionID',

#     'type'=>1,

#     'indicative'=>0,

#     'strategy'=>'',

#     'answers'=>[ { question=>1, answer=>1,

#                    'correct'=>1, ticked=>0, strategy=>"b=2" },

#                  {question=>1, answer=>2,

#                    'correct'=>0, ticked=>0, strategy=>"" },

#                ],

#   },

#  ...

# ]

sub student_scoring_base_sorted {

    my ( $self, @args ) = @_;

    my $ssb = $self->student_scoring_base(@args);

    my @n   = sort {

        $ssb->{questions}->{$a}->{title}

          cmp $ssb->{questions}->{$b}->{title}

    } ( keys %{ $ssb->{questions} } );

    my $sorted_q = [ map { $ssb->{questions}->{$_} } (@n) ];

    $ssb->{questions} = $sorted_q;

    return ($ssb);

}

# delete_scoring_data($student,$copy) deletes all scoring data

# relative to a particular answer sheet.

sub delete_scoring_data {

    my ( $self, $student, $copy ) = @_;

    for my $part (qw/Scores Marks Codes/) {

        $self->statement( 'delete' . $part )->execute( $student, $copy );

    }

}

# set_external_score($student, $copy, $question, $score) sets a score

# to a particular question, from external data.

sub set_external_score {

    my ( $self, $student, $copy, $question, $score ) = @_;

    $self->statement('setExternal')

      ->execute( $student, $copy, $question, $score );

}

# get_external_score($student, $copy, $question) gets the external

# score associated with a particular question.

sub get_external_score {

    my ( $self, $student, $copy, $question ) = @_;

    return (

        $self->sql_single(

            $self->statement('getExternal'),

            $student, $copy, $question

        )

    );

}

# n_external() returns an array containing the number of external

# scores, and the number of students with external scores.

sub n_external {

    my ($self) = @_;

    return (

        @{

            $self->dbh->selectall_arrayref( $self->statement('nExternal'), {} )

              ->[0]

        }

    );

}

# delete_external() deletes all external scoring data

sub delete_external {

    my ($self) = @_;

    $self->statement('deleteExternal')->execute();

}

# forget_marks() deletes all scoring data from all students

sub forget_marks {

    my ($self) = @_;

    for my $t (qw/mark code score external/) {

        $self->sql_do("DELETE FROM ".$self->table($t));

    }

}

# add_question_external_score($q) adds the external score to a

# question hashref

sub add_question_external_score {

    my ( $self, $student, $copy, $q ) = @_;

    my $x = $self->get_external_score( $student, $copy, $q->{question} );

    if ( defined($x) && $x ne '' ) {

        $q->{external} = $x;

    }

}

# questions_n_answers returns an array of hashrefs with, for each

# question, the question number ({question}), the question id

# ({title}) and the maximum number of answers ({nanswers}, not

# counting the "None of the above")

sub questions_n_answers {

    my ( $self ) = @_;

    return (

        @{

            $self->dbh->selectall_arrayref(

                $self->statement('QnAnswers'), { Slice => {} },

            )

        }

    );

}

# question_first_student(qid) returns the first student number that

# includes this question

sub question_first_student {

    my ( $self, $question ) = @_;

    return (

        $self->sql_single( $self->statement('QfirstStudent'), $question )

    );

}

# question_info($student,$question) returns type, indicative, strategy

# for one particular question.

sub question_info {

    my ( $self, $student, $question ) = @_;

    return (

        $self->dbh->selectrow_array( $self->statement('Qall'), {},

            $student, $question )

    );

}

# answers_info($student, $question) returns an arrayref to hashrefs

# with info (answer, correct, strategy) for each answer corresponding

# to a particular question.