Diff for /loncom/homework/lonsimpleproblemedit.pm between versions 1.13 and 1.33

version 1.13, 2004/12/14 18:24:17 version 1.33, 2012/11/08 21:55:11
Line 34  use Apache::loncommon; Line 34  use Apache::loncommon;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonnavmaps;  use Apache::lonnavmaps;
   use lib '/home/httpd/lib/perl/';
   use LONCAPA;
    
   
 my %qparms;  my %qparms;
 my $prefix;  my $prefix;
Line 56  sub rawrendering { Line 59  sub rawrendering {
       'simple_edit_button' => 'off',        'simple_edit_button' => 'off',
       'devalidatecourseresdata'=>'on');        'devalidatecourseresdata'=>'on');
     return &Apache::loncommon::get_student_view($symb,time,time,      return &Apache::loncommon::get_student_view($symb,time,time,
  $ENV{'request.course.id'},   $env{'request.course.id'},
  'web',\%data);   'web',\%data);
 }  }
   
 sub questiontext {  sub questiontext {
     my $text=$qparms{$prefix.'questiontext'};      my $text=$qparms{$prefix.'questiontext'};
     my $qt=&mt('Question Text');      my $qt=&mt('Question Text');
       my $spell_link=
    &Apache::lonhtmlcommon::spelllink('simpleedit','questiontext');
     return (<<ENDQUESTION);      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 />  <tr><td><b>$qt</b><br />
 <textarea name="questiontext" cols="80" rows="8">$text</textarea>  <textarea style="width:99%" name="questiontext" cols="80" rows="8">$text</textarea>
   <br />$spell_link
 </td></tr>  </td></tr>
 </table>  </table>
 <br />  <br />
Line 76  ENDQUESTION Line 82  ENDQUESTION
 sub hint {  sub hint {
     my $text=$qparms{$prefix.'hinttext'};      my $text=$qparms{$prefix.'hinttext'};
     my $ht=&mt('Hint Text');      my $ht=&mt('Hint Text');
       my $spell_link=
    &Apache::lonhtmlcommon::spelllink('simpleedit','hinttext');
     return (<<ENDHINT);      return (<<ENDHINT);
 <table bgcolor="#accacc" cellspacing="4" cellpadding="2">  <table bgcolor="#accacc" cellspacing="4" cellpadding="2" style="width:100%">
 <tr><td><b>$ht</b><br />  <tr><td><b>$ht</b><br />
 <textarea name="hinttext" cols="80" rows="4">$text</textarea>  <textarea style="width:99%" name="hinttext" cols="80" rows="4">$text</textarea>
   <br />$spell_link
 </td></tr>  </td></tr>
 </table>  </table>
 <br />  <br />
 ENDHINT  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 {  sub foil {
     my $number=shift;      my $number=shift;
     my %values='';      my (%values,%defaultvalues,%customvalues);
       %defaultvalues = &Apache::lonlocal::texthash(
                            'unused' => 'Not shown, not used'
                        );
     if ($qtype eq 'radio') {      if ($qtype eq 'radio') {
  %values=('true' => 'True', 'false' => 'False');          %customvalues = &Apache::lonlocal::texthash(
                                          'true' => 'True',
                                          'false' => 'False'
           );
     } elsif ($qtype eq 'option') {      } 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};      my $value=$qparms{$prefix.'value'.$number};
     unless (defined($value)) { $value='unused'; }      unless (defined($value)) { $value='unused'; }
     unless ($values{$value}) { $value='unused'; }      unless ($values{$value}) { $value='unused'; }
Line 106  sub foil { Line 134  sub foil {
     unless ($positions{$position}) {      unless ($positions{$position}) {
  $position='random';   $position='random';
     }      }
     my $selectvalue=&Apache::loncommon::select_form      my $selectvalue=&Apache::loncommon::select_form(
                                 ($value,'value'.$number,%values);                          $value,
     my $selectposition=&Apache::loncommon::select_form                          'value'.$number,
                                ($position,'position'.$number,%positions);                          \%values);
       my $selectposition=&Apache::loncommon::select_form(
                              $position,
                              'position'.$number,
                              {&Apache::lonlocal::texthash(%positions)});
     my $text=$qparms{$prefix.'text'.$number};      my $text=$qparms{$prefix.'text'.$number};
     my %lt=&Apache::lonlocal::texthash('foil'  => 'Foil',      my %lt=&Apache::lonlocal::texthash('foil'  => 'Foil',
        'value' => 'Value',         'value' => 'Value',
        'pos'   => 'Position',         'pos'   => 'Position',
        'text'  => 'Text');         'text'  => 'Text');
   
       my $spell_link=
    &Apache::lonhtmlcommon::spelllink('simpleedit',"text$number");
     return (<<ENDFOIL);      return (<<ENDFOIL);
 <table bgcolor="#dd55ff" cellspacing="4" cellpadding="2">  <table bgcolor="#E8D8EE" cellspacing="2" cellpadding="1" style="width:100%">
 <tr><td colspan="2"><b>$lt{'foil'}</b></td></tr>  <tr><td colspan="2"><b>$lt{'foil'}</b></td></tr>
 <tr><td>$lt{'value'}: $selectvalue</td><td>$lt{'pos'}: $selectposition</td></tr>  <tr><td>$lt{'value'}: $selectvalue</td><td>$lt{'pos'}: $selectposition</td></tr>
 <tr><td colspan="2">$lt{'text'}:<br />  <tr><td colspan="2">$lt{'text'}:<br />
 <textarea name="text$number" cols="80" rows="4">$text</textarea>  <textarea style="width:99%" name="text$number" cols="80" rows="4">$text</textarea>
   <br />$spell_link
 </td></tr>  </td></tr>
 </table>  </table>
 <br />  <br />
Line 131  ENDFOIL Line 166  ENDFOIL
 sub get_parent_uri {  sub get_parent_uri {
     my ($cur_symb)=@_;      my ($cur_symb)=@_;
     my $navmap = Apache::lonnavmaps::navmap->new();      my $navmap = Apache::lonnavmaps::navmap->new();
     my $it = $navmap->getIterator(undef, undef, undef, 1);      if (defined($navmap)) {
     while ( my $res=$it->next()) {          my $it = $navmap->getIterator(undef, undef, undef, 1);
  if (ref($res) &&  $res->symb() eq  $cur_symb) { last; }          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;
     }      }
     my ($src,$symb,$anchor)=&Apache::lonnavmaps::getLinkForResource($it->getStack());      return;
     if (defined($anchor)) { $anchor='#'.$anchor; }  
     return $src.'?symb='.&Apache::lonnet::escape($symb).$anchor;  
 }  }
   
 sub handler {  sub handler {
Line 150  sub handler { Line 188  sub handler {
     }      }
   
 # -------------------------------------------------------------------- Allowed?  # -------------------------------------------------------------------- Allowed?
     unless (&Apache::lonnet::allowed('mdc',$ENV{'request.course.id'})) {      unless (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
  return HTTP_NOT_ACCEPTABLE;    return HTTP_NOT_ACCEPTABLE; 
     }      }
 # ----------------------------------------------------------------- Send header  # ----------------------------------------------------------------- Send header
Line 162  sub handler { Line 200  sub handler {
     my $symb=&Apache::lonnet::symbread();      my $symb=&Apache::lonnet::symbread();
   
 # ------------------------------------------------ Prefix for everything stored  # ------------------------------------------------ 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?  # ---------------------------------------------------------- Anything to store?
   
     if (($symb) && (defined($ENV{'form.questiontype'}))) {      if (($symb) && (defined($env{'form.questiontype'}))) {
         my %storecontent=();          my %storecontent=();
         undef %storecontent;          undef %storecontent;
         if ($ENV{'form.questiontype'} eq 'option') {          if ($env{'form.questiontype'} eq 'option') {
     my %curoptions=&evaloptionhash($ENV{'form.options'});      my %curoptions=&evaloptionhash($env{'form.options'});
     if ($ENV{'form.delopt'}) {      if ($env{'form.delopt'}) {
  delete $curoptions{$ENV{'form.delopt'}};   delete $curoptions{$env{'form.delopt'}};
     }      }
     if ($ENV{'form.newopt'}) {      if ($env{'form.newopt'}) {
  $ENV{'form.newopt'}=~s/\'/\\\'/g;   $env{'form.newopt'}=~s/\'/\\\'/g;
                 $curoptions{$ENV{'form.newopt'}}=$ENV{'form.newopt'};                  $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'};   $env{'form.hiddenparts'}='!'.$env{'form.questiontype'};
         foreach (keys %ENV) {          foreach (keys %env) {
     if ($_=~/^form\.(\w+)$/) {      if ($_=~/^form\.(\w+)$/) {
                 my $parm=$1;                  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;
  $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   my $reply=&Apache::lonnet::cput
     ('resourcedata',\%storecontent,      ('resourcedata',\%storecontent,
      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},       $env{'course.'.$env{'request.course.id'}.'.domain'},
      $ENV{'course.'.$ENV{'request.course.id'}.'.num'});       $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  # ------------------------------------------------------------------- Read Data
   
     %qparms=&Apache::lonnet::dump('resourcedata',      %qparms=&Apache::lonnet::dump('resourcedata',
      $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},       $env{'course.'.$env{'request.course.id'}.'.domain'},
      $ENV{'course.'.$ENV{'request.course.id'}.'.num'},       $env{'course.'.$env{'request.course.id'}.'.num'},
      $ENV{'request.course.id'}.'.'.$symb);       $env{'request.course.id'}.'.'.$symb);
   
 # ------------------------------------------------------------ Print the screen  # ------------------------------------------------------------ Print the screen
     $r->print(<<ENDDOCUMENT);      my $spell_header=&Apache::lonhtmlcommon::spellheader();
 <html>      $r->print(&Apache::loncommon::start_page('Simple Problem Editor',
 <head>       $spell_header));
 <title>The LearningOnline Network with CAPA</title>  
 ENDDOCUMENT  
     $r->print(&Apache::loncommon::bodytag('Simple Problem Editor'));  
     if ($symb) {      if ($symb) {
  $r->print('<h1>'.&Apache::lonnet::gettitle($symb).'</h1>');      my $title='<h1>'.&Apache::lonnet::gettitle($symb).'</h1>';
  $r->print('<table width="100%" bgcolor="#FFFFAA" border="2"><tr><td>'.          if (&get_parent_uri($symb)) {
                 '<a href="'.&get_parent_uri($symb).'">'.&mt('Student View').'</a> - '.&mt('Note: it can take up to 10 minutes for changes to take effect for all users.').              $r->print($title);
   &Apache::loncommon::help_open_topic('Caching').'</td></tr></table>');          } else {
  $r->print('<table border="2" bgcolor="#FFFFFF" width="100%"><tr><td>'.              $r->print($title
                   &rawrendering($symb).                       .'<p class="LC_error">'
                   '</td></tr></table><br />');                       .&mt('An error occurred retrieving the link to this problem.')
         $r->print('<form method="post">');                       .'<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          # Question Type        
  my %questiontypes=('radio'  =>           my %questiontypes=(
                                '1 out of N multiple choice (radio button)',                 'radio'     => '1 out of N multiple choice (radio button)',
    'option' => 'Option response',                 'option'    => 'Option Response',
                            'string' => 'Short string response',                 'string'    => 'Short string response',
                            'essay'  => 'Essay, open end');                 'essay'     => 'Essay, open end',
                  'numerical' => 'Numerical Response');
         $qtype=$qparms{$prefix.'questiontype'};          $qtype=$qparms{$prefix.'questiontype'};
         unless (defined($qtype)) { $qtype='radio'; }          unless (defined($qtype)) { $qtype='radio'; }
         unless ($questiontypes{$qtype}) { $qtype='radio'; }          unless ($questiontypes{$qtype}) { $qtype='radio'; }
         $r->print('<b>'.&mt('Question Type').          $r->print(
   ': '.&Apache::loncommon::select_form              '<fieldset style="width:400px;">'
                                ($qtype,'questiontype',%questiontypes).             .'<legend>'.&mt('Question Type').'</legend>'
   '</b><br /><input type="submit" value="'.&mt('Save and Edit').             .&Apache::loncommon::select_form(
   '" /><p>&nbsp;</p>');                  $qtype,
                   'questiontype',
                   {&Apache::lonlocal::texthash(%questiontypes)})
              .'</fieldset>'
           );
           $r->print(
               '<p>'
              .'<input type="submit" value="'.&mt('Save and Edit').'" />'
              .'</p>'
           );
   # Script
           if ($qtype eq 'numerical') {
              $r->print(&script());
           }
 # Question Text  # Question Text
         $r->print(&questiontext());          $r->print(&questiontext());
 # Radio, Option ===  # Radio, Option ===
Line 240  ENDDOCUMENT Line 323  ENDDOCUMENT
             unless (defined($maxfoils)) { $maxfoils=10; }              unless (defined($maxfoils)) { $maxfoils=10; }
             unless ($maxfoils=~/^\d+$/) { $maxfoils=10; }              unless ($maxfoils=~/^\d+$/) { $maxfoils=10; }
             if ($maxfoils<=0) { $maxfoils=10; }              if ($maxfoils<=0) { $maxfoils=10; }
     my %randomizes=('yes' => 'Display foils in random order',              my %randomizes=(
     'no'  => 'Display foils in order given');                     'yes' => 'Display foils in random order',
                      'no'  => 'Display foils in order given');
     my $randomize=$qparms{$prefix.'randomize'};      my $randomize=$qparms{$prefix.'randomize'};
             unless (defined($randomize)) { $randomize='yes'; }              unless (defined($randomize)) { $randomize='yes'; }
             unless ($randomizes{$randomize}) { $randomize='yes'; }              unless ($randomizes{$randomize}) { $randomize='yes'; }
     $r->print(      $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').            '<tr><td>'.&mt('Max number of foils displayed').
 ': <input type="text" size="3" name="maxfoils" value="'.$maxfoils.'" />&nbsp;&nbsp;'.  ': <input type="text" size="3" name="maxfoils" value="'.$maxfoils.'" />&nbsp;&nbsp;'.
       &Apache::loncommon::select_form                        &Apache::loncommon::select_form(
       ($randomize,'randomize',%randomizes).                            $randomize,
   '</td></tr><tr><td bgcolor="#AAAAAA">');                            'randomize',
                             {&Apache::lonlocal::texthash(%randomizes)}).
     '</td></tr><tr><td bgcolor="#F0F0F0">');
 # Option Response: Options  # Option Response: Options
     if ($qtype eq 'option') {      if ($qtype eq 'option') {
  my $options=$qparms{$prefix.'options'};   my $options=$qparms{$prefix.'options'};
                 unless (defined($options)) { $options="('true','false')"; }                  unless (defined($options)) { $options="('true','false')"; }
                 my %optionshash=&evaloptionhash($options);                  my %optionshash=&evaloptionhash($options);
  $r->print(   $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="'.    '<tr><td><input type="hidden" name="options" value="'.
                   $options.'" />'.&mt('Add new option').': '.                    $options.'" />'.&mt('Add new option').': '.
           '<input type="text" name="newopt" size="15" />'.            '<input type="text" name="newopt" size="15" />'.
           &mt('Delete an option').': '.            &mt('Delete an option').': '.
           &Apache::loncommon::select_form('','delopt',('' => '',%optionshash)).            &Apache::loncommon::select_form('','delopt',{'' => '',%optionshash}).
           '</td></tr><tr><td>');            '</td></tr><tr><td>');
     }      }
 # Foils  # Foils
Line 291  ENDDOCUMENT Line 377  ENDDOCUMENT
             unless (defined($stringtype)) { $stringtype='cs'; }              unless (defined($stringtype)) { $stringtype='cs'; }
             unless ($stringtypes{$stringtype}) { $stringtype='cs'; }              unless ($stringtypes{$stringtype}) { $stringtype='cs'; }
     $r->print(      $r->print(
   '<table bgcolor="#00ee44" cellspacing="4" cellpadding="2">'.    '<table bgcolor="#00ee44" cellspacing="4" cellpadding="2" style="width:100%">'.
           '<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                        &Apache::loncommon::select_form(
       ($stringtype,'stringtype',%stringtypes).                            $stringtype,
                             'stringtype',
                             {&Apache::lonlocal::texthash(%stringtypes)}).
   '</td></tr></table><br />');    '</td></tr></table><br />');
 # Hint  # Hint
     $r->print(&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  # Store Button
  $r->print(   $r->print(
   '<input type="submit" value="'.&mt('Save and Edit').'" /></form>');    '<input type="submit" value="'.&mt('Save and Edit').'" /></form>');
     } else {      } else {
  $r->print(&mt('Could not identify problem.'));   $r->print(&mt('Could not identify problem.'));
     }      }
     $r->print('</body></html>');      $r->print(&Apache::loncommon::end_page());
     return OK;      return OK;
 }   }
   
 1;  1;
 __END__  __END__

Removed from v.1.13  
changed lines
  Added in v.1.33


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.