[system] / branches / rel-2-4-patches / webwork-modperl / lib / WeBWorK / PG.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-4-patches/webwork-modperl/lib/WeBWorK/PG.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 555 Revision 558
… …
35 $translationOptions, # hashref containing options for the 35 $translationOptions, # hashref containing options for the
36 # translator, such as whether to show 36 # translator, such as whether to show
37 # hints and the display mode to use 37 # hints and the display mode to use
38 ) = @_; 38 ) = @_;
39 39
40# # get database information 40 # install a local warn handler to collect warnings
41# my $classlist = WeBWorK::DB::Classlist->new($courseEnv); 41 my $warnings = "";
42# my $wwdb = WeBWorK::DB::WW->new($courseEnv); 42 local $SIG{__WARN__} = sub { $warnings .= shift };
43# my $user = $classlist->getUser($userName);
44# my $set = $wwdb->getSet($userName, $setName);
45# my $psvn = $wwdb->getPSVN($userName, $setName);
46#
47# my $problem;
48# if ($problemNumber =~ /^\d+$/) {
49# $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
50# } else {
51# # This is the fun part: if $problemNumber is NON-NUMERIC, the
52# # user wants to specify a PG file directly. We manufacture a
53# # Problem object using fake data and the specified source file.
54# # This is potentially dangerous since an untrusted user is
55# # allowed to specifiy an arbitrary file to be evaluated as PG.
56# # A user of PG.pm MUST MAKE SURE that if $problemNumber is
57# # supplied by an untrusted source (i.e. the Apache request),
58# # it is numberic. A simple
59# #
60# # die unless $problemNumber =~ /^\d+$/;
61# #
62# # should suffice.
63# $problem = WeBWorK::Problem->new(
64# id => 0,
65# set_id => $set->id,
66# login_id => $user->id,
67# source_file => $problemNumber,
68# # the rest of Problem's fields are not needed
69# );
70# }
71 43
72 # create a Translator 44 # create a Translator
73 warn "PG: creating a Translator\n"; 45 #warn "PG: creating a Translator\n";
74 my $translator = WeBWorK::PG::Translator->new; 46 my $translator = WeBWorK::PG::Translator->new;
75 47
76 # set the directory hash 48 # set the directory hash
77 warn "PG: setting the directory hash\n"; 49 #warn "PG: setting the directory hash\n";
78 $translator->rh_directories({ 50 $translator->rh_directories({
79 courseScriptsDirectory => $courseEnv->{webworkDirs}->{macros}, 51 courseScriptsDirectory => $courseEnv->{webworkDirs}->{macros},
80 macroDirectory => $courseEnv->{courseDirs}->{macros}, 52 macroDirectory => $courseEnv->{courseDirs}->{macros},
81 templateDirectory => $courseEnv->{courseDirs}->{templates}, 53 templateDirectory => $courseEnv->{courseDirs}->{templates},
82 tempDirectory => $courseEnv->{courseDirs}->{html_temp}, 54 tempDirectory => $courseEnv->{courseDirs}->{html_temp},
83 }); 55 });
84 56
85 # evaluate modules and "extra packages" 57 # evaluate modules and "extra packages"
86 warn "PG: evaluating modules and \"extra packages\"\n"; 58 #warn "PG: evaluating modules and \"extra packages\"\n";
87 my @modules = @{ $courseEnv->{pg}->{modules} }; 59 my @modules = @{ $courseEnv->{pg}->{modules} };
88 foreach my $module_packages_ref (@modules) { 60 foreach my $module_packages_ref (@modules) {
89 my ($module, @extra_packages) = @$module_packages_ref; 61 my ($module, @extra_packages) = @$module_packages_ref;
90 # the first item is the main package 62 # the first item is the main package
91 $translator->evaluate_modules($module); 63 $translator->evaluate_modules($module);
92 # the remaining items are "extra" packages 64 # the remaining items are "extra" packages
93 $translator->load_extra_packages(@extra_packages); 65 $translator->load_extra_packages(@extra_packages);
94 } 66 }
95 67
96 # set the environment (from defineProblemEnvir) 68 # set the environment (from defineProblemEnvir)
97 warn "PG: setting the environment (from defineProblemEnvir)\n"; 69 #warn "PG: setting the environment (from defineProblemEnvir)\n";
98 my $envir = defineProblemEnvir( 70 my $envir = defineProblemEnvir(
99 $courseEnv, 71 $courseEnv,
100 $user, 72 $user,
101 $key, 73 $key,
102 $set, 74 $set,
… …
106 $translationOptions, 78 $translationOptions,
107 ); 79 );
108 $translator->environment($envir); 80 $translator->environment($envir);
109 81
110 # initialize the Translator 82 # initialize the Translator
111 warn "PG: initializing the Translator\n"; 83 #warn "PG: initializing the Translator\n";
112 $translator->initialize(); 84 $translator->initialize();
113 85
114 # load PG.pl and dangerousMacros.pl using unrestricted_load 86 # load PG.pl and dangerousMacros.pl using unrestricted_load
115 # i'd like to change this at some point to have the same sort of interface to global.conf 87 # i'd like to change this at some point to have the same sort of interface to global.conf
116 # that the module loading does -- have a list of macros to load unrestrictedly. 88 # that the module loading does -- have a list of macros to load unrestrictedly.
117 warn "PG: loading PG.pl and dangerousMacros.pl using unrestricted_load\n"; 89 #warn "PG: loading PG.pl and dangerousMacros.pl using unrestricted_load\n";
118 my $pg_pl = $courseEnv->{webworkDirs}->{macros} . "/PG.pl"; 90 my $pg_pl = $courseEnv->{webworkDirs}->{macros} . "/PG.pl";
119 my $dangerousMacros_pl = $courseEnv->{webworkDirs}->{macros} . "/dangerousMacros.pl"; 91 my $dangerousMacros_pl = $courseEnv->{webworkDirs}->{macros} . "/dangerousMacros.pl";
120 my $err = $translator->unrestricted_load($pg_pl); 92 my $err = $translator->unrestricted_load($pg_pl);
121 warn "Error while loading $pg_pl: $err" if $err; 93 warn "Error while loading $pg_pl: $err" if $err;
122 $err = $translator->unrestricted_load($dangerousMacros_pl); 94 $err = $translator->unrestricted_load($dangerousMacros_pl);
123 warn "Error while loading $dangerousMacros_pl: $err" if $err; 95 warn "Error while loading $dangerousMacros_pl: $err" if $err;
124 96
125 # set the opcode mask (using default values) 97 # set the opcode mask (using default values)
126 warn "PG: setting the opcode mask (using default values)\n"; 98 #warn "PG: setting the opcode mask (using default values)\n";
127 $translator->set_mask(); 99 $translator->set_mask();
128 100
129 # store the problem source 101 # store the problem source
130 warn "PG: storing the problem source\n"; 102 #warn "PG: storing the problem source\n";
131 my $sourceFile = $problem->source_file; 103 my $sourceFile = $problem->source_file;
132 $sourceFile = $courseEnv->{courseDirs}->{templates}."/".$sourceFile 104 $sourceFile = $courseEnv->{courseDirs}->{templates}."/".$sourceFile
133 unless ($sourceFile =~ /^\//); 105 unless ($sourceFile =~ /^\//);
134 eval { $translator->source_string(readFile($sourceFile)) }; 106 eval { $translator->source_string(readFile($sourceFile)) };
135 if ($@) { 107 if ($@) {
… …
143EOF 115EOF
144 answers => {}, 116 answers => {},
145 result => {}, 117 result => {},
146 state => {}, 118 state => {},
147 errors => "Failed to read the problem source file.", 119 errors => "Failed to read the problem source file.",
148 warnings => undef, 120 warnings => $warnings,
149 flags => {error_flag => 1}, 121 flags => {error_flag => 1},
150 }, $class; 122 }, $class;
151 } 123 }
152 124
153 # install a safety filter (&safetyFilter) 125 # install a safety filter (&safetyFilter)
154 warn "PG: installing a safety filter\n"; 126 #warn "PG: installing a safety filter\n";
155 $translator->rf_safety_filter(\&safetyFilter); 127 $translator->rf_safety_filter(\&safetyFilter);
156 128
157 # translate the PG source into text 129 # translate the PG source into text
158 warn "PG: translating the PG source into text\n"; 130 #warn "PG: translating the PG source into text\n";
159 $translator->translate(); 131 $translator->translate();
160 132
161 # after we're done translating, we may have to clean up after the translator. 133 # after we're done translating, we may have to clean up after the translator.
162 # for example, 'images' mode uses a tempdir for dvipng's temp files. We have 134 # for example, 'images' mode uses a tempdir for dvipng's temp files. We have
163 # to remove it. 135 # to remove it.
164 if ($translationOptions->{displayMode} eq 'images' && $envir->{dvipngTempDir}) { 136 if ($translationOptions->{displayMode} eq 'images' && $envir->{dvipngTempDir}) {
165 rmtree($envir->{dvipngTempDir}, 0, 1); 137 rmtree($envir->{dvipngTempDir}, 0, 0);
166 } 138 }
167 139
168 my ($result, $state); # we'll need these on the other side of the if block! 140 my ($result, $state); # we'll need these on the other side of the if block!
169 if ($translationOptions->{processAnswers}) { 141 if ($translationOptions->{processAnswers}) {
170 142
171 # process student answers 143 # process student answers
172 warn "PG: processing student answers\n"; 144 #warn "PG: processing student answers\n";
173 $translator->process_answers($formFields); 145 $translator->process_answers($formFields);
174 146
175 # retrieve the problem state and give it to the translator 147 # retrieve the problem state and give it to the translator
176 warn "PG: retrieving the problem state and giving it to the translator\n"; 148 #warn "PG: retrieving the problem state and giving it to the translator\n";
177 $translator->rh_problem_state({ 149 $translator->rh_problem_state({
178 recorded_score => $problem->status, 150 recorded_score => $problem->status,
179 num_of_correct_ans => $problem->num_correct, 151 num_of_correct_ans => $problem->num_correct,
180 num_of_incorrect_ans => $problem->num_incorrect, 152 num_of_incorrect_ans => $problem->num_incorrect,
181 }); 153 });
182 154
183 # determine an entry order -- the ANSWER_ENTRY_ORDER flag is built by 155 # determine an entry order -- the ANSWER_ENTRY_ORDER flag is built by
184 # the PG macro package (PG.pl) 156 # the PG macro package (PG.pl)
185 warn "PG: determining an entry order\n"; 157 #warn "PG: determining an entry order\n";
186 my @answerOrder = 158 my @answerOrder =
187 $translator->rh_flags->{ANSWER_ENTRY_ORDER} 159 $translator->rh_flags->{ANSWER_ENTRY_ORDER}
188 ? @{ $translator->rh_flags->{ANSWER_ENTRY_ORDER} } 160 ? @{ $translator->rh_flags->{ANSWER_ENTRY_ORDER} }
189 : keys %{ $translator->rh_evaluated_answers }; 161 : keys %{ $translator->rh_evaluated_answers };
190 162
191 # install a grader -- use the one specified in the problem, 163 # install a grader -- use the one specified in the problem,
192 # or fall back on the default from the course environment. 164 # or fall back on the default from the course environment.
193 # (two magic strings are accepted, to avoid having to 165 # (two magic strings are accepted, to avoid having to
194 # reference code when it would be difficult.) 166 # reference code when it would be difficult.)
195 warn "PG: installing a grader\n"; 167 #warn "PG: installing a grader\n";
196 my $grader = $translator->rh_flags->{PROBLEM_GRADER_TO_USE} 168 my $grader = $translator->rh_flags->{PROBLEM_GRADER_TO_USE}
197 || $courseEnv->{pg}->{options}->{grader}; 169 || $courseEnv->{pg}->{options}->{grader};
198 $grader = $translator->rf_std_problem_grader 170 $grader = $translator->rf_std_problem_grader
199 if $grader eq "std_problem_grader"; 171 if $grader eq "std_problem_grader";
200 $grader = $translator->rf_avg_problem_grader 172 $grader = $translator->rf_avg_problem_grader
… …
202 die "Problem grader $grader is not a CODE reference." 174 die "Problem grader $grader is not a CODE reference."
203 unless ref $grader eq "CODE"; 175 unless ref $grader eq "CODE";
204 $translator->rf_problem_grader($grader); 176 $translator->rf_problem_grader($grader);
205 177
206 # grade the problem 178 # grade the problem
207 warn "PG: grading the problem\n"; 179 #warn "PG: grading the problem\n";
208 ($result, $state) = $translator->grade_problem( 180 ($result, $state) = $translator->grade_problem(
209 answers_submitted => $translationOptions->{processAnswers}, 181 answers_submitted => $translationOptions->{processAnswers},
210 ANSWER_ENTRY_ORDER => \@answerOrder, 182 ANSWER_ENTRY_ORDER => \@answerOrder,
211 ); 183 );
212 184
… …
220 head_text => ${ $translator->r_header }, 192 head_text => ${ $translator->r_header },
221 body_text => ${ $translator->r_text }, 193 body_text => ${ $translator->r_text },
222 answers => $translator->rh_evaluated_answers, 194 answers => $translator->rh_evaluated_answers,
223 result => $result, 195 result => $result,
224 state => $state, 196 state => $state,
225 errors => $translator->errors, # *** what is this doing? 197 errors => $translator->errors,
226 warnings => undef, # *** gotta catch warnings eventually... 198 warnings => $warnings,
227 flags => $translator->rh_flags, 199 flags => $translator->rh_flags,
228 }, $class; 200 }, $class;
229} 201}
230 202
231# ----- 203# -----
… …
320 $envir{tempDirectory} = $courseEnv->{courseDirs}->{html_temp}."/"; 292 $envir{tempDirectory} = $courseEnv->{courseDirs}->{html_temp}."/";
321 $envir{tempURL} = $courseEnv->{courseURLs}->{html_temp}; 293 $envir{tempURL} = $courseEnv->{courseURLs}->{html_temp};
322 $envir{scriptDirectory} = undef; 294 $envir{scriptDirectory} = undef;
323 $envir{webworkDocsURL} = $courseEnv->{webworkURLs}->{docs}; 295 $envir{webworkDocsURL} = $courseEnv->{webworkURLs}->{docs};
324 $envir{dvipngTempDir} = $options->{displayMode} eq 'images' 296 $envir{dvipngTempDir} = $options->{displayMode} eq 'images'
325 ? tempdir("webwork-dvipng-XXXXXXXX", TMPDIR => 1) 297 ? tempdir("webwork-dvipng-XXXXXXXX", DIR => $envir{tempDirectory})
326 : undef; 298 : undef;
327 299
328 # Default values for evaluating answers 300 # Default values for evaluating answers
329 301
330 my $ansEvalDefaults = $courseEnv->{pg}->{ansEvalDefaults}; 302 my $ansEvalDefaults = $courseEnv->{pg}->{ansEvalDefaults};
Legend:
Removed from v.555  
changed lines
  Added in v.558
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9