Parent Directory
| 
Revision Log
added HTML_img display mode. it currently generates image files using math2img (which in turn uses latex, dvips and pstoimg (which in turn uses gs, netpbm, and possibly otheres)). doesn't do any cacheing... which means it's s--l--o--w. but it works. -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 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 # External Programs 224 $envir{externalTTHPath} = $courseEnv->{externalPrograms}->{tth}; 225 $envir{externalMath2imgPath} = $courseEnv->{externalPrograms}->{math2img}; 226 227 # Directories and URLs 228 # REMOVED: courseName 229 230 $envir{cgiDirectory} = undef; 231 $envir{cgiURL} = undef; 232 $envir{classDirectory} = undef; 233 $envir{courseScriptsDirectory} = $courseEnv->{webworkDirs}->{macros}."/"; 234 $envir{htmlDirectory} = $courseEnv->{courseDirs}->{html}."/"; 235 $envir{htmlURL} = $courseEnv->{courseURLs}->{html}; 236 $envir{macroDirectory} = $courseEnv->{courseDirs}->{macros}."/"; 237 $envir{templateDirectory} = $courseEnv->{courseDirs}->{templates}."/"; 238 $envir{tempDirectory} = $courseEnv->{courseDirs}->{html_temp}."/"; 239 $envir{tempURL} = $courseEnv->{courseURLs}->{html_temp}; 240 $envir{scriptDirectory} = undef; 241 $envir{webworkDocsURL} = $courseEnv->{webworkURLs}->{docs}; 242 243 # Default values for evaluating answers 244 245 my $ansEvalDefaults = $courseEnv->{pg}->{ansEvalDefaults}; 246 $envir{$_} = $ansEvalDefaults->{$_} foreach (keys %$ansEvalDefaults); 247 248 # Other things... 249 250 $envir{PROBLEM_GRADER_TO_USE} = $courseEnv->{pg}->{options}->{grader}; 251 252 return \%envir; 253 } 254 255 sub translateDisplayModeNames($) { 256 my $name = shift; 257 return { 258 plainText => "HTML", 259 formattedText => "HTML_tth", 260 images => "HTML_img" 261 }->{$name}; 262 } 263 264 sub safetyFilter { 265 my $answer = shift; # accepts one answer and checks it 266 my $submittedAnswer = $answer; 267 $answer = '' unless defined $answer; 268 my ($errorno); 269 $answer =~ tr/\000-\037/ /; 270 # Return if answer field is empty 271 unless ($answer =~ /\S/) { 272 #$errorno = "<BR>No answer was submitted."; 273 $errorno = 0; ## don't report blank answer as error 274 return ($answer,$errorno); 275 } 276 # replace ^ with ** (for exponentiation) 277 # $answer =~ s/\^/**/g; 278 # Return if forbidden characters are found 279 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { 280 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; 281 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>"; 282 return ($answer,$errorno); 283 } 284 $errorno = 0; 285 return($answer, $errorno); 286 } 287 288 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |