--- trunk/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm 2002/07/03 23:24:26 423
+++ trunk/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm 2002/07/11 19:09:08 424
@@ -3,338 +3,141 @@
use strict;
use warnings;
-use Apache::Constants qw(:common);
-use WeBWorK::ContentGenerator;
+use CGI qw(:html :form);
+use WeBWorK::Utils qw(ref2string);
use WeBWorK::PG;
+use WeBWorK::Form;
-# "Classic" form fields from processProblem8.pl
+# NEW form fields
#
-# user - user ID
-# key - session key
-# course - course name
-# probSetKey - USUALLY known as the PSVN
-# probNum - problem number a.k.a. ID a.k.a. name
+# user
+# key
#
-# Mode - display mode (HTML, HTML_tth, or typeset or whatever it's called)
-# show_old_answers - whether or not student's old answers should be filled in
-# ShowAns - asks for correct answer to be shown -- only available for instructors
-# answer$i - student answers
-# showEdit - checks if the ShowEditor button should be shown and clicked
-# showSol - checks if the solution button ishould be shown and clicked
+# displayMode
+# showOldAnswers
+# showCorrectAnswers
+# showHints
+# showSolutions
#
-# source - contains modified problem source when called from the web-based problem editor
-# seed - contains problem seed when called from the web-based problem editor
-# readSourceFromHTMLQ - if true, problem is read from 'source' instead of file
-# action - submit button clicked to invoke script (alledgedly)
-# 'Save updated version'
-# 'Read problem from disk'
-# 'Submit Answers'
-# 'Preview Answers'
-# 'Preview Again'
-# probFileName - name of the PG file being edited
-# languageType - afaik, always set to 'pg'
+# submitAnswers - name of "Submit Answers" button
sub title {
- my ($self, $problem_set, $problem) = @_;
- my $r = $self->{r};
- my $user = $r->param('user');
- return "Problem $problem of problem set $problem_set for $user";
+ my ($self, $setName, $problemNumber) = @_;
+ my $userName = $self->{r}->param('user');
+ return "Problem $problemNumber of problem set $setName for $userName";
}
sub body {
- my ($self, $problem_set, $problem) = @_;
-
- # we have to call init_translator like this:
- my $pt = WeBWorK::PG->new($courseEnv, $userName, $setName, $problemNumber, $formData);
-
- #
+ my ($self, $setName, $problemNumber) = @_;
+ my $courseEnv = $self->{courseEnvironment};
+ my $r = $self->{r};
+ my $userName = $r->param('user');
- # ----- this is not a place of honor -----
+ # fix format of setName and problem
+ # (i want dennis to cut "set" and "prob" off before calling me)
+ $setName =~ s/^set//;
+ $problemNumber =~ s/^prob//;
+
+ # get database information
+ my $classlist = WeBWorK::DB::Classlist->new($courseEnv);
+ my $wwdb = WeBWorK::DB::WW->new($courseEnv);
+ my $user = $classlist->getUser($userName);
+ my $set = $wwdb->getSet($userName, $setName);
+ my $problem = $wwdb->getProblem($userName, $setName, $problemNumber);
+ my $psvn = $wwdb->getPSVN($userName, $setName);
+
+ # set options from form fields
+ my $displayMode = $r->param("displayMode") || $courseEnv->{pg}->{options}->{displayMode};
+ my $showOldAnswers = $r->param("showOldAnswers") || $courseEnv->{pg}->{options}->{showOldAnswers};
+ my $showCorrectAnswers = $r->param("showCorrectAnswers") || $courseEnv->{pg}->{options}->{showCorrectAnswers};
+ my $showHints = $r->param("showHints") || $courseEnv->{pg}->{options}->{showHints};
+ my $showSolutions = $r->param("showSolutions") || $courseEnv->{pg}->{options}->{showSolutions};
+ my $processAnswers = $r->param("submitAnswers");
+
+ # coerce form fields into CGI::Vars format
+ my $formFields = { WeBWorK::Form->new_from_paramable($r)->Vars };
+
+ # TODO:
+ # 1. enforce privs for showCorrectAnswers and showSolutions
+ # (use $PRIV = $canPRIV && $wantPRIV -- cool syntax!)
+ # 2. if answers were not submitted and there are student answers in the DB,
+ # decode them and put them into $formFields for the translator
+ # 3. Latex2HTML massaging code
+ # 4. store submitted answers hash in database for sticky answers
+ # 5. deal with the results of answer evaluation and grading :p
+ # 6. introduce a recordAnswers option, which works on the same principle as
+ # the other priv-based options
+
+ my $pg = WeBWorK::PG->new(
+ $courseEnv,
+ $r->param('user'),
+ $r->param('key'),
+ $setName,
+ $problemNumber,
+ { # translation options
+ displayMode => $displayMode,
+ showHints => $showHints,
+ showSolutions => $showSolutions,
+ processAnswers => $processAnswers,
+ },
+ $formFields
+ );
+
+# return (
+# h1("Problem.pm"),
+# table(
+# Tr(td("user"), td($r->param('userName'))),
+# Tr(td("key"), td($r->param('key'))),
+# Tr(td("set"), td($setName)),
+# Tr(td("problem"), td($problemNumber)),
+# ),
+# #pre(hash2string($pg, 0)),
+# hash2string($pg, 1),
+# );
+
+ # View options form
+ print startform("POST", $r->uri);
+ print $self->hidden_authen_fields;
+ print p("View equations as: ",
+ radio_group(
+ -name => "displayMode",
+ -values => ['plainText', 'formattedText', 'images'],
+ -default => $displayMode,
+ -labels => {
+ plainText => "plain text",
+ formattedText => "formatted text",
+ images => "images",
+ }
+ ), br(),
+ checkbox(
+ -name => "showOldAnswers",
+ -checked => $showOldAnswers,
+ -label => "Show old answers",
+ ), br(),
+ submit(-name=>'redisplay')
+ );
+ print endform();
+ print hr();
+
+ # Previous answer results
+
+
+ # Problem form
+ print startform("POST", $r->uri);
+ print $self->hidden_authen_fields;
+ print p($pg->{body_text});
+ print p(submit(-name=>"submitAnswers", -label=>"Submit Answers"));
+ print endform();
+ print hr();
+
+ # debugging stuff
+ print h2("debugging information");
+ print h3("form fields");
+ print ref2string($formFields);
+ print h3("PG object");
+ print ref2string($pg, {'WeBWorK::PG::Translator' => 1});
- # Run the problem (output the html text) but also store it within the object.
- # The correct answers are also calculated and stored within the object
- $pt ->translate();
-
- # print problem output
- print "Problem goes here\n";
- print "Problem output
\n";
- print "
";
- print ${$pt->r_text()};
- print "
";
- print "End of problem output
";
-
-
- # print source code
- print "Source code
\n";
- print $SOURCE1;
- print "
End source code";
-
- # The format for the output is described here. We'll need a local variable
- # to handle the warnings. From within the problem the warning command
- # has been slaved to the __WARNINGS__ routine which is defined in Global.
- # We'll need to provide an alternate mechanism.
- # The base64 encoding is only needed for xml transmission.
- print "
";
- print "Warnings output
";
- my $WARNINGS = "Let this be a warning:";
-
- print $WARNINGS;
-
- # Install the standard problem grader. See gage/xmlrpc/daemon.pm or processProblem8 for detailed
- # code on how to choose which problem grader to install, depending on courseEnvironment and problem data.
- # See also PG.pl which provides for problem by problem overrides.
- $pt->rf_problem_grader($pt->rf_std_problem_grader);
-
- # creates and stores a hash of answer results inside the object: $rh_answer_results
- $pt -> process_answers($rh->{envir}->{inputs_ref});
-
-
- # THE UPDATE AND GRADING LOGIC COULD USE AN OVERHAUL. IT WAS SOMEWHAT CONSTRAINED
- # BY LEGACY CONDITIONS IN THE ORIGINAL PROCESSPROBLEM8. IT'S NOT BAD
- # BUT IT COULD PROBABLY BE MADE A LITTLE MORE STRAIGHT FORWARD.
- #
- # updates the problem state stored by the translator object from the problemEnvironment data
-
- # $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score},
- # num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} ,
- # num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans}
- # } );
-
- # grade the problem (and update the problem state again.)
- #
- # Define an entry order -- the default is the order they are received from the browser.
- # (Which as I understand it is NOT guaranteed to be the Left->Right Up-> Down order we're
- # used to in the West.
-
- my %PG_FLAGS = $pt->h_flags;
- my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ?
- $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ;
- # Decide whether any answers were submitted.
- my $answers_submitted = 0;
- $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted};
- # If there are answers, grade them
- my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted,
- ANSWER_ENTRY_ORDER => $ra_answer_entry_order
- ); # grades the problem.
-
- # Output format expected by Webwork.pm (and I believe processProblem8, but check.)
- my $out = {
- text => ${$pt ->r_text()}, # encode_base64( ${$pt ->r_text()} ),
- header_text => $pt->r_header, # encode_base64( ${ $pt->r_header } ),
- answers => $pt->rh_evaluated_answers,
- errors => $pt-> errors(),
- WARNINGS => $WARNINGS, #encode_base64($WARNINGS ),
- problem_result => $rh_problem_result,
- problem_state => $rh_problem_state,
- PG_flag => \%PG_FLAGS
- };
-
- # Debugging printout of environment tables
- print "Request item
\n\n";
- print "
";
- print $self->print_form_data('| ',' | ',' |
');
- print "
\n";
- print "path info
\n";
- print $r->path_info();
- print "\n\ncourseEnvironment
\n\n";
- print pretty_print_rh($courseEnvironment);
- print "
\n\nproblemEnvironment
\n\n";
- print pretty_print_rh($problemEnvir_rh);
-
- "";
-}
-
-sub pretty_print_rh {
- my $r_input = shift;
- my $out = '';
- if ( not ref($r_input) ) {
- $out = $r_input; # not a reference
- } elsif (is_hash_ref($r_input)) {
- local($^W) = 0;
- $out .= "
";
- foreach my $key (sort keys %$r_input ) {
- $out .= "| $key | => | ".pretty_print_rh($r_input->{$key}) . " |
";
- }
- $out .="
";
- } elsif (is_array_ref($r_input) ) {
- my @array = @$r_input;
- $out .= "( " ;
- while (@array) {
- $out .= pretty_print_rh(shift @array) . " , ";
- }
- $out .= " )";
- } elsif (ref($r_input) eq 'CODE') {
- $out = "$r_input";
- } else {
- $out = $r_input;
- }
- $out;
-}
-
-sub is_hash_ref {
- my $in =shift;
- my $save_SIG_die_trap = $SIG{__DIE__};
- $SIG{__DIE__} = sub {CORE::die(@_) };
- my $out = eval{ %{ $in } };
- $out = ($@ eq '') ? 1 : 0;
- $@='';
- $SIG{__DIE__} = $save_SIG_die_trap;
- $out;
-}
-sub is_array_ref {
- my $in =shift;
- my $save_SIG_die_trap = $SIG{__DIE__};
- $SIG{__DIE__} = sub {CORE::die(@_) };
- my $out = eval{ @{ $in } };
- $out = ($@ eq '') ? 1 : 0;
- $@='';
- $SIG{__DIE__} = $save_SIG_die_trap;
- $out;
+ return "";
}
1;
-
-__END__
-
-my $foo =0;
-
-# The warning mechanism. This needs to be turned into an object of its own
-###############
-## Error message routines cribbed from CGI
-###############
-
-BEGIN { #error message routines cribbed from CGI
-
- my $CarpLevel = 0; # How many extra package levels to skip on carp.
- my $MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
-
- sub longmess {
- my $error = shift;
- my $mess = "";
- my $i = 1 + $CarpLevel;
- my ($pack,$file,$line,$sub,$eval,$require);
-
- while (($pack,$file,$line,$sub,undef,undef,$eval,$require) = caller($i++)) {
- if ($error =~ m/\n$/) {
- $mess .= $error;
- }
- else {
- if (defined $eval) {
- if ($require) {
- $sub = "require $eval";
- }
- else {
- $eval =~ s/[\\\']/\\$&/g;
- if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
- substr($eval,$MaxEvalLen) = '...';
- }
- $sub = "eval '$eval'";
- }
- }
- elsif ($sub eq '(eval)') {
- $sub = 'eval {...}';
- }
-
- $mess .= "\t$sub " if $error eq "called";
- $mess .= "$error at $file line $line\n";
- }
-
- $error = "called";
- }
-
- $mess || $error;
- }
-}
-###############
-### Our error messages for giving maximum feedback to the user for errors within problems.
-###############
-BEGIN {
- sub PG_floating_point_exception_handler { # 1st argument is signal name
- my($sig) = @_;
- print "Content-type: text/html\n\nThere was a floating point arithmetic error (exception SIG$sig )
--perhaps
- you divided by zero or took the square root of a negative number?
-
\n Use the back button to return to the previous page and recheck your entries.
\n";
- exit(0);
- }
-
- $SIG{'FPE'} = \&PG_floating_point_exception_handler;
-#!/usr/bin/perl -w
- sub PG_warnings_handler {
- my @input = @_;
- my $msg_string = longmess(@_);
- my @msg_array = split("\n",$msg_string);
- my $out_string = '';
-
- # Extra stack information is provided in this next block
- # If the warning message does NOT end in \n then a line
- # number is appended (see Perl manual about warn function)
- # The presence of the line number is detected below and extra
- # stack information is added.
- # To suppress the line number and the extra stack information
- # add \n to the end of a warn message (in .pl files. In .pg
- # files add ~~n instead
-
- if ($input[$#input]=~/line \d*\.\s*$/) {
- $out_string .= "##More details:
\n----";
- foreach my $line (@msg_array) {
- chomp($line);
- next unless $line =~/\w+\:\:/;
- $out_string .= "----" .$line . "
\n";
- }
- }
-
- $Global::WARNINGS .="* " . join("
",@input) . "
\n" . $out_string .
- "
\n--------------------------------------
\n
\n";
- $Global::background_plain_url = $Global::background_warn_url;
- $Global::bg_color = '#FF99CC'; #for warnings -- this change may come too late
- }
-
- $SIG{__WARN__}=\&PG_warnings_handler;
-
- $SIG{__DIE__} = sub {
- my $message = longmess(@_);
- $message =~ s/\n/
\n/;
- my ($package, $filename, $line) = caller();
- # use standard die for errors eminating from XML::Parser::Expat
- # it uses a trapped eval which sometimes fails -- apparently on purpose
- # and the error is handled by Expat itself. We don't want
- # to interfer with that.
-
- if ($package eq 'XML::Parser::Expat') {
- die @_;
- }
- #print "$package $filename $line \n";
- print
- "Content-type: text/html\r\n\r\n Software error
\n\n$message\n
\n
- Please inform the webwork meister.
\n
- In addition to the error message above the following warnings were detected:
-
- $Global::WARNINGS;
-
- It's sometimes hard to tell exactly what has gone wrong since the
- full error message may have been sent to
- standard error instead of to standard out.
- To debug you can
-
- - guess what went wrong and try to fix it.
-
- call the offending script directly from the command line
- of unix
-
- enable the debugging features by redefining
- \$cgiURL in Global.pm and checking the redirection scripts in
- system/cgi. This will force the standard error to be placed
- in the standard out pipe as well.
-
- Run tail -f error_log
- from the unix command line to see error messages from the webserver.
- The standard error output is being placed in the error_log file for the apache
- web server. To run this command you have to be in the directory containing the
- error_log or enter the full path name of the error_log.
- In a standard apache installation, this file is at /usr/local/apache/logs/error_log
- In a RedHat Linux installation, this file is at /var/log/httpd/error_log
- At Rochester this file is at /ww/logs/error_log.
-
- Good luck.\n" ;
- };
-
-
-
-}