Diff for /loncom/homework/lonsimpleproblemedit.pm between versions 1.1 and 1.37

version 1.1, 2003/07/07 07:32:16 version 1.37, 2014/12/15 00:50:20
Line 32  use strict; Line 32  use strict;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use Apache::loncommon;  use Apache::loncommon;
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::lonlocal;
   use Apache::lonnavmaps;
   use lib '/home/httpd/lib/perl/';
   use LONCAPA;
    
   
   my %qparms;
   my $prefix;
   my $qtype;
   
   sub evaloptionhash {
       my $options=shift;
       $options=~s/^\(\'//;
       $options=~s/\'\)$//;
       my %returnhash=();
       foreach (split(/\'\,\'/,$options)) {
    $returnhash{$_}=$_;
       }
       return %returnhash;
   }
   
   sub rawrendering {
       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 {  sub questiontext {
     my $text=shift;      my $text=$qparms{$prefix.'questiontext'};
       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>Question Text</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 46  ENDQUESTION Line 80  ENDQUESTION
 }  }
   
 sub hint {  sub hint {
     my $text=shift;      my $text=$qparms{$prefix.'hinttext'};
       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>Hint Text</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,$value,$position,$text,%values)=@_;      my $number=shift;
     $values{'unused'}='Not shown, not used';      my (%values,%defaultvalues,%customvalues);
       %defaultvalues = &Apache::lonlocal::texthash(
                            'unused' => 'Not shown, not used'
                        );
       if ($qtype eq 'radio') {
           %customvalues = &Apache::lonlocal::texthash(
                                          'true' => 'True',
                                          'false' => 'False'
           );
       } elsif ($qtype eq 'option') {
           %customvalues=&evaloptionhash($qparms{$prefix.'options'});
       }
       %values = (%defaultvalues,%customvalues);
       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'; }
       my $position=$qparms{$prefix.'position'.$number};
     my %positions=('random' => 'Random position',      my %positions=('random' => 'Random position',
    'top'    => 'Show always at top position',     'top'    => 'Show always at top position',
    'bottom' => 'Show always at bottom position');     'bottom' => 'Show always at bottom position');
Line 69  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 %lt=&Apache::lonlocal::texthash('foil'  => 'Foil',
          'value' => 'Value',
          'pos'   => 'Position',
          '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>Foil</b></td></tr>  <tr><td colspan="2"><b>$lt{'foil'}</b></td></tr>
 <tr><td>Value: $selectvalue</td><td>Position: $selectposition</td></tr>  <tr><td>$lt{'value'}: $selectvalue</td><td>$lt{'pos'}: $selectposition</td></tr>
 <tr><td colspan="2">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 />
 ENDFOIL  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 {  sub handler {
     my $r = shift;      my $r = shift;
   
     if ($r->header_only) {      if ($r->header_only) {
         $r->content_type('text/html');          &Apache::loncommon::content_type($r,'text/html');
         $r->send_http_header;          $r->send_http_header;
         return OK;          return OK;
     }      }
   
 # -------------------------------------------------------------------- Allowed?  # -------------------------------------------------------------------- Allowed?
     unless (&Apache::lonnet::allowed('srm',$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
     $r->content_type('text/html');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
 # ----------------------------------------------------- Figure out where we are  # ----------------------------------------------------- Figure out where we are
     my $uri=$r->uri;      my $uri=$r->uri;
     $uri=~s/\/smpedit$//;      $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 for storing weight of Problem Parts
       my $weightprefix=$env{'request.course.id'}.'.'.$symb.'.';
       
 # ---------------------------------------------------------- Anything to store?  # ---------------------------------------------------------- Anything to store?
       my $storeresult;
     if (($symb) && ($ENV{'form.storeproblem'})) {      if (($symb) && (defined($env{'form.questiontype'}))) {
         my %storecontent=();          my %storecontent=();
         undef %storecontent;          undef %storecontent;
         foreach (keys %ENV) {          if ($env{'form.questiontype'} eq 'option') {
     if ($_=~/^form\.(\w+)$/) {      my %curoptions=&evaloptionhash($env{'form.options'});
  my $spnam=$1;      if ($env{'form.delopt'}) {
  my $symbparm=$symb.'.'.$spnam;   delete $curoptions{$env{'form.delopt'}};
   
  my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;  
   
  $storecontent{$courselevelr}=$ENV{'form.'.$spnam};;  
     }      }
       if ($env{'form.newopt'}) {
    $env{'form.newopt'}=~s/\'/\\\'/g;
                   $curoptions{$env{'form.newopt'}}=$env{'form.newopt'};
       }
               $env{'form.options'}="('".join("','",keys(%curoptions))."')";
  }   }
    $env{'form.hiddenparts'}='!'.$env{'form.questiontype'};
           foreach my $envkey (keys(%env)) {
       if ($envkey=~/^form\.(\w+)$/) {
                   my $parm=$1;
    $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   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'});
           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);
   
       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  # ------------------------------------------------------------ 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.$js));
 <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>';
 #          if (&get_parent_uri($symb)) {
 #              $r->print($title);
  $r->print(&questiontext('What color?').              if ($storeresult) {
                   &foil(3,'green','bottom','Tomato',                  $r->print('<p class="LC_error">'.&mt('An error: [_1] occurred saving your changes',$storeresult).'</p>'); 
                   ('green'=>'green','red'=>'red')).              }
   &hint('This is the hint.'));          } 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" action="">');
   # Question Type        
           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(
               '<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 ===
    if (($qtype eq 'radio') || ($qtype eq 'option')) {
   # Response
               my $maxfoils=$qparms{$prefix.'maxfoils'};
               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 $randomize=$qparms{$prefix.'randomize'};
               unless (defined($randomize)) { $randomize='yes'; }
               unless ($randomizes{$randomize}) { $randomize='yes'; }
       $r->print(
     '<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',
                             {&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" style="width:100%">'.
     '<tr><td><input type="hidden" name="options" value="'.
                     $options.'" />'.&mt('Add new option').': '.
             '<input type="text" name="newopt" size="15" />'.
             &mt('Delete an option').': '.
             &Apache::loncommon::select_form('','delopt',{'' => '',%optionshash}).
             '</td></tr><tr><td>');
       }
   # Foils
       for (my $i=1;$i<=10;$i++) {
    $r->print(&foil($i));
       }
   # End Options
       if ($qtype eq 'option') {
    $r->print('</td></tr></table>');
       }
   
   # End Response
       $r->print('</td></tr></table><br />');
   # Hint
       $r->print(&hint());
    }
    if ($qtype eq 'string') {
               my %stringtypes=(
          'cs' => 'Case sensitive',
          'ci' => 'Case Insensitive',
          'mc' => 'Multiple Choice, Order of characters unchecked');
               my $stringanswer=$qparms{$prefix.'stringanswer'};
               unless (defined($stringanswer)) { $stringanswer=''; }
               my $stringtype=$qparms{$prefix.'stringtype'};
               unless (defined($stringtype)) { $stringtype='cs'; }
               unless ($stringtypes{$stringtype}) { $stringtype='cs'; }
       $r->print(
     '<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('Save and Edit').'" />'.
     ('&nbsp;' x3).
     '<input type="submit" value="'.&mt('Save and View').'" onclick="javascript:setForceView();" />'.
     '</form>');
     } else {      } else {
  $r->print('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.1  
changed lines
  Added in v.1.37


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>