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