loncom/homework/lonsimpleproblemedit.pm - view

File: [LON-CAPA] / loncom / homework / lonsimpleproblemedit.pm
Revision 1.35: download - view: text, annotated - select for diffs
Fri May 10 12:48:48 2013 UTC (10 years, 11 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Suppress "Apache2::RequestIO::print: (103) Software caused connection abort"
  messages in Apache error log by returning OK when internal redirect is used.

1: # The LearningOnline Network 2: # Simple Problem Parameter Setting "Editor" 3: # 4: # $Id: lonsimpleproblemedit.pm,v 1.35 2013/05/10 12:48:48 raeburn Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: package Apache::lonsimpleproblemedit; 30: 31: use strict; 32: use Apache::Constants qw(:common :http); 33: use Apache::loncommon; 34: use Apache::lonnet; 35: use Apache::lonlocal; 36: use Apache::lonnavmaps; 37: use lib '/home/httpd/lib/perl/'; 38: use LONCAPA; 39: 40: 41: my %qparms; 42: my $prefix; 43: my $qtype; 44: 45: sub evaloptionhash { 46: my $options=shift; 47: $options=~s/^$\'//; 48: $options=~s/\'$$//; 49: my %returnhash=(); 50: foreach (split(/\'\,\'/,$options)) { 51: $returnhash{$_}=$_; 52: } 53: return %returnhash; 54: } 55: 56: sub rawrendering { 57: my ($symb)=@_; 58: my %data=('show_errors'=>'on', 59: 'simple_edit_button' => 'off', 60: 'devalidatecourseresdata'=>'on'); 61: return &Apache::loncommon::get_student_view($symb,time,time, 62: $env{'request.course.id'}, 63: 'web',\%data); 64: } 65: 66: sub questiontext { 67: my $text=$qparms{$prefix.'questiontext'}; 68: my $qt=&mt('Question Text'); 69: my $spell_link= 70: &Apache::lonhtmlcommon::spelllink('simpleedit','questiontext'); 71: return (<<ENDQUESTION); 72: <table bgcolor="#dddd22" cellspacing="4" cellpadding="2" style="width:100%"> 73: <tr><td><b>$qt</b><br /> 74: <textarea style="width:99%" name="questiontext" cols="80" rows="8">$text</textarea> 75: <br />$spell_link 76: </td></tr> 77: </table> 78: <br /> 79: ENDQUESTION 80: } 81: 82: sub hint { 83: my $text=$qparms{$prefix.'hinttext'}; 84: my $ht=&mt('Hint Text'); 85: my $spell_link= 86: &Apache::lonhtmlcommon::spelllink('simpleedit','hinttext'); 87: return (<<ENDHINT); 88: <table bgcolor="#accacc" cellspacing="4" cellpadding="2" style="width:100%"> 89: <tr><td><b>$ht</b><br /> 90: <textarea style="width:99%" name="hinttext" cols="80" rows="4">$text</textarea> 91: <br />$spell_link 92: </td></tr> 93: </table> 94: <br /> 95: ENDHINT 96: } 97: 98: sub script { 99: my $text=$qparms{$prefix.'numericalscript'}; 100: my $ht=&mt('Scripting (optional)'); 101: return (<<ENDSCRIPT); 102: <table bgcolor="#ccccaa" cellspacing="4" cellpadding="2" style="width:100%"> 103: <tr><td><b>$ht</b><br /> 104: <textarea style="width:99%" name="numericalscript" cols="80" rows="4">$text</textarea> 105: </td></tr> 106: </table> 107: <br /> 108: ENDSCRIPT 109: } 110: 111: sub foil { 112: my $number=shift; 113: my (%values,%defaultvalues,%customvalues); 114: %defaultvalues = &Apache::lonlocal::texthash( 115: 'unused' => 'Not shown, not used' 116: ); 117: if ($qtype eq 'radio') { 118: %customvalues = &Apache::lonlocal::texthash( 119: 'true' => 'True', 120: 'false' => 'False' 121: ); 122: } elsif ($qtype eq 'option') { 123: %customvalues=&evaloptionhash($qparms{$prefix.'options'}); 124: } 125: %values = (%defaultvalues,%customvalues); 126: my $value=$qparms{$prefix.'value'.$number}; 127: unless (defined($value)) { $value='unused'; } 128: unless ($values{$value}) { $value='unused'; } 129: my $position=$qparms{$prefix.'position'.$number}; 130: my %positions=('random' => 'Random position', 131: 'top' => 'Show always at top position', 132: 'bottom' => 'Show always at bottom position'); 133: unless (defined($position)) { $position='random'; } 134: unless ($positions{$position}) { 135: $position='random'; 136: } 137: my $selectvalue=&Apache::loncommon::select_form( 138: $value, 139: 'value'.$number, 140: \%values); 141: my $selectposition=&Apache::loncommon::select_form( 142: $position, 143: 'position'.$number, 144: {&Apache::lonlocal::texthash(%positions)}); 145: my $text=$qparms{$prefix.'text'.$number}; 146: my %lt=&Apache::lonlocal::texthash('foil' => 'Foil', 147: 'value' => 'Value', 148: 'pos' => 'Position', 149: 'text' => 'Text'); 150: 151: my $spell_link= 152: &Apache::lonhtmlcommon::spelllink('simpleedit',"text$number"); 153: return (<<ENDFOIL); 154: <table bgcolor="#E8D8EE" cellspacing="2" cellpadding="1" style="width:100%"> 155: <tr><td colspan="2"><b>$lt{'foil'}</b></td></tr> 156: <tr><td>$lt{'value'}: $selectvalue</td><td>$lt{'pos'}: $selectposition</td></tr> 157: <tr><td colspan="2">$lt{'text'}:<br /> 158: <textarea style="width:99%" name="text$number" cols="80" rows="4">$text</textarea> 159: <br />$spell_link 160: </td></tr> 161: </table> 162: <br /> 163: ENDFOIL 164: } 165: 166: sub get_parent_uri { 167: my ($cur_symb)=@_; 168: my $navmap = Apache::lonnavmaps::navmap->new(); 169: if (defined($navmap)) { 170: my $it = $navmap->getIterator(undef, undef, undef, 1); 171: while ( my $res=$it->next()) { 172: if (ref($res) && $res->symb() eq $cur_symb) { last; } 173: } 174: my ($src,$symb,$anchor)=&Apache::lonnavmaps::getLinkForResource($it->getStack()); 175: if (defined($anchor)) { $anchor='#'.$anchor; } 176: return $src.'?symb='.&escape($symb).$anchor; 177: } 178: return; 179: } 180: 181: sub handler { 182: my $r = shift; 183: 184: if ($r->header_only) { 185: &Apache::loncommon::content_type($r,'text/html'); 186: $r->send_http_header; 187: return OK; 188: } 189: 190: # -------------------------------------------------------------------- Allowed? 191: unless (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) { 192: return HTTP_NOT_ACCEPTABLE; 193: } 194: # ----------------------------------------------------------------- Send header 195: &Apache::loncommon::content_type($r,'text/html'); 196: $r->send_http_header; 197: # ----------------------------------------------------- Figure out where we are 198: my $uri=$r->uri; 199: $uri=~s/\/smpedit$//; 200: my $symb=&Apache::lonnet::symbread(); 201: 202: # ------------------------------------------------ Prefix for everything stored 203: $prefix=$env{'request.course.id'}.'.'.$symb.'.0.'; 204: #------------------------------------------------- Prefix for storing weight of Problem Parts 205: my $weightprefix=$env{'request.course.id'}.'.'.$symb.'.'; 206: 207: # ---------------------------------------------------------- Anything to store? 208: my $storeresult; 209: if (($symb) && (defined($env{'form.questiontype'}))) { 210: my %storecontent=(); 211: undef %storecontent; 212: if ($env{'form.questiontype'} eq 'option') { 213: my %curoptions=&evaloptionhash($env{'form.options'}); 214: if ($env{'form.delopt'}) { 215: delete $curoptions{$env{'form.delopt'}}; 216: } 217: if ($env{'form.newopt'}) { 218: $env{'form.newopt'}=~s/\'/\\\'/g; 219: $curoptions{$env{'form.newopt'}}=$env{'form.newopt'}; 220: } 221: $env{'form.options'}="('".join("','",keys %curoptions)."')"; 222: } 223: $env{'form.hiddenparts'}='!'.$env{'form.questiontype'}; 224: foreach (keys %env) { 225: if ($_=~/^form\.(\w+)$/) { 226: my $parm=$1; 227: $storecontent{$prefix.$parm}=$env{'form.'.$parm}; 228: $storecontent{$prefix.$parm}=~s/^\s+//s; 229: $storecontent{$prefix.$parm}=~s/\s+$//s; 230: } 231: } 232: # ---------------------------------------------------- Set weights of hidden parts to zero 233: # ------------------------------------------------------ and used part to 1 234: $storecontent{$weightprefix.'essay.weight'}=0; 235: $storecontent{$weightprefix.'numerical.weight'}=0; 236: $storecontent{$weightprefix.'option.weight'}=0; 237: $storecontent{$weightprefix.'radio.weight'}=0; 238: $storecontent{$weightprefix.'string.weight'}=0; 239: $storecontent{$weightprefix.$env{'form.questiontype'}.'.weight'}=1; 240: 241: 242: my $reply=&Apache::lonnet::cput 243: ('resourcedata',\%storecontent, 244: $env{'course.'.$env{'request.course.id'}.'.domain'}, 245: $env{'course.'.$env{'request.course.id'}.'.num'}); 246: 247: &Apache::lonnet::devalidatecourseresdata( 248: $env{'course.'.$env{'request.course.id'}.'.num'}, 249: $env{'course.'.$env{'request.course.id'}.'.domain'}); 250: if ($reply eq 'ok') { 251: if ($env{'form.forceview'}) { 252: my $dest = &get_parent_uri($symb); 253: if ($dest) { 254: $r->internal_redirect($dest); 255: return OK; 256: } 257: } 258: } else { 259: $storeresult = $reply; 260: } 261: } 262: # ------------------------------------------------------------------- Read Data 263: 264: %qparms=&Apache::lonnet::dump('resourcedata', 265: $env{'course.'.$env{'request.course.id'}.'.domain'}, 266: $env{'course.'.$env{'request.course.id'}.'.num'}, 267: $env{'request.course.id'}.'.'.$symb); 268: 269: my $js = <<"ENDJS"; 270: 271: <script type="text/javascript"> 272: // <![CDATA[ 273: 274: function setForceView() { 275: if (document.getElementById('spview')) { 276: document.getElementById('spview').value = 1; 277: } 278: return true; 279: } 280: // END LON-CAPA Internal --> 281: // ]]> 282: </script> 283: 284: ENDJS 285: 286: # ------------------------------------------------------------ Print the screen 287: my $spell_header=&Apache::lonhtmlcommon::spellheader(); 288: $r->print(&Apache::loncommon::start_page('Simple Problem Editor', 289: $spell_header.$js)); 290: if ($symb) { 291: my $title='<h1>'.&Apache::lonnet::gettitle($symb).'</h1>'; 292: if (&get_parent_uri($symb)) { 293: $r->print($title); 294: if ($storeresult) { 295: $r->print('<p class="LC_error">'.&mt('An error: [_1] occurred saving your changes',$storeresult).'</p>'); 296: } 297: } else { 298: $r->print($title 299: .'<p class="LC_error">' 300: .&mt('An error occurred retrieving the link to this problem.') 301: .'<br />' 302: .&mt('You may need to [_1]re-select the course[_2] and then return to this resource to view it.' 303: ,'<a href="/adm/roles">','</a>') 304: .'</p>' 305: ); 306: } 307: $r->print('<p class="LC_warning">' 308: .&mt('Note: it can take up to 10 minutes for changes to take effect for all users.') 309: .&Apache::loncommon::help_open_topic('Caching') 310: .'</p>' 311: ); 312: 313: $r->print( 314: '<div class="LC_Box">' 315: .&rawrendering($symb) 316: .'</div>' 317: ); 318: $r->print('<form name="simpleedit" method="post">'); 319: # Question Type 320: my %questiontypes=( 321: 'radio' => '1 out of N multiple choice (radio button)', 322: 'option' => 'Option Response', 323: 'string' => 'Short string response', 324: 'essay' => 'Essay, open end', 325: 'numerical' => 'Numerical Response'); 326: $qtype=$qparms{$prefix.'questiontype'}; 327: unless (defined($qtype)) { $qtype='radio'; } 328: unless ($questiontypes{$qtype}) { $qtype='radio'; } 329: $r->print( 330: '<fieldset style="width:400px;">' 331: .'<legend>'.&mt('Question Type').'</legend>' 332: .&Apache::loncommon::select_form( 333: $qtype, 334: 'questiontype', 335: {&Apache::lonlocal::texthash(%questiontypes)}) 336: .'</fieldset>' 337: ); 338: $r->print( 339: '<p>' 340: .'<input type="hidden" name="forceview" value="" id="spview" />' 341: .'<input type="submit" value="'.&mt('Save and Edit').'" />' 342: .(' ' x3) 343: .'<input type="submit" value="'.&mt('Save and View').'" onclick="javascript:setForceView();" />' 344: .'</p>' 345: ); 346: # Script 347: if ($qtype eq 'numerical') { 348: $r->print(&script()); 349: } 350: # Question Text 351: $r->print(&questiontext()); 352: # Radio, Option === 353: if (($qtype eq 'radio') || ($qtype eq 'option')) { 354: # Response 355: my $maxfoils=$qparms{$prefix.'maxfoils'}; 356: unless (defined($maxfoils)) { $maxfoils=10; } 357: unless ($maxfoils=~/^\d+$/) { $maxfoils=10; } 358: if ($maxfoils<=0) { $maxfoils=10; } 359: my %randomizes=( 360: 'yes' => 'Display foils in random order', 361: 'no' => 'Display foils in order given'); 362: my $randomize=$qparms{$prefix.'randomize'}; 363: unless (defined($randomize)) { $randomize='yes'; } 364: unless ($randomizes{$randomize}) { $randomize='yes'; } 365: $r->print( 366: '<table bgcolor="#00ee44" cellspacing="4" cellpadding="2" style="width:100%">'. 367: '<tr><td>'.&mt('Max number of foils displayed'). 368: ': <input type="text" size="3" name="maxfoils" value="'.$maxfoils.'" />  '. 369: &Apache::loncommon::select_form( 370: $randomize, 371: 'randomize', 372: {&Apache::lonlocal::texthash(%randomizes)}). 373: '</td></tr><tr><td bgcolor="#F0F0F0">'); 374: # Option Response: Options 375: if ($qtype eq 'option') { 376: my $options=$qparms{$prefix.'options'}; 377: unless (defined($options)) { $options="('true','false')"; } 378: my %optionshash=&evaloptionhash($options); 379: $r->print( 380: '<table bgcolor="#ffcc22" cellspacing="4" cellpadding="2" style="width:100%">'. 381: '<tr><td><input type="hidden" name="options" value="'. 382: $options.'" />'.&mt('Add new option').': '. 383: '<input type="text" name="newopt" size="15" />'. 384: &mt('Delete an option').': '. 385: &Apache::loncommon::select_form('','delopt',{'' => '',%optionshash}). 386: '</td></tr><tr><td>'); 387: } 388: # Foils 389: for (my $i=1;$i<=10;$i++) { 390: $r->print(&foil($i)); 391: } 392: # End Options 393: if ($qtype eq 'option') { 394: $r->print('</td></tr></table>'); 395: } 396: 397: # End Response 398: $r->print('</td></tr></table><br />'); 399: # Hint 400: $r->print(&hint()); 401: } 402: if ($qtype eq 'string') { 403: my %stringtypes=( 404: 'cs' => 'Case sensitive', 405: 'ci' => 'Case Insensitive', 406: 'mc' => 'Multiple Choice, Order of characters unchecked'); 407: my $stringanswer=$qparms{$prefix.'stringanswer'}; 408: unless (defined($stringanswer)) { $stringanswer=''; } 409: my $stringtype=$qparms{$prefix.'stringtype'}; 410: unless (defined($stringtype)) { $stringtype='cs'; } 411: unless ($stringtypes{$stringtype}) { $stringtype='cs'; } 412: $r->print( 413: '<table bgcolor="#00ee44" cellspacing="4" cellpadding="2" style="width:100%">'. 414: '<tr><td><label>'.&mt('Correct answer').': <input type="text" size="20" name="stringanswer" value="'.$stringanswer.'" /></label>  '. 415: &Apache::loncommon::select_form( 416: $stringtype, 417: 'stringtype', 418: {&Apache::lonlocal::texthash(%stringtypes)}). 419: '</td></tr></table><br />'); 420: # Hint 421: $r->print(&hint()); 422: } 423: if ($qtype eq 'numerical') { 424: my $numericalanswer=$qparms{$prefix.'numericalanswer'}; 425: unless (defined($numericalanswer)) { $numericalanswer=''; } 426: my $numericaltolerance=$qparms{$prefix.'numericaltolerance'}; 427: unless (defined($numericaltolerance)) { $numericaltolerance='5%'; } 428: my $numericalsigfigs=$qparms{$prefix.'numericalsigfigs'}; 429: unless (defined($numericalsigfigs)) { $numericalsigfigs='1,15'; } 430: 431: $r->print( 432: '<table bgcolor="#00ee44" cellspacing="4" cellpadding="2" style="width:100%">'. 433: '<tr><td><label>'.&mt('Correct answer').': <input type="text" size="20" name="numericalanswer" value="'.$numericalanswer.'" /></label>  '. 434: '<label>'.&mt('Unit').': <input type="text" size="5" name="numericalunit" value="'.$qparms{$prefix.'numericalunit'}.'" /></label>  '. 435: '<label>'.&mt('Format').': <input type="text" size="5" name="numericalformat" value="'.$qparms{$prefix.'numericalformat'}.'" /></label>  '. 436: '<label>'.&mt('Tolerance').': <input type="text" size="5" name="numericaltolerance" value="'.$numericaltolerance.'" /></label>  '. 437: '<label>'.&mt('Significant digits').': <input type="text" size="5" name="numericalsigfigs" value="'.$numericalsigfigs.'" /></label>'. 438: '</td></tr></table><br />'); 439: $r->print(&hint()); 440: } 441: # Store Button 442: $r->print( 443: '<input type="submit" value="'.&mt('Save and Edit').'" />'. 444: (' ' x3). 445: '<input type="submit" value="'.&mt('Save and View').'" onclick="javascript:setForceView();" />'. 446: '</form>'); 447: } else { 448: $r->print(&mt('Could not identify problem.')); 449: } 450: $r->print(&Apache::loncommon::end_page()); 451: return OK; 452: } 453: 454: 1; 455: __END__