Parent Directory
| 
Revision Log
Problem.pm/PG.pm/Translator.pm now compile and work (to some degree) changed the format of pg/modules in global.conf diddled with the format of system.template (i believe i moved an <HR>) added ref2string function to Utils.pm, removed hash2string/array2string fixed a package name in IO.pm
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 warn "PG: loading PG.pl and dangerousMacros.pl using unrestricted_load\n"; 69 my $pg_pl = $courseEnv->{webworkDirs}->{macros} . "/PG.pl"; 70 my $dangerousMacros_pl = $courseEnv->{webworkDirs}->{macros} . "/dangerousMacros.pl"; 71 my $err = $translator->unrestricted_load($pg_pl); 72 warn "Error while loading $pg_pl: $err" if $err; 73 $err = $translator->unrestricted_load($dangerousMacros_pl); 74 warn "Error while loading $dangerousMacros_pl: $err" if $err; 75 76 # set the opcode mask (using default values) 77 warn "PG: setting the opcode mask (using default values)\n"; 78 $translator->set_mask(); 79 80 # store the problem source 81 warn "PG: storing the problem source\n"; 82 my $sourceFile = $courseEnv->{courseDirs}->{templates}."/".$problem->source_file; 83 $translator->source_string(readFile($sourceFile)); 84 85 # install a safety filter (&safetyFilter) 86 warn "PG: installing a safety filter\n"; 87 $translator->rf_safety_filter(\&safetyFilter); 88 89 # translate the PG source into text 90 warn "PG: translating the PG source into text\n"; 91 $translator->translate(); 92 93 # [in Problem.pm and processProblem8.pl, "install a grader" is here] 94 95 # process student answers 96 warn "PG: processing student answers\n"; 97 $translator->process_answers($formFields); 98 99 # retrieve the problem state and give it to the translator 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; 151 } 152 153 # ----- 154 155 sub defineProblemEnvir($$$$$$$) { 156 my ( 157 $courseEnv, 158 $user, 159 $key, 160 $set, 161 $problem, 162 $psvn, 163 $formFields, 164 $options, 165 ) = @_; 166 167 my %envir; 168 169 # PG environment variables 170 # from docs/pglanguage/pgreference/environmentvariables as of 06/25/2002 171 # any changes are noted by "ADDED:" or "REMOVED:" 172 173 # Vital state information 174 # ADDED: displayHintsQ, displaySolutionsQ, externalTTHPath 175 176 $envir{psvn} = $psvn; 177 $envir{psvnNumber} = $envir{psvn}; 178 $envir{probNum} = $problem->id; 179 $envir{questionNumber} = $envir{probNum}; 180 $envir{fileName} = $problem->source_file; 181 $envir{probFileName} = $envir{fileName}; 182 $envir{problemSeed} = $problem->problem_seed; 183 $envir{displayMode} = translateDisplayModeNames($options->{displayMode}); 184 $envir{languageMode} = $envir{displayMode}; 185 $envir{outputMode} = $envir{displayMode}; 186 $envir{displayHintsQ} = $options->{hints}; 187 $envir{displaySolutionsQ} = $options->{solutions}; 188 $envir{externalTTHPath} = $courseEnv->{externalPrograms}->{tth}; 189 190 # Problem Information 191 # ADDED: courseName 192 193 $envir{openDate} = $set->open_date; 194 $envir{formattedOpenDate} = formatDateTime($envir{openDate}); 195 $envir{dueDate} = $set->due_date; 196 $envir{formattedDueDate} = formatDateTime($envir{dueDate}); 197 $envir{answerDate} = $set->answer_date; 198 $envir{formattedAnswerDate} = formatDateTime($envir{answerDate}); 199 $envir{numOfAttempts} = $problem->num_correct + $problem->num_incorrect; 200 $envir{problemValue} = $problem->value; 201 $envir{sessionKey} = $key; 202 $envir{courseName} = $courseEnv->{courseName}; 203 204 # Student Information 205 # ADDED: studentID 206 207 $envir{sectionName} = $user->section; 208 $envir{sectionNumber} = $envir{sectionName}; 209 $envir{recitationName} = $user->recitation; 210 $envir{recitationNumber} = $envir{recitationName}; 211 $envir{setNumber} = $set->id; 212 $envir{studentLogin} = $user->id; 213 $envir{studentName} = $user->first_name . " " . $user->last_name; 214 $envir{studentID} = $user->student_id; 215 216 # Answer Information 217 # REMOVED: refSubmittedAnswers (alledgedly unused, causes errors) 218 219 $envir{inputs_ref} = $formFields; 220 221 # Default values for evaluating answers 222 223 my $ansEvalDefaults = $courseEnv->{pg}->{ansEvalDefaults}; 224 $envir{$_} = $ansEvalDefaults->{$_} foreach (keys %$ansEvalDefaults); 225 226 # Directories and URLs 227 # REMOVED: courseName 228 229 $envir{cgiDirectory} = undef; 230 $envir{cgiURL} = undef; 231 $envir{classDirectory} = undef; 232 $envir{courseScriptsDirectory} = $courseEnv->{webworkDirs}->{macros}."/"; 233 $envir{htmlDirectory} = $courseEnv->{courseDirs}->{html}."/"; 234 $envir{htmlURL} = $courseEnv->{courseURLs}->{html}; 235 $envir{macroDirectory} = $courseEnv->{courseDirs}->{macros}."/"; 236 $envir{templateDirectory} = $courseEnv->{courseDirs}->{templates}."/"; 237 $envir{tempDirectory} = $courseEnv->{courseDirs}->{html_temp}."/"; 238 $envir{tempURL} = $courseEnv->{courseURLs}->{html_temp}; 239 $envir{scriptDirectory} = undef; 240 $envir{webworkDocsURL} = $courseEnv->{webworkURLs}->{docs}; 241 242 return \%envir; 243 } 244 245 sub translateDisplayModeNames($) { 246 my $name = shift; 247 return { 248 plainText => "HTML", 249 formattedText => "HTML_tth", 250 images => "Latex2HTML" 251 }->{$name}; 252 } 253 254 sub safetyFilter { 255 my $answer = shift; # accepts one answer and checks it 256 my $submittedAnswer = $answer; 257 $answer = '' unless defined $answer; 258 my ($errorno); 259 $answer =~ tr/\000-\037/ /; 260 # Return if answer field is empty 261 unless ($answer =~ /\S/) { 262 #$errorno = "<BR>No answer was submitted."; 263 $errorno = 0; ## don't report blank answer as error 264 return ($answer,$errorno); 265 } 266 # replace ^ with ** (for exponentiation) 267 # $answer =~ s/\^/**/g; 268 # Return if forbidden characters are found 269 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { 270 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; 271 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>"; 272 return ($answer,$errorno); 273 } 274 $errorno = 0; 275 return($answer, $errorno); 276 } 277 278 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |