[BACK]Return to inputtags.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/inputtags.pm between versions 1.170 and 1.182

version 1.170, 2005/06/28 21:41:08 version 1.182, 2005/11/16 23:17:39
Line 36  BEGIN { Line 36  BEGIN {
     &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline'));      &Apache::lonxml::register('Apache::inputtags',('hiddenline','textfield','textline'));
 }  }
   
   #   Initializes a set of global variables used during the parse of the problem.
   #
   #  @Apache::inputtags::input        - List of current input ids.
   #  @Apache::inputtags::inputlist    - List of all input ids seen this problem.
   #  @Apache::inputtags::response     - List of all current resopnse ids.
   #  @Apache::inputtags::responselist - List of all response ids seen this 
   #                                       problem.
   #  @Apache::inputtags::hint         - List of all hint ids.
   #  @Apache::inputtags::hintlist     - List of all hint ids seen this problem.
   #  @Apache::inputtags::previous     - List describing if specific responseds
   #                                       have been used
   #  @Apache::inputtags::previous_version - Submission responses were used in.
   #  $Apache::inputtags::part         - Current part id (valid only in 
   #                                       <problem>)
   #                                     0 if not in a part.
   #  @Apache::inputtags::partlist     - List of part ids seen in the current
   #                                       <problem>
   #  @Apache::inputtags::status       - List of problem  statuses. First 
   #                                     element is the status of the <problem>
   #                                     the remainder are for individual <part>s.
   #  %Apache::inputtags::params       - Hash of defined parameters for the
   #                                     current response.
   #  @Apache::inputtags::import       - List of all ids for <import> thes get
   #                                     join()ed and prepended.
   #  @Apache::inputtags::importlist   - List of all import ids seen.
   #  $Apache::inputtags::response_with_no_part
   #                                   - Flag set true if we have seen a response
   #                                     that is not inside a <part>
   #  %Apache::inputtags::answertxt    - <*response> tags store correct
   #                                     answer strings for display by <textline/>
   #                                     in this hash.
   
 sub initialize_inputtags {  sub initialize_inputtags {
     # list of current input ids  
     @Apache::inputtags::input=();      @Apache::inputtags::input=();
     # list of all input ids seen in this problem  
     @Apache::inputtags::inputlist=();      @Apache::inputtags::inputlist=();
     # list of all current response ids  
     @Apache::inputtags::response=();      @Apache::inputtags::response=();
     # list of all response ids seen in this problem  
     @Apache::inputtags::responselist=();      @Apache::inputtags::responselist=();
     # list of whether or not a specific response was previously used      @Apache::inputtags::hint=();
       @Apache::inputtags::hintlist=();
     @Apache::inputtags::previous=();      @Apache::inputtags::previous=();
     # submission it was used in  
     @Apache::inputtags::previous_version=();      @Apache::inputtags::previous_version=();
     # id of current part, 0 means that no part is current   
     # (inside <problem> only  
     $Apache::inputtags::part='';      $Apache::inputtags::part='';
     # list of all part ids seen  
     @Apache::inputtags::partlist=();      @Apache::inputtags::partlist=();
     # list of problem date statuses, the first element is for <problem>  
     # if there is a second element it is for the current <part>  
     @Apache::inputtags::status=();      @Apache::inputtags::status=();
     # hash of defined params for the current response  
     %Apache::inputtags::params=();      %Apache::inputtags::params=();
     # list of all ids, for <import>, these get join()ed and prepended  
     @Apache::inputtags::import=();      @Apache::inputtags::import=();
     # list of all import ids seen  
     @Apache::inputtags::importlist=();      @Apache::inputtags::importlist=();
     # just used to note whether we have seen a response that isn't in a part  
     $Apache::inputtags::response_with_no_part=0;      $Apache::inputtags::response_with_no_part=0;
     # storage location so the begin <*response> tag can generate the correct  
     # answer string for display by the <textline />  
     %Apache::inputtags::answertxt=();      %Apache::inputtags::answertxt=();
 }  }
   
