--- loncom/homework/lonsimpleproblemedit.pm	2003/11/08 02:56:09	1.9
+++ loncom/homework/lonsimpleproblemedit.pm	2009/09/24 00:50:03	1.26
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Simple Problem Parameter Setting "Editor"
 #
-# $Id: lonsimpleproblemedit.pm,v 1.9 2003/11/08 02:56:09 www Exp $
+# $Id: lonsimpleproblemedit.pm,v 1.26 2009/09/24 00:50:03 truskell Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -33,9 +33,14 @@ use Apache::Constants qw(:common :http);
 use Apache::loncommon;
 use Apache::lonnet;
 use Apache::lonlocal;
+use Apache::lonnavmaps;
+use lib '/home/httpd/lib/perl/';
+use LONCAPA;
+ 
 
 my %qparms;
 my $prefix;
+my $weightprefix;
 my $qtype;
 
 sub evaloptionhash {
@@ -50,32 +55,25 @@ sub evaloptionhash {
 }
 
 sub rawrendering {
-    my ($request,$uri)=@_;
-    my $problem=&Apache::lonnet::getfile
-                            (&Apache::lonnet::filelocation('',$uri));
-    &Apache::lonnet::devalidatecourseresdata(
-		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
-		     $ENV{'course.'.$ENV{'request.course.id'}.'.domain'});
-    my $uname=$ENV{'user.name'};
-    my $udom=$ENV{'user.domain'};
-    $ENV{'user.name'}=time;
-    $ENV{'user.domain'}=time;
-    my $result = &Apache::lonxml::xmlparse($request,'web', $problem);
-    undef($Apache::lonhomework::parsing_a_problem);
-    $ENV{'user.name'}=$uname;
-    $ENV{'user.domain'}=$udom;
-    $result=~s/^.*\<body[^\>]*\>//si;
-    $result=~s/\<\/body[^\>]*\>.*$//si;
-    return $result;
+    my ($symb)=@_;
+    my %data=('show_errors'=>'on',
+	      'simple_edit_button' => 'off',
+	      'devalidatecourseresdata'=>'on');
+    return &Apache::loncommon::get_student_view($symb,time,time,
+						$env{'request.course.id'},
+						'web',\%data);
 }
 
 sub questiontext {
     my $text=$qparms{$prefix.'questiontext'};
     my $qt=&mt('Question Text');
+    my $spell_link=
+	&Apache::lonhtmlcommon::spelllink('simpleedit','questiontext');
     return (<<ENDQUESTION);
-<table bgcolor="#dddd22" cellspacing="4" cellpadding="2">
+<table bgcolor="#dddd22" cellspacing="4" cellpadding="2" style="width:100%">
 <tr><td><b>$qt</b><br />
-<textarea name="questiontext" cols="80" rows="8">$text</textarea>
+<textarea style="width:100%" name="questiontext" cols="80" rows="8">$text</textarea>
+<br />$spell_link
 </td></tr>
 </table>
 <br />
@@ -85,16 +83,32 @@ ENDQUESTION
 sub hint {
     my $text=$qparms{$prefix.'hinttext'};
     my $ht=&mt('Hint Text');
+    my $spell_link=
+	&Apache::lonhtmlcommon::spelllink('simpleedit','hinttext');
     return (<<ENDHINT);
 <table bgcolor="#accacc" cellspacing="4" cellpadding="2">
 <tr><td><b>$ht</b><br />
-<textarea name="hinttext" cols="80" rows="4">$text</textarea>
+<textarea style="width:100%" name="hinttext" cols="80" rows="4">$text</textarea>
+<br />$spell_link
 </td></tr>
 </table>
 <br />
 ENDHINT
 }
 
+sub script {
+    my $text=$qparms{$prefix.'numericalscript'};
+    my $ht=&mt('Scripting (optional)');
+    return (<<ENDSCRIPT);
+<table bgcolor="#ccccaa" cellspacing="4" cellpadding="2">
+<tr><td><b>$ht</b><br />
+<textarea style="width:100%" name="numericalscript" cols="80" rows="4">$text</textarea>
+</td></tr>
+</table>
+<br />
+ENDSCRIPT
+}
+
 sub foil {
     my $number=shift;
     my %values='';
@@ -125,18 +139,36 @@ sub foil {
 				       'pos'   => 'Position',
 				       'text'  => 'Text');
 
+    my $spell_link=
+	&Apache::lonhtmlcommon::spelllink('simpleedit',"text$number");
     return (<<ENDFOIL);
 <table bgcolor="#dd55ff" cellspacing="4" cellpadding="2">
 <tr><td colspan="2"><b>$lt{'foil'}</b></td></tr>
-<tr><td>$lt{'value'}: $selectvalue</td><td>$lt{'position'}: $selectposition</td></tr>
+<tr><td>$lt{'value'}: $selectvalue</td><td>$lt{'pos'}: $selectposition</td></tr>
 <tr><td colspan="2">$lt{'text'}:<br />
-<textarea name="text$number" cols="80" rows="4">$text</textarea>
+<textarea style="width:100%" name="text$number" cols="80" rows="4">$text</textarea>
+<br />$spell_link
 </td></tr>
 </table>
 <br />
 ENDFOIL
 }
 
+sub get_parent_uri {
+    my ($cur_symb)=@_;
+    my $navmap = Apache::lonnavmaps::navmap->new();
+    if (defined($navmap)) {
+        my $it = $navmap->getIterator(undef, undef, undef, 1);
+        while ( my $res=$it->next()) {
+	    if (ref($res) &&  $res->symb() eq  $cur_symb) { last; }
+        }
+        my ($src,$symb,$anchor)=&Apache::lonnavmaps::getLinkForResource($it->getStack());
+        if (defined($anchor)) { $anchor='#'.$anchor; }
+        return $src.'?symb='.&escape($symb).$anchor;
+    }
+    return;
+}
+
 sub handler {
     my $r = shift;
 
@@ -147,7 +179,7 @@ sub handler {
     }
 
 # -------------------------------------------------------------------- Allowed?
-    unless (&Apache::lonnet::allowed('mdc',$ENV{'request.course.id'})) {
+    unless (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
 	return HTTP_NOT_ACCEPTABLE; 
     }
 # ----------------------------------------------------------------- Send header
@@ -156,75 +188,117 @@ sub handler {
 # ----------------------------------------------------- Figure out where we are
     my $uri=$r->uri;
     $uri=~s/\/smpedit$//;
-    my $symb=&Apache::lonnet::symbread($uri);
+    my $symb=&Apache::lonnet::symbread();
 
 # ------------------------------------------------ Prefix for everything stored
-    $prefix=$ENV{'request.course.id'}.'.'.$symb.'.0.';
+    $prefix=$env{'request.course.id'}.'.'.$symb.'.0.';
+#------------------------------------------------- Prefix for storing weight of Problem Parts
+    $weightprefix=$env{'request.course.id'}.'.'.$symb.'.';
+    
 # ---------------------------------------------------------- Anything to store?
 
-    if (($symb) && (defined($ENV{'form.questiontype'}))) {
+    if (($symb) && (defined($env{'form.questiontype'}))) {
         my %storecontent=();
         undef %storecontent;
-        if ($ENV{'form.questiontype'} eq 'option') {
-	    my %curoptions=&evaloptionhash($ENV{'form.options'});
-	    if ($ENV{'form.delopt'}) {
-		delete $curoptions{$ENV{'form.delopt'}};
+        if ($env{'form.questiontype'} eq 'option') {
+	    my %curoptions=&evaloptionhash($env{'form.options'});
+	    if ($env{'form.delopt'}) {
+		delete $curoptions{$env{'form.delopt'}};
 	    }
-	    if ($ENV{'form.newopt'}) {
-		$ENV{'form.newopt'}=~s/\'/\\\'/g;
-                $curoptions{$ENV{'form.newopt'}}=$ENV{'form.newopt'};
+	    if ($env{'form.newopt'}) {
+		$env{'form.newopt'}=~s/\'/\\\'/g;
+                $curoptions{$env{'form.newopt'}}=$env{'form.newopt'};
 	    }
-            $ENV{'form.options'}="('".join("','",keys %curoptions)."')";
+            $env{'form.options'}="('".join("','",keys %curoptions)."')";
 	}
-	$ENV{'form.hiddenparts'}='!'.$ENV{'form.questiontype'};
-        foreach (keys %ENV) {
+	$env{'form.hiddenparts'}='!'.$env{'form.questiontype'};
+        foreach (keys %env) {
 	    if ($_=~/^form\.(\w+)$/) {
                 my $parm=$1;
-		$storecontent{$prefix.$parm}=$ENV{'form.'.$parm};
+		$storecontent{$prefix.$parm}=$env{'form.'.$parm};
                 $storecontent{$prefix.$parm}=~s/^\s+//s;
 		$storecontent{$prefix.$parm}=~s/\s+$//s;
 	    }
 	}
+# ---------------------------------------------------- Set weights of hidden parts to zero
+# ------------------------------------------------------ and used part to 1
+	$storecontent{$weightprefix.'essay.weight'}=0;
+	$storecontent{$weightprefix.'numerical.weight'}=0;
+	$storecontent{$weightprefix.'option.weight'}=0;
+	$storecontent{$weightprefix.'radio.weight'}=0;
+	$storecontent{$weightprefix.'string.weight'}=0;
+	$storecontent{$weightprefix.$env{'form.questiontype'}.'.weight'}=1;
+
+
 	my $reply=&Apache::lonnet::cput
 	    ('resourcedata',\%storecontent,
-	     $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
-	     $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
+	     $env{'course.'.$env{'request.course.id'}.'.domain'},
+	     $env{'course.'.$env{'request.course.id'}.'.num'});
+
+        &Apache::lonnet::devalidatecourseresdata(
+                            $env{'course.'.$env{'request.course.id'}.'.num'},
+                            $env{'course.'.$env{'request.course.id'}.'.domain'});
 
     }
 # ------------------------------------------------------------------- Read Data
 
     %qparms=&Apache::lonnet::dump('resourcedata',
-		     $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
-		     $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
-		     $ENV{'request.course.id'}.'.'.$symb);
+		     $env{'course.'.$env{'request.course.id'}.'.domain'},
+		     $env{'course.'.$env{'request.course.id'}.'.num'},
+		     $env{'request.course.id'}.'.'.$symb);
 
 # ------------------------------------------------------------ Print the screen
-    $r->print(<<ENDDOCUMENT);
-<html>
-<head>
-<title>The LearningOnline Network with CAPA</title>
-ENDDOCUMENT
-    $r->print(&Apache::loncommon::bodytag('Simple Problem Editor'));
+    my $spell_header=&Apache::lonhtmlcommon::spellheader();
+    $r->print(&Apache::loncommon::start_page('Simple Problem Editor',
+					     $spell_header));
     if ($symb) {
 	$r->print('<h1>'.&Apache::lonnet::gettitle($symb).'</h1>');
+        my $displaylink = &get_parent_uri($symb);
+        if ($displaylink ne '') {
+            my $functions=&Apache::lonhtmlcommon::start_funclist()
+                         .&Apache::lonhtmlcommon::add_item_funclist(
+                              '<a href="'.$displaylink.'">'
+                             .&mt('Student View').'</a>')
+                             .&Apache::lonhtmlcommon::end_funclist();
+            $r->print(&Apache::loncommon::head_subbox($functions));
+        } else {
+            $r->print('<p class="LC_error">'
+                     .&mt('An error occurred retrieving the link to this problem.')
+                     .'<br />'
+                     .&mt('You may need to [_1]re-select the course[_2] and then return to this resource to view it.'
+                         ,'<a href="/adm/roles">','</a>')
+                     .'</p>'
+            );
+        }
+        $r->print('<p class="LC_warning">'
+                 .&mt('Note: it can take up to 10 minutes for changes to take effect for all users.')
+                 .&Apache::loncommon::help_open_topic('Caching')
+                 .'</p>'
+        );
+
 	$r->print('<table border="2" bgcolor="#FFFFFF" width="100%"><tr><td>'.
-                  &rawrendering($r,$uri).
+                  &rawrendering($symb).
                   '</td></tr></table><br />');
-        $r->print('<form method="post">');
+        $r->print('<form name="simpleedit" method="post">');
 # Question Type        
 	my %questiontypes=('radio'  => 
                                '1 out of N multiple choice (radio button)',
 			   'option' => 'Option response',
                            'string' => 'Short string response',
-                           'essay'  => 'Essay, open end');
+                           'essay'  => 'Essay, open end',
+                           'numerical' => 'Numerical response');
         $qtype=$qparms{$prefix.'questiontype'};
         unless (defined($qtype)) { $qtype='radio'; }
         unless ($questiontypes{$qtype}) { $qtype='radio'; }
         $r->print('<b>'.&mt('Question Type').
 		  ': '.&Apache::loncommon::select_form
 	                               ($qtype,'questiontype',%questiontypes).
-  '</b><br /><input type="submit" value="'.&mt('Store Changes').
+  '</b><br /><input type="submit" value="'.&mt('Save and Edit').
   '" /><p>&nbsp;</p>');
+# Script
+        if ($qtype eq 'numerical') {
+           $r->print(&script());
+        }
 # Question Text
         $r->print(&questiontext());
 # Radio, Option ===
@@ -286,20 +360,38 @@ ENDDOCUMENT
             unless ($stringtypes{$stringtype}) { $stringtype='cs'; }
 	    $r->print(
 		  '<table bgcolor="#00ee44" cellspacing="4" cellpadding="2">'.
-	          '<tr><td>'.&mt('Correct answer').': <input type="text" size="20" name="stringanswer" value="'.$stringanswer.'" />&nbsp;&nbsp;'.
+	          '<tr><td><label>'.&mt('Correct answer').': <input type="text" size="20" name="stringanswer" value="'.$stringanswer.'" /></label>&nbsp;&nbsp;'.
 		      &Apache::loncommon::select_form
 		      ($stringtype,'stringtype',%stringtypes).
 		  '</td></tr></table><br />');
 # Hint
 	    $r->print(&hint());
 	}
+        if ($qtype eq 'numerical') {
+           my $numericalanswer=$qparms{$prefix.'numericalanswer'};
+           unless (defined($numericalanswer)) { $numericalanswer=''; }
+           my $numericaltolerance=$qparms{$prefix.'numericaltolerance'};
+           unless (defined($numericaltolerance)) { $numericaltolerance='5%'; }
+           my $numericalsigfigs=$qparms{$prefix.'numericalsigfigs'};
+           unless (defined($numericalsigfigs)) { $numericalsigfigs='1,15'; }
+
+           $r->print(
+                  '<table bgcolor="#00ee44" cellspacing="4" cellpadding="2">'.
+                  '<tr><td><label>'.&mt('Correct answer').': <input type="text" size="20" name="numericalanswer" value="'.$numericalanswer.'" /></label>&nbsp;&nbsp;'.
+                  '<label>'.&mt('Unit').':  <input type="text" size="5" name="numericalunit" value="'.$qparms{$prefix.'numericalunit'}.'" /></label>&nbsp;&nbsp;'.
+                  '<label>'.&mt('Format').':  <input type="text" size="5" name="numericalformat" value="'.$qparms{$prefix.'numericalformat'}.'" /></label>&nbsp;&nbsp;'.
+                  '<label>'.&mt('Tolerance').':  <input type="text" size="5" name="numericaltolerance" value="'.$numericaltolerance.'" /></label>&nbsp;&nbsp;'.
+                  '<label>'.&mt('Significant digits').':  <input type="text" size="5" name="numericalsigfigs" value="'.$numericalsigfigs.'" /></label>'.
+                  '</td></tr></table><br />');
+           $r->print(&hint());
+        }
 # Store Button
 	$r->print(
-  '<input type="submit" value="'.&mt('Store Changes').'" /></form>');
+  '<input type="submit" value="'.&mt('Save and Edit').'" /></form>');
     } else {
 	$r->print(&mt('Could not identify problem.'));
     }
-    $r->print('</body></html>');
+    $r->print(&Apache::loncommon::end_page());
     return OK;
 }