Parent Directory
| 
Revision Log
Revision 415 - (view) (download) (as text)
| 1 : | malsyned | 353 | package WeBWorK::ContentGenerator::Problem; |
| 2 : | sh002i | 415 | use base qw(WeBWorK::ContentGenerator); |
| 3 : | malsyned | 396 | |
| 4 : | use strict; | ||
| 5 : | use warnings; | ||
| 6 : | malsyned | 353 | use Apache::Constants qw(:common); |
| 7 : | sh002i | 415 | use WeBWorK::ContentGenerator; |
| 8 : | use WeBWorK::PG; | ||
| 9 : | malsyned | 353 | |
| 10 : | sh002i | 415 | # "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 : | gage | 392 | |
| 37 : | malsyned | 353 | 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 : | sh002i | 415 | # we have to call init_translator like this: |
| 48 : | my $pt = WeBWorK::PG->new($courseEnv, $userName, $setName, $problemNumber, $formData); | ||
| 49 : | gage | 388 | |
| 50 : | sh002i | 415 | # |
| 51 : | malsyned | 396 | |
| 52 : | sh002i | 415 | # ----- this is not a place of honor ----- |
| 53 : | gage | 388 | |
| 54 : | gage | 392 | # 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 : | sh002i | 415 | $pt ->translate(); |
| 57 : | gage | 392 | |
| 58 : | sh002i | 415 | # print problem output |
| 59 : | gage | 392 | print "Problem goes here<p>\n"; |
| 60 : | print "Problem output <br>\n"; | ||
| 61 : | sh002i | 415 | print "<HR>"; |
| 62 : | gage | 392 | print ${$pt->r_text()}; |
| 63 : | sh002i | 415 | print "<HR>"; |
| 64 : | gage | 392 | print "<p>End of problem output<br>"; |
| 65 : | |||
| 66 : | |||
| 67 : | sh002i | 415 | # print source code |
| 68 : | gage | 392 | print "Source code<pre>\n"; |
| 69 : | print $SOURCE1; | ||
| 70 : | print "</pre>End source code<p>"; | ||
| 71 : | sh002i | 415 | |
| 72 : | gage | 392 | # 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 : | sh002i | 415 | print "<hr>"; |
| 78 : | gage | 392 | 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 : | sh002i | 415 | # |
| 96 : | gage | 392 | # 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 : | sh002i | 415 | # grade the problem (and update the problem state again.) |
| 104 : | # | ||
| 105 : | gage | 392 | # 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 : | malsyned | 396 | PG_flag => \%PG_FLAGS |
| 130 : | gage | 392 | }; |
| 131 : | |||
| 132 : | sh002i | 415 | # Debugging printout of environment tables |
| 133 : | gage | 392 | 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 : | gage | 388 | print "<P>\n\nproblemEnvironment<P>\n\n"; |
| 142 : | print pretty_print_rh($problemEnvir_rh); | ||
| 143 : | gage | 392 | |
| 144 : | sh002i | 415 | ""; |
| 145 : | malsyned | 353 | } |
| 146 : | |||
| 147 : | gage | 388 | 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 : | gage | 392 | |
| 195 : | sh002i | 415 | 1; |
| 196 : | gage | 392 | |
| 197 : | sh002i | 415 | __END__ |
| 198 : | gage | 392 | |
| 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 : | malsyned | 396 | #!/usr/bin/perl -w |
| 262 : | gage | 392 | 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 : | |||
| 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 |