Line 75  sub check_for_duplicate_ids { Line 91  sub check_for_duplicate_ids {
     my %check;      my %check;
     foreach my $id (@Apache::inputtags::partlist,      foreach my $id (@Apache::inputtags::partlist,
     @Apache::inputtags::responselist,      @Apache::inputtags::responselist,
       @Apache::inputtags::hintlist,
     @Apache::inputtags::importlist) {      @Apache::inputtags::importlist) {
  $check{$id}++;   $check{$id}++;
     }      }
Line 301  sub end_hiddenline { Line 318  sub end_hiddenline {
 # $which -> 'uploadedonly'  -> only newly uploaded files  # $which -> 'uploadedonly'  -> only newly uploaded files
 #           'portfolioonly' -> only allow files from portfolio  #           'portfolioonly' -> only allow files from portfolio
 #           'both' -> allow files from either location  #           'both' -> allow files from either location
   # $extratext -> additional text to go between the link and the input box
 # returns a table row <tr>   # returns a table row <tr> 
 sub file_selector {  sub file_selector {
     my ($part,$id,$uploadedfiletypes,$which)=@_;      my ($part,$id,$uploadedfiletypes,$which,$extratext)=@_;
     if (!$uploadedfiletypes) { return ''; }      if (!$uploadedfiletypes) { return ''; }
   
     my $jspart=$part;      my $jspart=$part;
Line 324  sub file_selector { Line 342  sub file_selector {
   
  if ($uploadedfile) {   if ($uploadedfile) {
     my $url=$Apache::lonhomework::history{"resource.$part.$id.uploadedurl"};      my $url=$Apache::lonhomework::history{"resource.$part.$id.uploadedurl"};
     push (@Apache::lonxml::extlinks,$url);      &Apache::lonxml::extlink($url);
     &Apache::lonnet::allowuploaded('/adm/essayresponse',$url);      &Apache::lonnet::allowuploaded('/adm/essayresponse',$url);
     my $icon=&Apache::loncommon::icon($url);      my $icon=&Apache::loncommon::icon($url);
     my $curfile='<a href="'.$url.'"><img src="'.$icon.      my $curfile='<a href="'.$url.'"><img src="'.$icon.
Line 338  sub file_selector { Line 356  sub file_selector {
  $result.='<br />'.'<strong>'.&mt('OR:').'</strong><br />';   $result.='<br />'.'<strong>'.&mt('OR:').'</strong><br />';
     }      }
     if ($which eq 'portfolioonly' || $which eq 'both') {       if ($which eq 'portfolioonly' || $which eq 'both') { 
  $result.='<a href='."'".'javascript:void(window.open("/adm/portfolio?mode=selectfile&amp;fieldname=HWPORT'.$jspart.'_'.$id.'","cat","height=600,width=800,scrollbars=1,resizable=1,menubar=2,location=1"))'."'".'>'.   $result.=$extratext.'<a href='."'".'javascript:void(window.open("/adm/portfolio?mode=selectfile&amp;fieldname=HWPORT'.$jspart.'_'.$id.'","cat","height=600,width=800,scrollbars=1,resizable=1,menubar=2,location=1"))'."'".'>'.
     &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 />';
Line 368  sub checkstatus { Line 386  sub checkstatus {
     return(undef,undef);      return(undef,undef);
 }  }
   
   sub valid_award {
       my ($award) =@_;
       foreach my $possibleaward ('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', 'SIG_FAIL', 'INCORRECT', 
          'MISORDERED_RANK', 'INVALID_FILETYPE',
          'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE',
          'APPROX_ANS', 'EXACT_ANS','COMMA_FAIL') {
    if ($award eq $possibleaward) { return 1; }
       }
       return 0;
   }
   
 sub finalizeawards {  sub finalizeawards {
     my ($awardref,$msgref)=@_;      my ($awardref,$msgref,$nameref,$reverse)=@_;
     my $result=undef;      my $result=undef;
     my $award;      my $award;
     my $msg;      my $msg;
Line 385  sub finalizeawards { Line 420  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,$msg); }
     foreach my $possibleaward ('MISSING_ANSWER', 'ERROR', 'NO_RESPONSE',  
        'TOO_LONG', 'UNIT_INVALID_INSTRUCTOR',      # these awards are ordered from most important error through best correct
        'UNIT_INVALID_STUDENT', 'UNIT_IRRECONCIBLE',      
        'UNIT_FAIL', 'NO_UNIT',      my @awards = ('EXTRA_ANSWER', 'MISSING_ANSWER', 'ERROR', 'NO_RESPONSE',
        'UNIT_NOTNEEDED', 'WANTED_NUMERIC',    'TOO_LONG',
        'BAD_FORMULA', 'SIG_FAIL', 'INCORRECT',     'UNIT_INVALID_INSTRUCTOR', 'UNIT_INVALID_STUDENT',
        'MISORDERED_RANK', 'INVALID_FILETYPE',    'UNIT_IRRECONCIBLE', 'UNIT_FAIL', 'NO_UNIT',
        'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE',    'UNIT_NOTNEEDED', 'WANTED_NUMERIC', 'BAD_FORMULA',
        'APPROX_ANS', 'EXACT_ANS','COMMA_FAIL') {    'COMMA_FAIL', 'SIG_FAIL', 'INCORRECT', 'MISORDERED_RANK',
     'INVALID_FILETYPE', 'DRAFT', 'SUBMITTED', 'ASSIGNED_SCORE',
     'APPROX_ANS', 'EXACT_ANS');
       if ($reverse) { @awards=reverse(@awards); }
       foreach my $possibleaward (@awards) {
  ($result,$msg)=&checkstatus($possibleaward,$awardref,$msgref);   ($result,$msg)=&checkstatus($possibleaward,$awardref,$msgref);
  if (defined($result)) { return ($result,$msg); }   if (defined($result)) { return ($result,$msg); }
     }      }
Line 414  sub decideoutput { Line 453  sub decideoutput {
   'no_message' => '#fffff',    'no_message' => '#fffff',
   );    );
   
       my $part = $Apache::inputtags::part;
       my $handgrade = 
    ('yes' eq lc(&Apache::lonnet::EXT("resource.$part.handgrade")));
       
       my $computer = ($handgrade)? ''
                          : " ".&mt("Computer's answer now shown above.");
       &Apache::lonxml::debug("handgrade has :$handgrade:");
   
     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/) {
Line 426  sub decideoutput { Line 473  sub decideoutput {
     $message=&mt('Incorrect.');      $message=&mt('Incorrect.');
     $bgcolor=$possiblecolors{'charged_try'};      $bgcolor=$possiblecolors{'charged_try'};
  }   }
  if ($award eq 'ASSIGNED_SCORE') {   if ($env{'request.filename'} =~ 
       m|/res/lib/templates/examupload.problem$|) {
     $message = &mt("A score has been assigned.");      $message = &mt("A score has been assigned.");
       $added_computer_text=1;
  } else {   } else {
     if ($target eq 'tex') {      if ($target eq 'tex') {
  $message = '\textbf{'.$message.'}';   $message = '\textbf{'.$message.'}';
     } else {      } else {
  $message = "<b>".$message."</b>";   $message = "<b>".$message."</b>";
  $message.=" ".&mt("Computer's answer now shown above.");   $message.= $computer;
     }      }
     $added_computer_text=1;      $added_computer_text=1;
     unless ($env{'course.'.      unless ($env{'course.'.
Line 465  sub decideoutput { Line 514  sub decideoutput {
  $message = '\textbf{'.&mt('You are correct.').'}';   $message = '\textbf{'.&mt('You are correct.').'}';
     } else {      } else {
  $message = "<b>".&mt('You are correct.')."</b>";   $message = "<b>".&mt('You are correct.')."</b>";
  $message.=" ".&mt("Computer's answer now shown above.");   $message.= $computer;
     }      }
     $added_computer_text=1;      $added_computer_text=1;
     unless ($env{'course.'.      unless ($env{'course.'.
Line 483  sub decideoutput { Line 532  sub decideoutput {
  $message = '';   $message = '';
  $bgcolor=$possiblecolors{'no_feedback'};   $bgcolor=$possiblecolors{'no_feedback'};
  $button=1;   $button=1;
       } elsif ($award eq 'EXTRA_ANSWER') {
    $message = &mt('Some extra items were submitted.');
    $bgcolor=$possiblecolors{'not_charged_try'};
    $button = 1;
     } elsif ($award eq 'MISSING_ANSWER') {      } elsif ($award eq 'MISSING_ANSWER') {
  $message = &mt('Some items were not submitted.');   $message = &mt('Some items were not submitted.');
  $bgcolor=$possiblecolors{'not_charged_try'};   $bgcolor=$possiblecolors{'not_charged_try'};
Line 581  sub decideoutput { Line 634  sub decideoutput {
     }      }
     if ($Apache::inputtags::status[-1] eq 'SHOW_ANSWER' &&       if ($Apache::inputtags::status[-1] eq 'SHOW_ANSWER' && 
  !$added_computer_text && $target ne 'tex') {   !$added_computer_text && $target ne 'tex') {
  $message.=" ".&mt("Computer's answer now shown above.");   $message.= $computer;
  $added_computer_text=1;   $added_computer_text=1;
     }      }
     return ($button,$bgcolor,$message,$previousmsg);      return ($button,$bgcolor,$message,$previousmsg);
Removed from v.1.170  
changed lines
  Added in v.1.182

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