Parent Directory
| 
Revision Log
stuff i've been working on. -sam
1 package WeBWorK::ContentGenerator::Problem; 2 use base qw(WeBWorK::ContentGenerator); 3 4 use strict; 5 use warnings; 6 use Apache::Constants qw(:common); 7 use WeBWorK::ContentGenerator; 8 use WeBWorK::PG; 9 10 # "Classic" form fields from processProblem8.pl 11 # 12 # user - user ID 13 # key - session key 14 # course - course name 15 # probSetKey - USUALLY known as the PSVN 16 # probNum - problem number a.k.a. ID a.k.a. name 17 # 18 # Mode - display mode (HTML, HTML_tth, or typeset or whatever it's called) 19 # show_old_answers - whether or not student's old answers should be filled in 20 # ShowAns - asks for correct answer to be shown -- only available for instructors 21 # answer$i - student answers 22 # showEdit - checks if the ShowEditor button should be shown and clicked 23 # showSol - checks if the solution button ishould be shown and clicked 24 # 25 # source - contains modified problem source when called from the web-based problem editor 26 # seed - contains problem seed when called from the web-based problem editor 27 # readSourceFromHTMLQ - if true, problem is read from 'source' instead of file 28 # action - submit button clicked to invoke script (alledgedly) 29 # 'Save updated version' 30 # 'Read problem from disk' 31 # 'Submit Answers' 32 # 'Preview Answers' 33 # 'Preview Again' 34 # probFileName - name of the PG file being edited 35 # languageType - afaik, always set to 'pg' 36 37 sub title { 38 my ($self, $problem_set, $problem) = @_; 39 my $r = $self->{r}; 40 my $user = $r->param('user'); 41 return "Problem $problem of problem set $problem_set for $user"; 42 } 43 44 sub body { 45 my ($self, $problem_set, $problem) = @_; 46 47 # we have to call init_translator like this: 48 my $pt = WeBWorK::PG->new($courseEnv, $userName, $setName, $problemNumber, $formData); 49 50 # 51 52 # ----- this is not a place of honor ----- 53 54 # Run the problem (output the html text) but also store it within the object. 55 # The correct answers are also calculated and stored within the object 56 $pt ->translate(); 57 58 # print problem output 59 print "Problem goes here<p>\n"; 60 print "Problem output <br>\n"; 61 print "<HR>"; 62 print ${$pt->r_text()}; 63 print "<HR>"; 64 print "<p>End of problem output<br>"; 65 66 67 # print source code 68 print "Source code<pre>\n"; 69 print $SOURCE1; 70 print "</pre>End source code<p>"; 71 72 # The format for the output is described here. We'll need a local variable 73 # to handle the warnings. From within the problem the warning command 74 # has been slaved to the __WARNINGS__ routine which is defined in Global. 75 # We'll need to provide an alternate mechanism. 76 # The base64 encoding is only needed for xml transmission. 77 print "<hr>"; 78 print "Warnings output<br>"; 79 my $WARNINGS = "Let this be a warning:"; 80 81 print $WARNINGS; 82 83 # Install the standard problem grader. See gage/xmlrpc/daemon.pm or processProblem8 for detailed 84 # code on how to choose which problem grader to install, depending on courseEnvironment and problem data. 85 # See also PG.pl which provides for problem by problem overrides. 86 $pt->rf_problem_grader($pt->rf_std_problem_grader); 87 88 # creates and stores a hash of answer results inside the object: $rh_answer_results 89 $pt -> process_answers($rh->{envir}->{inputs_ref}); 90 91 92 # THE UPDATE AND GRADING LOGIC COULD USE AN OVERHAUL. IT WAS SOMEWHAT CONSTRAINED 93 # BY LEGACY CONDITIONS IN THE ORIGINAL PROCESSPROBLEM8. IT'S NOT BAD 94 # BUT IT COULD PROBABLY BE MADE A LITTLE MORE STRAIGHT FORWARD. 95 # 96 # updates the problem state stored by the translator object from the problemEnvironment data 97 98 # $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score}, 99 # num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} , 100 # num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans} 101 # } ); 102 103 # grade the problem (and update the problem state again.) 104 # 105 # Define an entry order -- the default is the order they are received from the browser. 106 # (Which as I understand it is NOT guaranteed to be the Left->Right Up-> Down order we're 107 # used to in the West. 108 109 my %PG_FLAGS = $pt->h_flags; 110 my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ? 111 $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ; 112 # Decide whether any answers were submitted. 113 my $answers_submitted = 0; 114 $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted}; 115 # If there are answers, grade them 116 my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted, 117 ANSWER_ENTRY_ORDER => $ra_answer_entry_order 118 ); # grades the problem. 119 120 # Output format expected by Webwork.pm (and I believe processProblem8, but check.) 121 my $out = { 122 text => ${$pt ->r_text()}, # encode_base64( ${$pt ->r_text()} ), 123 header_text => $pt->r_header, # encode_base64( ${ $pt->r_header } ), 124 answers => $pt->rh_evaluated_answers, 125 errors => $pt-> errors(), 126 WARNINGS => $WARNINGS, #encode_base64($WARNINGS ), 127 problem_result => $rh_problem_result, 128 problem_state => $rh_problem_state, 129 PG_flag => \%PG_FLAGS 130 }; 131 132 # Debugging printout of environment tables 133 print "<P>Request item<P>\n\n"; 134 print "<TABLE border=\"3\">"; 135 print $self->print_form_data('<tr><td>','</td><td>','</td></tr>'); 136 print "</table>\n"; 137 print "path info <br>\n"; 138 print $r->path_info(); 139 print "<P>\n\ncourseEnvironment<P>\n\n"; 140 print pretty_print_rh($courseEnvironment); 141 print "<P>\n\nproblemEnvironment<P>\n\n"; 142 print pretty_print_rh($problemEnvir_rh); 143 144 ""; 145 } 146 147 sub pretty_print_rh { 148 my $r_input = shift; 149 my $out = ''; 150 if ( not ref($r_input) ) { 151 $out = $r_input; # not a reference 152 } elsif (is_hash_ref($r_input)) { 153 local($^W) = 0; 154 $out .= "<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">"; 155 foreach my $key (sort keys %$r_input ) { 156 $out .= "<tr><TD> $key</TD><TD>=></td><td> ".pretty_print_rh($r_input->{$key}) . "</td></tr>"; 157 } 158 $out .="</table>"; 159 } elsif (is_array_ref($r_input) ) { 160 my @array = @$r_input; 161 $out .= "( " ; 162 while (@array) { 163 $out .= pretty_print_rh(shift @array) . " , "; 164 } 165 $out .= " )"; 166 } elsif (ref($r_input) eq 'CODE') { 167 $out = "$r_input"; 168 } else { 169 $out = $r_input; 170 } 171 $out; 172 } 173 174 sub is_hash_ref { 175 my $in =shift; 176 my $save_SIG_die_trap = $SIG{__DIE__}; 177 $SIG{__DIE__} = sub {CORE::die(@_) }; 178 my $out = eval{ %{ $in } }; 179 $out = ($@ eq '') ? 1 : 0; 180 $@=''; 181 $SIG{__DIE__} = $save_SIG_die_trap; 182 $out; 183 } 184 sub is_array_ref { 185 my $in =shift; 186 my $save_SIG_die_trap = $SIG{__DIE__}; 187 $SIG{__DIE__} = sub {CORE::die(@_) }; 188 my $out = eval{ @{ $in } }; 189 $out = ($@ eq '') ? 1 : 0; 190 $@=''; 191 $SIG{__DIE__} = $save_SIG_die_trap; 192 $out; 193 } 194 195 1; 196 197 __END__ 198 199 my $foo =0; 200 201 # The warning mechanism. This needs to be turned into an object of its own 202 ############### 203 ## Error message routines cribbed from CGI 204 ############### 205 206 BEGIN { #error message routines cribbed from CGI 207 208 my $CarpLevel = 0; # How many extra package levels to skip on carp. 209 my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all. 210 211 sub longmess { 212 my $error = shift; 213 my $mess = ""; 214 my $i = 1 + $CarpLevel; 215 my ($pack,$file,$line,$sub,$eval,$require); 216 217 while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) { 218 if ($error =~ m/\n$/) { 219 $mess .= $error; 220 } 221 else { 222 if (defined $eval) { 223 if ($require) { 224 $sub = "require $eval"; 225 } 226 else { 227 $eval =~ s/[\\\']/\\$&/g; 228 if ($MaxEvalLen && length($eval) > $MaxEvalLen) { 229 substr($eval,$MaxEvalLen) = '...'; 230 } 231 $sub = "eval '$eval'"; 232 } 233 } 234 elsif ($sub eq '(eval)') { 235 $sub = 'eval {...}'; 236 } 237 238 $mess .= "\t$sub " if $error eq "called"; 239 $mess .= "$error at $file line $line\n"; 240 } 241 242 $error = "called"; 243 } 244 245 $mess || $error; 246 } 247 } 248 ############### 249 ### Our error messages for giving maximum feedback to the user for errors within problems. 250 ############### 251 BEGIN { 252 sub PG_floating_point_exception_handler { # 1st argument is signal name 253 my($sig) = @_; 254 print "Content-type: text/html\n\n<H4>There was a floating point arithmetic error (exception SIG$sig )</H4>--perhaps 255 you divided by zero or took the square root of a negative number? 256 <BR>\n Use the back button to return to the previous page and recheck your entries.<BR>\n"; 257 exit(0); 258 } 259 260 $SIG{'FPE'} = \&PG_floating_point_exception_handler; 261 #!/usr/bin/perl -w 262 sub PG_warnings_handler { 263 my @input = @_; 264 my $msg_string = longmess(@_); 265 my @msg_array = split("\n",$msg_string); 266 my $out_string = ''; 267 268 # Extra stack information is provided in this next block 269 # If the warning message does NOT end in \n then a line 270 # number is appended (see Perl manual about warn function) 271 # The presence of the line number is detected below and extra 272 # stack information is added. 273 # To suppress the line number and the extra stack information 274 # add \n to the end of a warn message (in .pl files. In .pg 275 # files add ~~n instead 276 277 if ($input[$#input]=~/line \d*\.\s*$/) { 278 $out_string .= "##More details: <BR>\n----"; 279 foreach my $line (@msg_array) { 280 chomp($line); 281 next unless $line =~/\w+\:\:/; 282 $out_string .= "----" .$line . "<BR>\n"; 283 } 284 } 285 286 $Global::WARNINGS .="* " . join("<BR>",@input) . "<BR>\n" . $out_string . 287 "<BR>\n--------------------------------------<BR>\n<BR>\n"; 288 $Global::background_plain_url = $Global::background_warn_url; 289 $Global::bg_color = '#FF99CC'; #for warnings -- this change may come too late 290 } 291 292 $SIG{__WARN__}=\&PG_warnings_handler; 293 294 $SIG{__DIE__} = sub { 295 my $message = longmess(@_); 296 $message =~ s/\n/<BR>\n/; 297 my ($package, $filename, $line) = caller(); 298 # use standard die for errors eminating from XML::Parser::Expat 299 # it uses a trapped eval which sometimes fails -- apparently on purpose 300 # and the error is handled by Expat itself. We don't want 301 # to interfer with that. 302 303 if ($package eq 'XML::Parser::Expat') { 304 die @_; 305 } 306 #print "$package $filename $line \n"; 307 print 308 "Content-type: text/html\r\n\r\n <h4>Software error</h4> <p>\n\n$message\n<p>\n 309 Please inform the webwork meister.<p>\n 310 In addition to the error message above the following warnings were detected: 311 <HR> 312 $Global::WARNINGS; 313 <HR> 314 It's sometimes hard to tell exactly what has gone wrong since the 315 full error message may have been sent to 316 standard error instead of to standard out. 317 <p> To debug you can 318 <ul> 319 <li> guess what went wrong and try to fix it. 320 <li> call the offending script directly from the command line 321 of unix 322 <li> enable the debugging features by redefining 323 \$cgiURL in Global.pm and checking the redirection scripts in 324 system/cgi. This will force the standard error to be placed 325 in the standard out pipe as well. 326 <li> Run tail -f error_log <br> 327 from the unix command line to see error messages from the webserver. 328 The standard error output is being placed in the error_log file for the apache 329 web server. To run this command you have to be in the directory containing the 330 error_log or enter the full path name of the error_log. <p> 331 In a standard apache installation, this file is at /usr/local/apache/logs/error_log<p> 332 In a RedHat Linux installation, this file is at /var/log/httpd/error_log<p> 333 At Rochester this file is at /ww/logs/error_log. 334 </ul> 335 Good luck.<p>\n" ; 336 }; 337 338 339 340 }
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |