--- loncom/homework/lonsimpleproblemedit.pm	2003/11/04 16:44:50	1.7
+++ loncom/homework/lonsimpleproblemedit.pm	2013/05/10 12:48:48	1.35
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Simple Problem Parameter Setting "Editor"
 #
-# $Id: lonsimpleproblemedit.pm,v 1.7 2003/11/04 16:44:50 www Exp $
+# $Id: lonsimpleproblemedit.pm,v 1.35 2013/05/10 12:48:48 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -33,6 +33,10 @@ 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;
@@ -50,30 +54,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);
-    $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">
-<tr><td><b>Question Text</b><br />
-<textarea name="questiontext" cols="80" rows="8">$text</textarea>
+<table bgcolor="#dddd22" cellspacing="4" cellpadding="2" style="width:100%">
+<tr><td><b>$qt</b><br />
+<textarea style="width:99%" name="questiontext" cols="80" rows="8">$text</textarea>
+<br />$spell_link
 </td></tr>
 </table>
 <br />
@@ -82,25 +81,48 @@ 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>Hint Text</b><br />
-<textarea name="hinttext" cols="80" rows="4">$text</textarea>
+<table bgcolor="#accacc" cellspacing="4" cellpadding="2" style="width:100%">
+<tr><td><b>$ht</b><br />
+<textarea style="width:99%" 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" style="width:100%">
+<tr><td><b>$ht</b><br />
+<textarea style="width:99%" name="numericalscript" cols="80" rows="4">$text</textarea>
+</td></tr>
+</table>
+<br />
+ENDSCRIPT
+}
+
 sub foil {
     my $number=shift;
-    my %values='';
+    my (%values,%defaultvalues,%customvalues);
+    %defaultvalues = &Apache::lonlocal::texthash(
+                         'unused' => 'Not shown, not used'
+                     );
     if ($qtype eq 'radio') {
-	%values=('true' => 'True', 'false' => 'False');
+        %customvalues = &Apache::lonlocal::texthash(
+                                       'true' => 'True',
+                                       'false' => 'False'
+        );
     } elsif ($qtype eq 'option') {
-	%values=&evaloptionhash($qparms{$prefix.'options'});
+        %customvalues=&evaloptionhash($qparms{$prefix.'options'});
     }
-    $values{'unused'}='Not shown, not used';
+    %values = (%defaultvalues,%customvalues);
     my $value=$qparms{$prefix.'value'.$number};
     unless (defined($value)) { $value='unused'; }
     unless ($values{$value}) { $value='unused'; }
@@ -112,23 +134,50 @@ sub foil {
     unless ($positions{$position}) {
 	$position='random';
     }
-    my $selectvalue=&Apache::loncommon::select_form
-	                                ($value,'value'.$number,%values);
-    my $selectposition=&Apache::loncommon::select_form
-                               ($position,'position'.$number,%positions);
+    my $selectvalue=&Apache::loncommon::select_form(
+                        $value,
+                        'value'.$number,
+                        \%values);
+    my $selectposition=&Apache::loncommon::select_form(
+                           $position,
+                           'position'.$number,
+                           {&Apache::lonlocal::texthash(%positions)});
     my $text=$qparms{$prefix.'text'.$number};
+    my %lt=&Apache::lonlocal::texthash('foil'  => 'Foil',
+				       'value' => 'Value',
+				       '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>Foil</b></td></tr>
-<tr><td>Value: $selectvalue</td><td>Position: $selectposition</td></tr>
-<tr><td colspan="2">Text:<br />
-<textarea name="text$number" cols="80" rows="4">$text</textarea>
+<table bgcolor="#E8D8EE" cellspacing="2" cellpadding="1" style="width:100%">
+<tr><td colspan="2"><b>$lt{'foil'}</b></td></tr>
+<tr><td>$lt{'value'}: $selectvalue</td><td>$lt{'pos'}: $selectposition</td></tr>
+<tr><td colspan="2">$lt{'text'}:<br />
+<textarea style="width:99%" 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;
 
@@ -139,7 +188,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
@@ -148,74 +197,156 @@ 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
+    my $weightprefix=$env{'request.course.id'}.'.'.$symb.'.';
+    
 # ---------------------------------------------------------- Anything to store?
-
-    if (($symb) && (defined($ENV{'form.questiontype'}))) {
+    my $storeresult;
+    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'});
+        if ($reply eq 'ok') {
+            if ($env{'form.forceview'}) {
+                my $dest = &get_parent_uri($symb);
+                if ($dest) {
+                    $r->internal_redirect($dest);
+                    return OK;
+                }
+            }
+        } else {
+            $storeresult = $reply;
+        }
     }
 # ------------------------------------------------------------------- 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);
+
+    my $js = <<"ENDJS";
+
+<script type="text/javascript">
+// <![CDATA[
+
+function setForceView() {
+    if (document.getElementById('spview')) {
+        document.getElementById('spview').value = 1;
+    }
+    return true;
+}
+// END LON-CAPA Internal -->
+// ]]>
+</script>
+
+ENDJS
 
 # ------------------------------------------------------------ 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.$js));
     if ($symb) {
-	$r->print('<h1>'.&Apache::lonnet::gettitle($symb).'</h1>');
-	$r->print('<table border="2" bgcolor="#FFFFFF" width="100%"><tr><td>'.
-                  &rawrendering($r,$uri).
-                  '</td></tr></table><br />');
-        $r->print('<form method="post">');
+	    my $title='<h1>'.&Apache::lonnet::gettitle($symb).'</h1>';
+        if (&get_parent_uri($symb)) {
+            $r->print($title);
+            if ($storeresult) {
+                $r->print('<p class="LC_error">'.&mt('An error: [_1] occurred saving your changes',$storeresult).'</p>'); 
+            }
+        } else {
+            $r->print($title
+                     .'<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(
+            '<div class="LC_Box">'
+           .&rawrendering($symb)
+           .'</div>'
+        );
+        $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');
+        my %questiontypes=(
+               'radio'     => '1 out of N multiple choice (radio button)',
+               'option'    => 'Option Response',
+               'string'    => 'Short string response',
+               'essay'     => 'Essay, open end',
+               'numerical' => 'Numerical Response');
         $qtype=$qparms{$prefix.'questiontype'};
         unless (defined($qtype)) { $qtype='radio'; }
         unless ($questiontypes{$qtype}) { $qtype='radio'; }
-        $r->print('<b>Question Type: '.&Apache::loncommon::select_form
-	                               ($qtype,'questiontype',%questiontypes).
-  '</b><br /><input type="submit" value="'.&mt('Store Changes').
-  '" /><p>&nbsp;</p>');
+        $r->print(
+            '<fieldset style="width:400px;">'
+           .'<legend>'.&mt('Question Type').'</legend>'
+           .&Apache::loncommon::select_form(
+                $qtype,
+                'questiontype',
+                {&Apache::lonlocal::texthash(%questiontypes)})
+           .'</fieldset>'
+        );
+        $r->print(
+            '<p>'
+           .'<input type="hidden" name="forceview" value="" id="spview" />' 
+           .'<input type="submit" value="'.&mt('Save and Edit').'" />'
+           .('&nbsp;' x3)
+           .'<input type="submit" value="'.&mt('Save and View').'" onclick="javascript:setForceView();" />'
+           .'</p>'
+        );
+# Script
+        if ($qtype eq 'numerical') {
+           $r->print(&script());
+        }
 # Question Text
         $r->print(&questiontext());
 # Radio, Option ===
@@ -225,30 +356,33 @@ ENDDOCUMENT
             unless (defined($maxfoils)) { $maxfoils=10; }
             unless ($maxfoils=~/^\d+$/) { $maxfoils=10; }
             if ($maxfoils<=0) { $maxfoils=10; }
-	    my %randomizes=('yes' => 'Display foils in random order',
-			    'no'  => 'Display foils in order given');
+            my %randomizes=(
+                   'yes' => 'Display foils in random order',
+                   'no'  => 'Display foils in order given');
 	    my $randomize=$qparms{$prefix.'randomize'};
             unless (defined($randomize)) { $randomize='yes'; }
             unless ($randomizes{$randomize}) { $randomize='yes'; }
 	    $r->print(
-		  '<table bgcolor="#00ee44" cellspacing="4" cellpadding="2">'.
+		  '<table bgcolor="#00ee44" cellspacing="4" cellpadding="2" style="width:100%">'.
 	          '<tr><td>'.&mt('Max number of foils displayed').
 ': <input type="text" size="3" name="maxfoils" value="'.$maxfoils.'" />&nbsp;&nbsp;'.
-		      &Apache::loncommon::select_form
-		      ($randomize,'randomize',%randomizes).
-		  '</td></tr><tr><td bgcolor="#AAAAAA">');
+                      &Apache::loncommon::select_form(
+                          $randomize,
+                          'randomize',
+                          {&Apache::lonlocal::texthash(%randomizes)}).
+		  '</td></tr><tr><td bgcolor="#F0F0F0">');
 # Option Response: Options
 	    if ($qtype eq 'option') {
 		my $options=$qparms{$prefix.'options'};
                 unless (defined($options)) { $options="('true','false')"; }
                 my %optionshash=&evaloptionhash($options);
 		$r->print(
-		  '<table bgcolor="#ffcc22" cellspacing="4" cellpadding="2">'.
+		  '<table bgcolor="#ffcc22" cellspacing="4" cellpadding="2" style="width:100%">'.
 		  '<tr><td><input type="hidden" name="options" value="'.
-                  $options.'" />Add new option: '.
+                  $options.'" />'.&mt('Add new option').': '.
           '<input type="text" name="newopt" size="15" />'.
           &mt('Delete an option').': '.
-          &Apache::loncommon::select_form('','delopt',('' => '',%optionshash)).
+          &Apache::loncommon::select_form('','delopt',{'' => '',%optionshash}).
           '</td></tr><tr><td>');
 	    }
 # Foils
@@ -276,23 +410,46 @@ ENDDOCUMENT
             unless (defined($stringtype)) { $stringtype='cs'; }
             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;'.
-		      &Apache::loncommon::select_form
-		      ($stringtype,'stringtype',%stringtypes).
+		  '<table bgcolor="#00ee44" cellspacing="4" cellpadding="2" style="width:100%">'.
+	          '<tr><td><label>'.&mt('Correct answer').': <input type="text" size="20" name="stringanswer" value="'.$stringanswer.'" /></label>&nbsp;&nbsp;'.
+                      &Apache::loncommon::select_form(
+                          $stringtype,
+                          'stringtype',
+                          {&Apache::lonlocal::texthash(%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" style="width:100%">'.
+                  '<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').'" />'.
+  ('&nbsp;' x3).
+  '<input type="submit" value="'.&mt('Save and View').'" onclick="javascript:setForceView();" />'.
+  '</form>');
     } else {
 	$r->print(&mt('Could not identify problem.'));
     }
-    $r->print('</body></html>');
+    $r->print(&Apache::loncommon::end_page());
     return OK;
-} 
+}
 
 1;
 __END__