[system] / trunk / webwork2 / lib / WeBWorK / PG.pm Repository:
ViewVC logotype

Diff of /trunk/webwork2/lib/WeBWorK/PG.pm

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

Revision 415 Revision 424
1package WeBWork::PG; 1package WeBWorK::PG;
2 2
3# hide PG::* from the not-yet-insane. 3# hide PG::* from the not-yet-insane.
4 4
5use strict; 5use strict;
6use warnings; 6use warnings;
7use WeBWorK::Utils qw(readFile formatDateTime); 7use WeBWorK::Utils qw(readFile formatDateTime);
8use WeBWorK::DB::Classlist; 8use WeBWorK::DB::Classlist;
9use WeBWorK::DB::WW; 9use WeBWorK::DB::WW;
10use WeBWorK::PG::Translator; 10use WeBWorK::PG::Translator;
11 11
12sub new($$$$$$) { 12sub new($$$$$$$$) {
13 my $invocant = shift; 13 my $invocant = shift;
14 my $class = ref($invocant) || $invocant; 14 my $class = ref($invocant) || $invocant;
15 15 my (
16 my $courseEnv = shift; 16 $courseEnv,
17 my $userName = shift; 17 $userName,
18 my $setName = shift; 18 $key,
19 my $problemNumber = shift; 19 $setName,
20 my $formData = shift; 20 $problemNumber,
21 $translationOptions, # hashref containing options for the
22 # translator, such as whether to show
23 # hints and the display mode to use
24 $formFields, # in CGI::Vars format
25 ) = @_;
21 26
22 # get database information 27 # get database information
23 my $classlist = WeBWorK::DB::Classlist->new($courseEnv); 28 my $classlist = WeBWorK::DB::Classlist->new($courseEnv);
24 my $wwdb = WeBWorK::DB::WW->new($courseEnv); 29 my $wwdb = WeBWorK::DB::WW->new($courseEnv);
25 my $user = $classlist->getUser($userName); 30 my $user = $classlist->getUser($userName);
26 my $set = $wwdb->getSet($userName, $setName); 31 my $set = $wwdb->getSet($userName, $setName);
27 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 32 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
28 my $psvn = $wwdb->getPSVN($userName, $setName); 33 my $psvn = $wwdb->getPSVN($userName, $setName);
29 34
30 # create a Translator 35 # create a Translator
36 warn "PG: creating a Translator\n";
31 my $translator = WeBWorK::PG::Translator->new; 37 my $translator = WeBWorK::PG::Translator->new;
32 38
33 # give it a directory hash 39 # set the directory hash
40 warn "PG: setting the directory hash\n";
34 $translator->rh_directories({ 41 $translator->rh_directories({
35 courseScriptsDirectory => $courseEnv->{webworkDirs}->{macros}, 42 courseScriptsDirectory => $courseEnv->{webworkDirs}->{macros},
36 macroDirectory => $courseEnv->{courseDirs}->{macros}, 43 macroDirectory => $courseEnv->{courseDirs}->{macros},
37 templateDirectory => $courseEnv->{courseDirs}->{templates}, 44 templateDirectory => $courseEnv->{courseDirs}->{templates},
38 tempDirectory => $courseEnv->{courseDirs}->{html_temp}, 45 tempDirectory => $courseEnv->{courseDirs}->{html_temp},
39 }); 46 });
40 47
41 # give it modules to evaluate 48 # evaluate modules and "extra packages"
42 # give it "extra packages" to load 49 warn "PG: evaluating modules and \"extra packages\"\n";
43 my $modules = $courseEnv->{pg}->{modules}; 50 my @modules = @{ $courseEnv->{pg}->{modules} };
44 foreach $module (keys %$modules) { 51 foreach my $module_packages (@modules) {
45 my $main_package_loaded = 0; 52 # the first item in $module_packages is the main package
46 foreach $package (@{$modules->{$module}}) {
47 if ($package eq $module) {
48 # this is the main package
49 $translator->evaluate_modules($package); 53 $translator->evaluate_modules(shift @$module_packages);
50 $main_package_loaded = 1; 54 # the remaining items are "extra" packages
51 } else {
52 # this is an "extra" package
53 if ($main_package_loaded) {
54 $translator->load_extra_packages($package); 55 $translator->load_extra_packages(@$module_packages);
55 } else {
56 warn "Can't load extra package $package: module $module hasn't been evaluated.";
57 }
58
59 }
60 }
61 } 56 }
62 57
63 # give it an environment (from defineProblemEnvir) 58 # set the environment (from defineProblemEnvir)
64 $translator->environment( 59 warn "PG: setting the environment (from defineProblemEnvir)\n";
65 defineProblemEnvir($courseEnv, $user, $set, $problem, $psvn, $formData) 60 $translator->environment(defineProblemEnvir(
66 ); 61 $courseEnv, $user, $key, $set, $problem, $psvn, $formFields, $translationOptions));
67 62
68 # initialize it 63 # initialize the Translator
64 warn "PG: initializing the Translator\n";
69 $translator->initialize(); 65 $translator->initialize();
70 66
71 # have it "unrestricted load" PG.pl and dangerousMacros.pl 67 # load PG.pl and dangerousMacros.pl using unrestricted_load
68 warn "PG: loading PG.pl and dangerousMacros.pl using unrestricted_load\n";
72 my $pg_pl = $courseEnv->{webworkDirs}->{macros} . "/PG.pl"; 69 my $pg_pl = $courseEnv->{webworkDirs}->{macros} . "/PG.pl";
73 my $dangerousMacros_pl = $courseEnv->{webworkDirs}->{macros} . "/dangerousMacros.pl" 70 my $dangerousMacros_pl = $courseEnv->{webworkDirs}->{macros} . "/dangerousMacros.pl";
74 my $err = $translator->unrestricted_load($pg_pl); 71 my $err = $translator->unrestricted_load($pg_pl);
75 warn "Error while loading $pg_pl: $err" if $err; 72 warn "Error while loading $pg_pl: $err" if $err;
76 $err = $translator->unrestricted_load($dangerousMacros_pl); 73 $err = $translator->unrestricted_load($dangerousMacros_pl);
77 warn "Error while loading $dangerousMacros_pl: $err" if $err; 74 warn "Error while loading $dangerousMacros_pl: $err" if $err;
78 75
79 # give it an opcode mask (using default values) 76 # set the opcode mask (using default values)
77 warn "PG: setting the opcode mask (using default values)\n";
80 $translator->set_mask(); 78 $translator->set_mask();
81 79
82 # give it the problem source 80 # store the problem source
81 warn "PG: storing the problem source\n";
83 my $sourceFile = $courseEnv->{courseDirs}->{templates}."/".$problem->source_file; 82 my $sourceFile = $courseEnv->{courseDirs}->{templates}."/".$problem->source_file;
84 $translator->source_string(readFile($sourceFile)); 83 $translator->source_string(readFile($sourceFile));
85 84
86 # install a safety filter (&safetyFilter) 85 # install a safety filter (&safetyFilter)
86 warn "PG: installing a safety filter\n";
87 $translator->rf_safety_filter(\&safetyFilter); 87 $translator->rf_safety_filter(\&safetyFilter);
88 88
89 # translate the PG source into text 89 # translate the PG source into text
90 warn "PG: translating the PG source into text\n";
90 $translator->translate(); 91 $translator->translate();
91 92
92 # install a grader 93 # [in Problem.pm and processProblem8.pl, "install a grader" is here]
93 my $grader = $courseEnv->{pg}->{grader};
94 $translator->rf_problem_grader(\&FIXME); # *** need a coderef!
95 94
96 # process student answers (if any) 95 # process student answers
96 warn "PG: processing student answers\n";
97 $translator->process_answers($formData); 97 $translator->process_answers($formFields);
98 98
99 # a PG object is a REFERENCE to a Translator object 99 # retrieve the problem state and give it to the translator
100 return bless \$translator, $class; 100 warn "PG: retrieving the problem state and giving it to the translator\n";
101 $translator->rh_problem_state({
102 recorded_score => $problem->status,
103 num_of_correct_ans => $problem->num_correct,
104 num_of_incorrect_ans => $problem->num_incorrect,
105 });
106
107 # determine an entry order -- the ANSWER_ENTRY_ORDER flag is built by
108 # the PG macro package (PG.pl)
109 warn "PG: determining an entry order\n";
110 my @answerOrder =
111 $translator->rh_flags->{ANSWER_ENTRY_ORDER}
112 ? @{ $translator->rh_flags->{ANSWER_ENTRY_ORDER} }
113 : keys %{ $translator->rh_evaluated_answers };
114
115 # install a grader -- use the one specified in the problem,
116 # or fall back on the default from the course environment.
117 # (two magic strings are accepted, to avoid having to
118 # reference code when it would be difficult.)
119 warn "PG: installing a grader\n";
120 my $grader = $translator->rh_flags->{PROBLEM_GRADER_TO_USE}
121 || $courseEnv->{pg}->{options}->{grader};
122 $grader = $translator->rf_std_problem_grader
123 if $grader eq "std_problem_grader";
124 $grader = $translator->rf_avg_problem_grader
125 if $grader eq "avg_problem_grader";
126 die "Problem grader $grader is not a CODE reference."
127 unless ref $grader eq "CODE";
128 $translator->rf_problem_grader($grader);
129
130 # grading the problem
131 warn "PG: grade the problem\n";
132 my ($result, $state) = $translator->grade_problem(
133 answers_submitted => $translationOptions->{processAnswers},
134 ANSWER_ENTRY_ORDER => \@answerOrder,
135 );
136
137 # return an object which contains the translator and the results of
138 # the translation process. this is DIFFERENT from the "format expected
139 # by Webwork.pm (and I believe processProblem8, but check.)"
140 return bless {
141 translator => $translator,
142 head_text => ${ $translator->r_header },
143 body_text => ${ $translator->r_text },
144 answers => $translator->rh_evaluated_answers,
145 result => $result,
146 state => $state,
147 errors => $translator->errors, # *** what is this doing?
148 warnings => undef, # *** gotta catch warnings eventually...
149 flags => $translator->rh_flags,
150 }, $class;
101} 151}
102 152
103# ----- 153# -----
104 154
105sub defineProblemEnvir($$$$$$) { 155sub defineProblemEnvir($$$$$$$) {
106 my $courseEnv = shift; 156 my (
107 my $user = shift; 157 $courseEnv,
108 my $set = shift; 158 $user,
109 my $problem = shift; 159 $key,
110 my $psvn = shift; 160 $set,
111 my $form = shift; 161 $problem,
162 $psvn,
163 $formFields,
164 $options,
165 ) = @_;
112 166
113 my %envir; 167 my %envir;
114 168
115 # PG environment variables 169 # PG environment variables
116 # from docs/pglanguage/pgreference/environmentvariables as of 06/25/2002 170 # from docs/pglanguage/pgreference/environmentvariables as of 06/25/2002
… …
124 $envir{probNum} = $problem->id; 178 $envir{probNum} = $problem->id;
125 $envir{questionNumber} = $envir{probNum}; 179 $envir{questionNumber} = $envir{probNum};
126 $envir{fileName} = $problem->source_file; 180 $envir{fileName} = $problem->source_file;
127 $envir{probFileName} = $envir{fileName}; 181 $envir{probFileName} = $envir{fileName};
128 $envir{problemSeed} = $problem->problem_seed; 182 $envir{problemSeed} = $problem->problem_seed;
129 $envir{displayMode} = $form->param('Mode'); 183 $envir{displayMode} = translateDisplayModeNames($options->{displayMode});
130 $envir{languageMode} = $envir{displayMode}; 184 $envir{languageMode} = $envir{displayMode};
131 $envir{outputMode} = $envir{displayMode}; 185 $envir{outputMode} = $envir{displayMode};
132 $envir{displayHintsQ} = $form->param('ShowHint'); 186 $envir{displayHintsQ} = $options->{hints};
133 $envir{displaySolutionsQ} = $form->param('ShowSol'); 187 $envir{displaySolutionsQ} = $options->{solutions};
134 $envir{externalTTHPath} = $courseEnv->{externalPrograms}->{tth}; 188 $envir{externalTTHPath} = $courseEnv->{externalPrograms}->{tth};
135 189
136 # Problem Information 190 # Problem Information
137 # ADDED: courseName 191 # ADDED: courseName
138 192
139 $envir{openDate} = $set->open_date; 193 $envir{openDate} = $set->open_date;
140 $envir{formattedOpenDate} = formatDateTime $envir{openDate}; 194 $envir{formattedOpenDate} = formatDateTime($envir{openDate});
141 $envir{dueDate} = $set->due_date; 195 $envir{dueDate} = $set->due_date;
142 $envir{formattedDueDate} = formatDateTime $envir{dueDate}; 196 $envir{formattedDueDate} = formatDateTime($envir{dueDate});
143 $envir{answerDate} = $set->answer_date; 197 $envir{answerDate} = $set->answer_date;
144 $envir{formattedAnswerDate} = formatDateTime $envir{answerDate}; 198 $envir{formattedAnswerDate} = formatDateTime($envir{answerDate});
145 $envir{numOfAttempts} = $problem->num_correct + $problem->num_incorrect; 199 $envir{numOfAttempts} = $problem->num_correct + $problem->num_incorrect;
146 $envir{problemValue} = $problem->value; 200 $envir{problemValue} = $problem->value;
147 $envir{sessionKey} = $form->param('key'); 201 $envir{sessionKey} = $key;
148 $envir{courseName} = $courseEnv->{courseName}; 202 $envir{courseName} = $courseEnv->{courseName};
149 203
150 # Student Information 204 # Student Information
151 # ADDED: studentID 205 # ADDED: studentID
152 206
… …
155 $envir{recitationName} = $user->recitation; 209 $envir{recitationName} = $user->recitation;
156 $envir{recitationNumber} = $envir{recitationName}; 210 $envir{recitationNumber} = $envir{recitationName};
157 $envir{setNumber} = $set->id; 211 $envir{setNumber} = $set->id;
158 $envir{studentLogin} = $user->id; 212 $envir{studentLogin} = $user->id;
159 $envir{studentName} = $user->first_name . " " . $user->last_name; 213 $envir{studentName} = $user->first_name . " " . $user->last_name;
160 $envir{studentID} = $user->student_id 214 $envir{studentID} = $user->student_id;
161 215
162 # Answer Information 216 # Answer Information
217 # REMOVED: refSubmittedAnswers (alledgedly unused, causes errors)
163 218
164 $envir{inputs_ref} = {}; # *** keys like "Answer1" 219 $envir{inputs_ref} = $formFields;
165 $envir{refSubmittedAnswers} = {}; # *** keys like "AnSwEr1"
166 220
167 # Default values for evaluating answers 221 # Default values for evaluating answers
168 222
169 my $ansEvalDefaults = $courseEnv->{pg}->{ansEvalDefaults}; 223 my $ansEvalDefaults = $courseEnv->{pg}->{ansEvalDefaults};
170 $envir{$_} = $ansEvalDefaults->{$_} foreach (keys %$ansEvalDefaults); 224 $envir{$_} = $ansEvalDefaults->{$_} foreach (keys %$ansEvalDefaults);
… …
173 # REMOVED: courseName 227 # REMOVED: courseName
174 228
175 $envir{cgiDirectory} = undef; 229 $envir{cgiDirectory} = undef;
176 $envir{cgiURL} = undef; 230 $envir{cgiURL} = undef;
177 $envir{classDirectory} = undef; 231 $envir{classDirectory} = undef;
178 $envir{courseScriptsDirectory} = $courseEnv->{webworkDirs}->{macros}; 232 $envir{courseScriptsDirectory} = $courseEnv->{webworkDirs}->{macros}."/";
179 $envir{htmlDirectory} = $courseEnv->{courseDirs}->{html}; 233 $envir{htmlDirectory} = $courseEnv->{courseDirs}->{html}."/";
180 $envir{htmlURL} = $courseEnv->{courseURLs}->{html}; 234 $envir{htmlURL} = $courseEnv->{courseURLs}->{html};
181 $envir{macroDirectory} = $courseEnv->{courseDirs}->{macros}; 235 $envir{macroDirectory} = $courseEnv->{courseDirs}->{macros}."/";
182 $envir{templateDirectory} = $courseEnv->{courseDirs}->{templates}; 236 $envir{templateDirectory} = $courseEnv->{courseDirs}->{templates}."/";
183 $envir{tempDirectory} = $courseEnv->{courseDirs}->{html_temp}; 237 $envir{tempDirectory} = $courseEnv->{courseDirs}->{html_temp}."/";
184 $envir{tempURL} = $courseEnv->{courseURLs}->{html_temp}; 238 $envir{tempURL} = $courseEnv->{courseURLs}->{html_temp};
185 $envir{scriptDirectory} = undef; 239 $envir{scriptDirectory} = undef;
186 $envir{webworkDocsURL} = $courseEnv->{webworkURLs}->{docs}; 240 $envir{webworkDocsURL} = $courseEnv->{webworkURLs}->{docs};
187 241
188 return \%envir; 242 return \%envir;
243}
244
245sub translateDisplayModeNames($) {
246 my $name = shift;
247 return {
248 plainText => "HTML",
249 formattedText => "HTML_tth",
250 images => "Latex2HTML"
251 }->{$name};
189} 252}
190 253
191sub safetyFilter { 254sub safetyFilter {
192 my $answer = shift; # accepts one answer and checks it 255 my $answer = shift; # accepts one answer and checks it
193 my $submittedAnswer = $answer; 256 my $submittedAnswer = $answer;
Legend:
Removed from v.415  
changed lines
  Added in v.424
aubreyja at gmail dot com
 ViewVC Help
Powered by ViewVC 1.0.9