Substitute.pm

DENIS Sébastien, 04/25/2022 12:02 am

Download (5.5 kB)

 
1
#! /usr/bin/perl
2
#
3
# Copyright (C) 2012-2021 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::Substitute;
25
26
use AMC::Basic;
27
28
use utf8; 
29
30
sub new {
31
    my (%o) = @_;
32
    my $self = {
33
        names   => '',
34
        scoring => '',
35
        assoc   => '',
36
        name    => '',
37
        chsign  => 4,
38
        lk      => '',
39
    };
40
41
    for ( keys %o ) {
42
        $self->{$_} = $o{$_} if ( defined( $self->{$_} ) );
43
    }
44
45
    bless $self;
46
    return ($self);
47
}
48
49
sub format_note {
50
    my ( $self, $mark ) = @_;
51
52
    if ( $self->{chsign} ) {
53
        $mark = sprintf( "%.*g", $self->{chsign}, $mark );
54
    }
55
    return ($mark);
56
}
57
58
59
# Affiche le niveau acquis pour chaque compétence entrée comme groupe
60
61
# <=25%: non maîtrisé - <70%: maîtrise incomplète - <100%: maîtrise satisfaisante - =100%: maîtrise experte
62
63
sub format_skills {
64
65
  my ($self,$student,$copy)=@_;
66
67
  my $sth = $self->{scoring}->statement('studentSkillLevel');
68
69
  $sth->execute($student, $copy);
70
71
  my $stext = "\t\t\t\t\t\t\t\t\t";
72
73
  while(my @row=$sth->fetchrow_array) { # retrieve one row
74
75
    if (scalar(split '',$stext) > 6) {$stext = $stext . "\n\t";}
76
77
    $stext = $stext . "      ";
78
79
    $stext = $stext . @row[0] . " : ";
80
81
    if (@row[1]>1) {
82
83
      $stext = $stext . "Compétence non évaluée ";
84
85
    } elsif (@row[1]>=0.75) {
86
87
      $stext = $stext . "Très bonne maîtrise 😄";
88
89
    } elsif (@row[1]>=0.5) {
90
91
      $stext = $stext . "Maîtrise satisfaisante 😊";
92
93
    } elsif (@row[1]>=0.25) {
94
95
      $stext = $stext . "Maîtrise fragile 😕";
96
97
    } else {
98
99
      $stext = $stext . "Maîtrise insuffisante 😟";
100
101
    }
102
103
  }
104
105
  return($stext);
106
107
}
108
 	
109
110
# Affiche les pourcentages de réussite par groupe, arrondi à l'entier, le minimum étant fixé à zéro
111
112
sub format_knowledge {
113
114
  my ($self,$student,$copy)=@_;
115
116
  my $sth = $self->{scoring}->statement('studentSkillLevel');
117
118
  $sth->execute($student, $copy);
119
120
  my $stext = "\n";
121
122
  while(my @row=$sth->fetchrow_array) { # retrieve one row
123
124
    if (scalar(split '',$stext) > 6) {$stext = $stext . "  —  ";}
125
126
    my $knowledge=int(@row[1]*100+.5);
127
128
    $stext = $stext . @row[0] . " : " . (0, $knowledge)[$knowledge>0] . " %";
129
130
  }
131
132
  return($stext);
133
134
}
135
136
# Affiche  le niveau acquis et le pourcentage de réussite pour chaque compétence entrée comme groupe
137
138
sub format_skills_knowledge {
139
140
  my ($self,$student,$copy)=@_;
141
142
  my $sth = $self->{scoring}->statement('studentSkillLevel');
143
144
  $sth->execute($student, $copy);
145
146
  my $stext = "\t\t\t\t\t\t\t\t\t";
147
148
  while(my @row=$sth->fetchrow_array) { # retrieve one row
149
150
    if (scalar(split '',$stext) > 6) {$stext = $stext . "\n";}
151
152
    $stext = $stext . "     ";
153
154
    $stext = $stext . @row[0] . " : ";
155
156
    if (@row[1]>1) {
157
158
      my $knowledge=int(@row[1]*100+.5);
159
160
      $stext = $stext . "Compétence non évaluée ";
161
162
    } elsif (@row[1]>=0.75) {
163
164
      my $knowledge=int(@row[1]*100+.5);
165
166
      $stext = $stext . (0, $knowledge)[$knowledge>0] . "% - ";
167
168
      $stext = $stext . "Très bonne maîtrise 😄";
169
170
   } elsif (@row[1]>=0.5) {
171
172
      my $knowledge=int(@row[1]*100+.5);
173
174
      $stext = $stext . (0, $knowledge)[$knowledge>0] . "% - ";
175
176
      $stext = $stext . "Maîtrise satisfaisante 😊";
177
178
      } elsif (@row[1]>=0.25) {
179
180
      my $knowledge=int(@row[1]*100+.5);
181
182
      $stext = $stext . (0, $knowledge)[$knowledge>0] . "% - ";
183
184
      $stext = $stext . "Maîtrise fragile 😕";
185
186
    } else {
187
188
      my $knowledge=int(@row[1]*100+.5);
189
190
      $stext = $stext . (0, $knowledge)[$knowledge>0] . "% - ";
191
192
      $stext = $stext . "Maîtrise insuffisante 😟";
193
194
    }
195
196
  }
197
198
  return($stext);
199
}
200
201
202
sub substitute {
203
    my ( $self, $text, $student, $copy ) = @_;
204
205
    if ( $self->{scoring} ) {
206
        my $student_mark = $self->{scoring}->student_global( $student, $copy );
207
208
        if ($student_mark) {
209
            $text =~ s/\%[S]/$self->format_note($student_mark->{total})/ge;
210
            $text =~ s/\%[M]/$self->format_note($student_mark->{max})/ge;
211
            $text =~ s/\%[s]/$self->format_note($student_mark->{mark})/ge;
212
	    $text =~ s/\%[m]/$self->format_note($self->{scoring}->variable('mark_max'))/ge;
213
	    $text =~ s/\%[Z]/$self->format_skills_knowledge($student, $copy)/ge;
214
        } else {
215
            debug "No marks found ! Copy="
216
              . studentids_string( $student, $copy );
217
        }
218
    }
219
220
    $text =~ s/\%[n]/$self->{name}/ge;
221
222
    if ( $self->{assoc} && $self->{names} ) {
223
        $self->{lk} = $self->{assoc}->variable('key_in_list')
224
          if ( !$self->{lk} );
225
226
        my $i = $self->{assoc}->get_real( $student, $copy );
227
        my $n;
228
229
        if ( defined($i) ) {
230
            debug "Association -> ID=$i";
231
232
            ($n) = $self->{names}->data( $self->{lk}, $i, test_numeric => 1 );
233
            if ($n) {
234
                $text = $self->{names}->substitute( $n, $text, prefix => '%' );
235
            }
236
        } else {
237
            debug "Not associated";
238
        }
239
    }
240
241
    return ($text);
242
}
243
244
1;