Diff for /loncom/homework/inputtags.pm between versions 1.189 and 1.210

version 1.189, 2006/03/09 00:43:05 version 1.210, 2006/11/01 23:24:52
Line 31  use strict; Line 31  use strict;
 use Apache::loncommon;  use Apache::loncommon;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonnet;  use Apache::lonnet;
   use lib '/home/httpd/lib/perl/';
   use LONCAPA;
    
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline'));      &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline'));
Line 137  sub start_textfield { Line 140  sub start_textfield {
     my $resid=$Apache::inputtags::response[-1];      my $resid=$Apache::inputtags::response[-1];
     if ($target eq 'web') {      if ($target eq 'web') {
  $Apache::lonxml::evaluate--;   $Apache::lonxml::evaluate--;
    my $partid=$Apache::inputtags::part;
    my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$resid.submission"},'<>&"');
  if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {   if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
     my $partid=$Apache::inputtags::part;  
     my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$resid.submission"},'<>&"');  
     my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);      my $cols = &Apache::lonxml::get_param('cols',$parstack,$safeeval);
     if ( $cols eq '') { $cols = 80; }      if ( $cols eq '') { $cols = 80; }
     my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);      my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
Line 149  sub start_textfield { Line 152  sub start_textfield {
     if ($addchars) {      if ($addchars) {
  $result.=&addchars('HWVAL_'.$resid,$addchars);   $result.=&addchars('HWVAL_'.$resid,$addchars);
     }      }
     push @Apache::lonxml::htmlareafields,'HWVAL_'.$resid;      &Apache::lonhtmlcommon::add_htmlareafields('HWVAL_'.$resid);
     $result.= '<textarea wrap="hard" name="HWVAL_'.$resid.'" id="HWVAL_'.$resid.'" '.      $result.= '<textarea wrap="hard" name="HWVAL_'.$resid.'" id="HWVAL_'.$resid.'" '.
  "rows=\"$rows\" cols=\"$cols\">".$oldresponse;   "rows=\"$rows\" cols=\"$cols\">".$oldresponse;
     if ($oldresponse ne '') {      if ($oldresponse ne '') {
Line 158  sub start_textfield { Line 161  sub start_textfield {
  &Apache::lonxml::get_all_text("/textfield",$parser,$style);   &Apache::lonxml::get_all_text("/textfield",$parser,$style);
     }      }
  } else {   } else {
     #right or wrong don't show it      #show past answer in the essayresponse case
     #$result='<table border="1"><tr><td><i>'.$oldresponse.'</i></td></tr></table>';      if ($oldresponse =~ /\S/
     $result='';   && &Apache::londefdef::is_inside_of($tagstack,
       'essayresponse') ) {
    $result='<table class="LC_pastsubmission"><tr><td>'.
       $oldresponse.'</td></tr></table>';
       }
     #get rid of any startup text      #get rid of any startup text
     &Apache::lonxml::get_all_text("/textfield",$parser,$style);      &Apache::lonxml::get_all_text("/textfield",$parser,$style);
  }   }
Line 222  sub end_textfield { Line 229  sub end_textfield {
     return $result;      return $result;
 }  }
   
 sub exam_box {  sub exam_score_line {
     my ($target) = @_;      my ($target) = @_;
     my $result;  
   
       my $result;
     if ($target eq 'tex') {      if ($target eq 'tex') {
  $result.='\fbox{\fbox{\parbox{\textwidth-5mm}{\strut\\\\\strut\\\\\strut\\\\\strut\\\\}}}';  
  my $repetition = &Apache::response::repetition();   my $repetition = &Apache::response::repetition();
  $result.='\begin{enumerate}';   $result.='\begin{enumerate}';
    if ($env{'request.state'} eq "construct" ) {$result.='\item[\strut]';}
  foreach my $i (0..$repetition-1) {   foreach my $i (0..$repetition-1) {
     $result.='\item[\textbf{'.      $result.='\item[\textbf{'.
  ($Apache::lonxml::counter+$i).   ($Apache::lonxml::counter+$i).
  '}.]\textit{Leave blank on scoring form}\vskip 0 mm';   '}.]\textit{Leave blank on scoring form}\vskip 0 mm';
  }   }
  $result.= '\end{enumerate}';   $result.= '\end{enumerate}';
       }
   
       return $result;
   }
   
   sub exam_box {
       my ($target) = @_;
       my $result;
   
       if ($target eq 'tex') {
    $result .= '\fbox{\fbox{\parbox{\textwidth-5mm}{\strut\\\\\strut\\\\\strut\\\\\strut\\\\}}}';
    $result .= &exam_score_line($target);
     } elsif ($target eq 'web') {      } elsif ($target eq 'web') {
  my $id=$Apache::inputtags::response[-1];   my $id=$Apache::inputtags::response[-1];
  $result.= '<br /><br />   $result.= '<br /><br />
Line 252  sub needs_exam_box { Line 270  sub needs_exam_box {
  'stringresponse',   'stringresponse',
  'reactionresponse',   'reactionresponse',
  'organicresponse',   'organicresponse',
  'imageresponse',  
  );   );
   
     foreach my $tag (@tags) {      foreach my $tag (@tags) {
Line 266  sub needs_exam_box { Line 283  sub needs_exam_box {
 sub start_textline {  sub start_textline {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     my $result = "";      my $result = "";
       my $input_id = &start_input($parstack,$safeeval);
     if ($target eq 'web') {      if ($target eq 'web') {
  $Apache::lonxml::evaluate--;   $Apache::lonxml::evaluate--;
  my $partid=$Apache::inputtags::part;   my $partid=$Apache::inputtags::part;
  my $id=$Apache::inputtags::response[-1];   my $id=$Apache::inputtags::response[-1];
  if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {   if (!&Apache::response::show_answer()) {
     my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);      my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
     my $maxlength;      my $maxlength;
     if ($size eq '') { $size=20; } else {      if ($size eq '') { $size=20; } else {
  if ($size < 20) { $maxlength=$size; }   if ($size < 20) { $maxlength=$size; }
     }      }
     my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"},'<>&"');      my $oldresponse = $Apache::lonhomework::history{"resource.$partid.$id.submission"};
       &Apache::lonxml::debug("oldresponse $oldresponse is ".ref($oldresponse));
   
       if (ref($oldresponse) eq 'ARRAY') {
    $oldresponse = $oldresponse->[$#Apache::inputtags::inputlist];
       }
       $oldresponse = &HTML::Entities::encode($oldresponse,'<>&"');
   
     if ($Apache::lonhomework::type ne 'exam') {      if ($Apache::lonhomework::type ne 'exam') {
  my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval);   my $addchars=&Apache::lonxml::get_param('addchars',$parstack,$safeeval);
  $result='';   $result='';
Line 285  sub start_textline { Line 310  sub start_textline {
  }   }
  my $readonly=&Apache::lonxml::get_param('readonly',$parstack,   my $readonly=&Apache::lonxml::get_param('readonly',$parstack,
  $safeeval);   $safeeval);
  if (lc($readonly) eq 'yes') {   if (lc($readonly) eq 'yes' 
       || $Apache::inputtags::status[-1] eq 'CANNOT_ANSWER') {
     $readonly=' readonly="readonly" ';      $readonly=' readonly="readonly" ';
  } else {   } else {
     $readonly='';      $readonly='';
  }   }
  $result.= '<input type="text" '.$readonly.' name="HWVAL_'.$id.'" value="'.   my $name = 'HWVAL_'.$id;
    if ($Apache::inputtags::status[-1] eq 'CANNOT_ANSWER') {
       $name = "none";
    }
    $result.= '<input type="text" '.$readonly.' name="'.$name.'" value="'.
     $oldresponse.'" size="'.$size.'" maxlength="'.$maxlength.'" />';      $oldresponse.'" size="'.$size.'" maxlength="'.$maxlength.'" />';
     }      }
     if ($Apache::lonhomework::type eq 'exam'      if ($Apache::lonhomework::type eq 'exam'
Line 299  sub start_textline { Line 329  sub start_textline {
     }      }
  } else {   } else {
     #right or wrong don't show what was last typed in.      #right or wrong don't show what was last typed in.
     $result='<b>'.$Apache::inputtags::answertxt{$id}.'</b>';      my $count = scalar(@Apache::inputtags::inputlist)-1;
       $result='<b>'.$Apache::inputtags::answertxt{$id}[$count].'</b>';
     #$result='';      #$result='';
  }   }
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
Line 334  sub end_textline { Line 365  sub end_textline {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     if    ($target eq 'web') { $Apache::lonxml::evaluate++; }      if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
     elsif ($target eq 'edit') { return ('','no'); }      elsif ($target eq 'edit') { return ('','no'); }
       &end_input();
     return "";      return "";
 }  }
   
Line 397  sub file_selector { Line 429  sub file_selector {
  $result.=&mt('Submit a file: (only one file can be uploaded)').   $result.=&mt('Submit a file: (only one file can be uploaded)').
     ' <br /><input type="file" size="50" name="HWFILE'.      ' <br /><input type="file" size="50" name="HWFILE'.
     $jspart.'_'.$id.'" /><br />';      $jspart.'_'.$id.'" /><br />';
  my $uploadedfile= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.uploadedfile"},'<>&"');   $result .= &show_past_file_submission($part,$id);
   
  if ($uploadedfile) {  
     my $url=$Apache::lonhomework::history{"resource.$part.$id.uploadedurl"};  
     &Apache::lonxml::extlink($url);  
     &Apache::lonnet::allowuploaded('/adm/essayresponse',$url);  
     my $icon=&Apache::loncommon::icon($url);  
     my $curfile='<a href="'.$url.'"><img src="'.$icon.  
  '" border="0" />'.$uploadedfile.'</a>';  
     $result.=&mt('Currently submitted: <tt>[_1]</tt>',$curfile);  
  } else {  
     #$result.=&mt('(Hand in a file you have prepared on your computer)');  
  }  
     }      }
     if ( $which eq 'both') {       if ( $which eq 'both') { 
  $result.='<br />'.'<strong>'.&mt('OR:').'</strong><br />';   $result.='<br />'.'<strong>'.&mt('OR:').'</strong><br />';
Line 419  sub file_selector { Line 439  sub file_selector {
     &mt('Select Portfolio Files').'</a><br />'.      &mt('Select Portfolio Files').'</a><br />'.
     '<input type="text" size="50" name="HWPORT'.$jspart.'_'.$id.'" value="" />'.      '<input type="text" size="50" name="HWPORT'.$jspart.'_'.$id.'" value="" />'.
     '<br />';      '<br />';
  if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"}=~/[^\s]/){   $result .= &show_past_portfile_submission($part,$id);
     my (@filelist,@bad_file_list);  
     foreach my $file (split(',',&Apache::lonnet::unescape($Apache::lonhomework::history{"resource.$part.$id.portfiles"}))) {  
  my (undef,undef,$domain,$user)=&Apache::lonxml::whichuser();  
  my $url="/uploaded/$domain/$user/portfolio$file";  
  my $icon=&Apache::loncommon::icon($url);  
  push(@filelist,'<a href="'.$url.'"><img src="'.$icon.  
      '" border="0" />'.$file.'</a>');  
  if (! &Apache::lonnet::stat_file($url)) {  
     push(@bad_file_list,'<a href="'.$url.'"><img src="'.$icon.  
  '" border="0" />'.$file.'</a>');  
  }  
     }  
     $result.=&mt("Portfolio files previously selected: <strong>[_1]</strong>",join(', ',@filelist));  
     if (@bad_file_list) {  
  $result.='<br />'.&mt('<font color="red">These file(s) don\'t exist:</font> <strong>[_1]</strong>',join(', ',@bad_file_list));  
     }  
  }  
     }      }
     $result.='</td></tr>';       $result.='</td></tr>'; 
     return $result;      return $result;
 }  }
   
 sub checkstatus {  sub show_past_file_submission {
     my ($value,$awardref,$msgref)=@_;      my ($part,$id) = @_;
     for (my $i=0;$i<=$#$awardref;$i++) {      my $uploadedfile= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.uploadedfile"},'<>&"');
  if ($$awardref[$i] eq $value) {  
     return ($$awardref[$i],$$msgref[$i]);      return if (!$uploadedfile);
  }  
       my $url=$Apache::lonhomework::history{"resource.$part.$id.uploadedurl"};
       &Apache::lonxml::extlink($url);
       &Apache::lonnet::allowuploaded('/adm/essayresponse',$url);
       my $icon=&Apache::loncommon::icon($url);
       my $curfile='<a href="'.$url.'"><img src="'.$icon.
    '" border="0" />'.$uploadedfile.'</a>';
       return &mt('Currently submitted: <tt>[_1]</tt>',$curfile);
   
   }
   
   sub show_past_portfile_submission {
       my ($part,$id) = @_;
       if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"}!~/[^\s]/){
    return;
       }
       my (@file_list,@bad_file_list);
       foreach my $file (split(/\s*,\s*/,&unescape($Apache::lonhomework::history{"resource.$part.$id.portfiles"}))) {
    my (undef,undef,$domain,$user)=&Apache::lonnet::whichuser();
    my $url="/uploaded/$domain/$user/portfolio$file";
    my $icon=&Apache::loncommon::icon($url);
    push(@file_list,'<a href="'.$url.'"><img src="'.$icon.
        '" border="0" />'.$file.'</a>');
    if (! &Apache::lonnet::stat_file($url)) {
       &Apache::lonnet::logthis("bad file is $url");
       push(@bad_file_list,'<a href="'.$url.'"><img src="'.$icon.
    '" border="0" />'.$file.'</a>');
    }
       }
       my $files = '<span class="LC_filename">'.
    join('</span>, <span class="LC_filename">',@file_list).
    '</span>';
       my $result = &mt("Portfolio files previously selected: [_1]",$files);
       if (@bad_file_list) {
    my $bad_files = '<span class="LC_filename">'.
       join('</span>, <span class="LC_filename">',@bad_file_list).
       '</span>';
    $result.='<br />'.&mt('<span class="LC_error">These file(s) don\'t exist:</span> [_1]',$bad_files);
     }      }
     return(undef,undef);      return $result;
   
 }  }
   
 sub valid_award {  sub valid_award {
Line 469  sub valid_award { Line 511  sub valid_award {
     return 0;      return 0;
 }  }
   
   {
       my @awards = ('EXTRA_ANSWER', 'MISSING_ANSWER', 'ERROR', 'NO_RESPONSE',
     'TOO_LONG',
     'UNIT_INVALID_INSTRUCTOR', 'UNIT_INVALID_STUDENT',
     'UNIT_IRRECONCIBLE', 'UNIT_FAIL', 'NO_UNIT',
     'UNIT_NOTNEEDED', 'WANTED_NUMERIC', 'BAD_FORMULA',
     'COMMA_FAIL', 'SIG_FAIL', 'INCORRECT', 'MISORDERED_RANK',
     'INVALID_FILETYPE', 'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE',
     'APPROX_ANS', 'EXACT_ANS');
       my $i=0;
       my %fwd_awards = map { ($_,$i++) } @awards;
       my $max=scalar(@awards);
       @awards=reverse(@awards);
       $i=0;
       my %rev_awards = map { ($_,$i++) } @awards;
   
 sub finalizeawards {  sub finalizeawards {
     my ($awardref,$msgref,$nameref,$reverse)=@_;      my ($awardref,$msgref,$nameref,$reverse)=@_;
     my $result=undef;      my $result;
     my $award;  
     my $msg;  
     if ($#$awardref == -1) { $result = "NO_RESPONSE"; }      if ($#$awardref == -1) { $result = "NO_RESPONSE"; }
     if ($result eq '' ) {      if ($result eq '' ) {
  my $blankcount;   my $blankcount;
  foreach $award (@$awardref) {   foreach my $award (@$awardref) {
     if ($award eq '') {      if ($award eq '') {
  $result='MISSING_ANSWER';   $result='MISSING_ANSWER';
  $blankcount++;   $blankcount++;
Line 485  sub finalizeawards { Line 541  sub finalizeawards {
  }   }
  if ($blankcount == ($#$awardref + 1)) { $result = 'NO_RESPONSE'; }   if ($blankcount == ($#$awardref + 1)) { $result = 'NO_RESPONSE'; }
     }      }
     if (defined($result)) { return ($result,$msg); }      if (defined($result)) { return ($result); }
   
     # these awards are ordered from most important error through best correct      # these awards are ordered from most important error through best correct
           my $awards = (!$reverse) ? \%fwd_awards : \%rev_awards ;
     my @awards = ('EXTRA_ANSWER', 'MISSING_ANSWER', 'ERROR', 'NO_RESPONSE',  
   'TOO_LONG',      my $best = $max;
   'UNIT_INVALID_INSTRUCTOR', 'UNIT_INVALID_STUDENT',      my $j=0;
   'UNIT_IRRECONCIBLE', 'UNIT_FAIL', 'NO_UNIT',      my $which;
   'UNIT_NOTNEEDED', 'WANTED_NUMERIC', 'BAD_FORMULA',      foreach my $award (@$awardref) {
   'COMMA_FAIL', 'SIG_FAIL', 'INCORRECT', 'MISORDERED_RANK',   if ($awards->{$award} < $best) {
   'INVALID_FILETYPE', 'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE',      $best  = $awards->{$award};
   'APPROX_ANS', 'EXACT_ANS');      $which = $j;
     if ($reverse) { @awards=reverse(@awards); }   }
     foreach my $possibleaward (@awards) {   $j++;
  ($result,$msg)=&checkstatus($possibleaward,$awardref,$msgref);      }
  if (defined($result)) { return ($result,$msg); }      if (defined($which)) {
    if (ref($nameref)) {
       return ($$awardref[$which],$$msgref[$which],$$nameref[$which]);
    } else {
       return ($$awardref[$which],$$msgref[$which]);
    }
     }      }
     return ('ERROR',undef);      return ('ERROR',undef);
 }  }
   }
   
 sub decideoutput {  sub decideoutput {
     my ($award,$awarded,$awardmsg,$solved,$previous,$target)=@_;      my ($award,$awarded,$awardmsg,$solved,$previous,$target)=@_;
Line 513  sub decideoutput { Line 575  sub decideoutput {
     my $bgcolor='orange';      my $bgcolor='orange';
     my $added_computer_text=0;      my $added_computer_text=0;
     my %possiblecolors =      my %possiblecolors =
  ( 'correct' => '#aaffaa',   ( 'correct'         => '#aaffaa',
   'charged_try' => '#ffaaaa',    'charged_try'     => '#ffaaaa',
   'not_charged_try' => '#ffffaa',    'not_charged_try' => '#ffffaa',
   'no_message' => '#fffff',    'no_grade'        => '#ffffaa',
     'no_message'      => '#ffffff',
   );    );
   
     my $part = $Apache::inputtags::part;      my $part = $Apache::inputtags::part;
Line 529  sub decideoutput { Line 592  sub decideoutput {
   
     if ($previous) { $previousmsg=&mt('You have entered that answer before'); }      if ($previous) { $previousmsg=&mt('You have entered that answer before'); }
           
     if      ($solved =~ /^correct/) {      if ($solved =~ /^correct/) {
  $bgcolor=$possiblecolors{'correct'};          $bgcolor=$possiblecolors{'correct'};
  $message=&mt('You are correct.');   $message=&mt('You are correct.');
  if ($awarded < 1 && $awarded > 0) {   if ($awarded < 1 && $awarded > 0) {
     $message=&mt('You are partially correct.');      $message=&mt('You are partially correct.');
Line 675  sub decideoutput { Line 738  sub decideoutput {
  $button=1;   $button=1;
     } elsif ($award eq 'SUBMITTED') {      } elsif ($award eq 'SUBMITTED') {
  $message = &mt("Your submission has been recorded.");   $message = &mt("Your submission has been recorded.");
  $bgcolor=$possiblecolors{'correct'};   $bgcolor=$possiblecolors{'no_grade'};
  $button=1;   $button=1;
     } elsif ($award eq 'DRAFT') {      } elsif ($award eq 'DRAFT') {
  $message = &mt("A draft copy has been saved.");   $message = &mt("A draft copy has been saved.");
Line 697  sub decideoutput { Line 760  sub decideoutput {
  $message = &mt("Unknown message").": $award";   $message = &mt("Unknown message").": $award";
  $button=1;   $button=1;
     }      }
       my (undef,undef,$domain,$user)=&Apache::lonnet::whichuser();
       foreach my $resid(@Apache::inputtags::response){
           if ($Apache::lonhomework::history{"resource.$part.$resid.handback"}) {
       $message.='<br />';
       my @files = split(/\s*,\s*/,
         $Apache::lonhomework::history{"resource.$part.$resid.handback"});
       my $file_msg;
       foreach my $file (@files) {
    $file_msg.= '<br /><a href="/uploaded/'."$domain/$user".'/'.$file.'">'.$file.'</a>';
       }
       $message .= &mt('Returned file(s): [_1]',$file_msg);
    }
       }
   
     if (lc($Apache::lonhomework::problemstatus) eq 'no'  &&       if (lc($Apache::lonhomework::problemstatus) eq 'no'  && 
  $Apache::inputtags::status[-1] ne 'SHOW_ANSWER') {   $Apache::inputtags::status[-1] ne 'SHOW_ANSWER') {
  $message = &mt("Answer Submitted: Your final submission will be graded after the due date.");   $message = &mt("Answer Submitted: Your final submission will be graded after the due date.");
  $bgcolor=$possiblecolors{'correct'};   $bgcolor=$possiblecolors{'no_grade'};
  $button=1;   $button=1;
     }      }
     if ($Apache::inputtags::status[-1] eq 'SHOW_ANSWER' &&       if ($Apache::inputtags::status[-1] eq 'SHOW_ANSWER' && 

Removed from v.1.189  
changed lines
  Added in v.1.210


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