Parent Directory
| 
Revision Log
created PG::init_translator, which takes care of bootstrapping a PG::Translator object. It is very sexy on the outside, and very hairy on the inside. -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 use base qw(Exporter); 13 our @EXPORT = qw(init_translator); 14 our @EXPORT_OK = qw(); 15 16 sub init_translator($$$$$) { 17 my $courseEnv = shift; 18 my $userName = shift; 19 my $setName = shift; 20 my $problemNumber = shift; 21 my $formData = shift; 22 23 # get database information 24 my $classlist = WeBWorK::DB::Classlist->new($courseEnv); 25 my $wwdb = WeBWorK::DB::WW->new($courseEnv); 26 my $user = $classlist->getUser($userName); 27 my $set = $wwdb->getSet($userName, $setName); 28 my $problem = $wwdb->getProblem($userName, $setName, $problemNumber); 29 my $psvn = $wwdb->getPSVN($userName, $setName); 30 31 # create a Translator 32 my $translator = WeBWorK::PG::Translator->new; 33 34 # give it a directory hash 35 $translator->rh_directories({ 36 courseScriptsDirectory => $courseEnv->{webworkDirs}->{macros}, 37 macroDirectory => $courseEnv->{courseDirs}->{macros}, 38 templateDirectory => $courseEnv->{courseDirs}->{templates}, 39 tempDirectory => $courseEnv->{courseDirs}->{html_temp}, 40 }); 41 42 # give it modules to evaluate 43 # give it "extra packages" to load 44 my $modules = $courseEnv->{pg}->{modules}; 45 foreach $module (keys %$modules) { 46 my $main_package_loaded = 0; 47 foreach $package (@{$modules->{$module}}) { 48 if ($package eq $module) { 49 # this is the main package 50 $translator->evaluate_modules($package); 51 $main_package_loaded = 1; 52 } else { 53 # this is an "extra" package 54 if ($main_package_loaded) { 55 $translator->load_extra_packages($package); 56 } else { 57 warn "Can't load extra package $package: module $module hasn't been evaluated."; 58 } 59 60 } 61 } 62 } 63 64 # give it an environment (from defineProblemEnvir) 65 $translator->environment( 66 defineProblemEnvir($courseEnv, $user, $set, $problem, $psvn, $formData) 67 ); 68 69 # initialize it 70 $translator->initialize(); 71 72 # have it "unrestricted load" PG.pl and dangerousMacros.pl 73 my $pg_pl = $courseEnv->{webworkDirs}->{macros} . "/PG.pl"; 74 my $dangerousMacros_pl = $courseEnv->{webworkDirs}->{macros} . "/dangerousMacros.pl" 75 my $err = $translator->unrestricted_load($pg_pl); 76 warn "Error while loading $pg_pl: $err" if $err; 77 $err = $translator->unrestricted_load($dangerousMacros_pl); 78 warn "Error while loading $dangerousMacros_pl: $err" if $err; 79 80 # give it an opcode mask (using default values) 81 $translator->set_mask(); 82 83 # give it the problem source 84 my $sourceFile = $courseEnv->{courseDirs}->{templates}."/".$problem->source_file; 85 $translator->source_string(readFile($sourceFile)); 86 87 # install a safety filter (&safetyFilter) 88 $translator->rf_safety_filter(\&safetyFilter); 89 90 # return the translator 91 return $translator; 92 } 93 94 # ----- 95 96 sub defineProblemEnvir($$$$$$) { 97 my $courseEnv = shift; 98 my $user = shift; 99 my $set = shift; 100 my $problem = shift; 101 my $psvn = shift; 102 my $form = shift; 103 104 my %envir; 105 106 # PG environment variables 107 # from docs/pglanguage/pgreference/environmentvariables as of 06/25/2002 108 # any changes are noted by "ADDED:" or "REMOVED:" 109 110 # Vital state information 111 # ADDED: displayHintsQ, displaySolutionsQ, externalTTHPath 112 113 $envir{psvn} = $psvn; 114 $envir{psvnNumber} = $envir{psvn}; 115 $envir{probNum} = $problem->id; 116 $envir{questionNumber} = $envir{probNum}; 117 $envir{fileName} = $problem->source_file; 118 $envir{probFileName} = $envir{fileName}; 119 $envir{problemSeed} = $problem->problem_seed; 120 $envir{displayMode} = $form->param('Mode'); 121 $envir{languageMode} = $envir{displayMode}; 122 $envir{outputMode} = $envir{displayMode}; 123 $envir{displayHintsQ} = $form->param('ShowHint'); 124 $envir{displaySolutionsQ} = $form->param('ShowSol'); 125 $envir{externalTTHPath} = $courseEnv->{externalPrograms}->{tth}; 126 127 # Problem Information 128 # ADDED: courseName 129 130 $envir{openDate} = $set->open_date; 131 $envir{formattedOpenDate} = formatDateTime $envir{openDate}; 132 $envir{dueDate} = $set->due_date; 133 $envir{formattedDueDate} = formatDateTime $envir{dueDate}; 134 $envir{answerDate} = $set->answer_date; 135 $envir{formattedAnswerDate} = formatDateTime $envir{answerDate}; 136 $envir{numOfAttempts} = $problem->num_correct + $problem->num_incorrect; 137 $envir{problemValue} = $problem->value; 138 $envir{sessionKey} = $form->param('key'); 139 $envir{courseName} = $courseEnv->{courseName}; 140 141 # Student Information 142 # ADDED: studentID 143 144 $envir{sectionName} = $user->section; 145 $envir{sectionNumber} = $envir{sectionName}; 146 $envir{recitationName} = $user->recitation; 147 $envir{recitationNumber} = $envir{recitationName}; 148 $envir{setNumber} = $set->id; 149 $envir{studentLogin} = $user->id; 150 $envir{studentName} = $user->first_name . " " . $user->last_name; 151 $envir{studentID} = $user->student_id 152 153 # Answer Information 154 155 $envir{inputs_ref} = {}; # *** keys like "Answer1" 156 $envir{refSubmittedAnswers} = {}; # *** keys like "AnSwEr1" 157 158 # Default values for evaluating answers 159 160 my $ansEvalDefaults = $courseEnv->{pg}->{ansEvalDefaults}; 161 $envir{$_} = $ansEvalDefaults->{$_} foreach (keys %$ansEvalDefaults); 162 163 # Directories and URLs 164 # REMOVED: courseName 165 166 $envir{cgiDirectory} = undef; 167 $envir{cgiURL} = undef; 168 $envir{classDirectory} = undef; 169 $envir{courseScriptsDirectory} = $courseEnv->{webworkDirs}->{macros}; 170 $envir{htmlDirectory} = $courseEnv->{courseDirs}->{html}; 171 $envir{htmlURL} = $courseEnv->{courseURLs}->{html}; 172 $envir{macroDirectory} = $courseEnv->{courseDirs}->{macros}; 173 $envir{templateDirectory} = $courseEnv->{courseDirs}->{templates}; 174 $envir{tempDirectory} = $courseEnv->{courseDirs}->{html_temp}; 175 $envir{tempURL} = $courseEnv->{courseURLs}->{html_temp}; 176 $envir{scriptDirectory} = undef; 177 $envir{webworkDocsURL} = $courseEnv->{webworkURLs}->{docs}; 178 179 return \%envir; 180 } 181 182 sub safetyFilter { 183 my $answer = shift; # accepts one answer and checks it 184 my $submittedAnswer = $answer; 185 $answer = '' unless defined $answer; 186 my ($errorno); 187 $answer =~ tr/\000-\037/ /; 188 # Return if answer field is empty 189 unless ($answer =~ /\S/) { 190 #$errorno = "<BR>No answer was submitted."; 191 $errorno = 0; ## don't report blank answer as error 192 return ($answer,$errorno); 193 } 194 # replace ^ with ** (for exponentiation) 195 # $answer =~ s/\^/**/g; 196 # Return if forbidden characters are found 197 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { 198 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; 199 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>"; 200 return ($answer,$errorno); 201 } 202 $errorno = 0; 203 return($answer, $errorno); 204 } 205 206 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |