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