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

Diff for /loncom/homework/inputtags.pm between versions 1.4 and 1.58

version 1.4, 2000/09/19 20:12:17 version 1.58, 2002/07/25 20:55:13
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # input  definitons  # input  definitons
   #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
   # 2/19 Guy 
   
 package Apache::inputtags;  package Apache::inputtags;
   use HTML::Entities();
 use strict;  use strict;
   
 sub BEGIN {  BEGIN {
   &Apache::lonxml::register('Apache::inputtags',('textline','answergroup'));    &Apache::lonxml::register('Apache::inputtags',('textfield','textline','datasubmission'));
 }  }
   
   
 sub initialize_inputtags {  sub initialize_inputtags {
   $Apache::inputtags::curvalue=0;    # list of current input ids
     @Apache::inputtags::input=();
     # list of all input ids seen in this problem
     @Apache::inputtags::inputlist=();
     # list of all current response ids
     @Apache::inputtags::response=();
     # list of all response ids seen in this problem
     @Apache::inputtags::responselist=();
     # list of whether or not a specific response was previously used
     @Apache::inputtags::previous=();
     # id of current part, 0 means that no part is current (inside <problem> only
     $Apache::inputtags::part='';
     # 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=();
     # hash of defined params for the current response
     %Apache::inputtags::params=();
     # list of all ids, for <import>, these get join()ed and prepended
     @Apache::inputtags::import=();
   }
   
   sub start_input {
     my ($parstack,$safeeval)=@_;
     my $id = &Apache::lonxml::get_param('id',$parstack,$safeeval);
     if ($id eq '') { $id = $Apache::lonxml::curdepth; }
     push (@Apache::inputtags::input,$id);
     push (@Apache::inputtags::inputlist,$id);
     return $id;
   }
   
   sub end_input {
     pop @Apache::inputtags::input;
     return '';
   }
   
   sub start_textfield {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     my $result = "";
     my $id = &start_input($parstack,$safeeval);
     my $resid=$Apache::inputtags::response[-1];
     if ($target eq 'web') {
       $Apache::lonxml::evaluate--;
       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);
       if ( $cols eq '') { $cols = 80; }
       my $rows = &Apache::lonxml::get_param('rows',$parstack,$safeeval);
       if ( $rows eq '') { $rows = 10; }
       if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
         $result= '<textarea name="HWVAL'.$resid.'" '.
    "rows=\"$rows\" cols=\"$cols\">".$oldresponse;
       } else {
         $result='<table border="1"><tr><td><i>'.$oldresponse.'</i></td></tr></table>';
       }
       if ($oldresponse ne '') {
         #get rid of any startup text if the user has already responded
         &Apache::lonxml::get_all_text("/textfield",$$parser[-1]);
       }
     }
     if ($target eq 'grade') {
       my $seedtext=&Apache::lonxml::get_all_text("/textfield",$$parser[-1]);
       if ($seedtext eq $ENV{'form.HWVAL'.$resid}) {
         # if the seed text is still there it wasn't a real submission
         $ENV{'form.HWVAL'.$resid}='';
       }
     }
     return $result;
   }
   
   sub end_textfield {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     if ($target eq 'web') {
       $Apache::lonxml::evaluate++;
       if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
         return "</textarea>";
       }
     }
     &end_input;
     return '';
 }  }
   
 sub start_textline {  sub start_textline {
   my ($target,$token,$parstack,$parser,$safeeval)=@_;    my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
   my $result = "";    my $result = "";
   $Apache::inputtags::curvalue++;  
   if ($target eq 'web') {    if ($target eq 'web') {
     $result= '<input name="HWVAL'.$Apache::inputtags::curvalue.'" value="">';      $Apache::lonxml::evaluate--;
       my $size = &Apache::lonxml::get_param('size',$parstack,$safeeval);
       if ($size eq '') { $size=20; }
       my $partid=$Apache::inputtags::part;
       my $id=$Apache::inputtags::response[-1];
       my $oldresponse = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$partid.$id.submission"});
       if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
         $result= '<input type="text" name="HWVAL'.$id.'" value="'.
    $oldresponse.'" size="'.$size.'" />';
       } else {
         $result='<i>'.$oldresponse.'</i>';
       }
     } elsif ($target eq 'edit') {
       $result=&Apache::edit::tag_start($target,$token);
       $result.=&Apache::edit::text_arg('Size:','size',$token,'5')."</td></tr>";
       $result.=&Apache::edit::end_table;
     } elsif ($target eq 'modified') {
       my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'size');
       if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
   }    }
   return $result;    return $result;
 }  }
   
 sub end_textline {  sub end_textline {
   my ($target,$token,$parstack,$parser,$safeeval)=@_;    my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     if    ($target eq 'web') { $Apache::lonxml::evaluate++; }
     elsif ($target eq 'edit') { return ('','no'); }
     return "";
   }
   
   sub start_datasubmission {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     my $id = &Apache::response::start_response($parstack,$safeeval);
     my $result;
     if ($target eq 'meta') {
       $result = &Apache::response::meta_stores_write($token->[2]->{'name'},
      $token->[2]->{'type'},
      $token->[2]->{'display'});
       $result .= &Apache::response::meta_package_write('datasubmission');
     }
     return $result;
   }
   
   sub end_datasubmission {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval)=@_;
     my $result;
     if ( $target eq 'web' ) {
     } elsif ($target eq 'grade' ) {
       if ( defined $ENV{'form.submitted'}) {
         &Apache::response::setup_params('datasubmission');
         my $partid = $Apache::inputtags::part;
         my $id = $Apache::inputtags::response['-1'];
         my $response = $ENV{'form.HWVAL'.$id};
         my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
         if ( $response =~ /[^\s]/) {
    $Apache::lonhomework::results{"resource.$partid.$id.$name"}=
     $response;
         }
       }
     }
     &Apache::response::end_response;
     return $result;
 }  }
   
 sub start_answergroup {  sub finalizeawards {
     my $result='';
     my $award;
     if ($#_ == '-1') { $result = "NO_RESPONSE"; }
     if ($result eq '' ) {
       my $blankcount;
       foreach $award (@_) {
         if ($award eq '') {
    $result='MISSING_ANSWER';
    $blankcount++;
         }
       }
       if ($blankcount == ($#_ + 1)) { $result = 'NO_RESPONSE'; }
     }
     if ($result eq '' ) {
       foreach $award (@_) { if ($award eq 'MISSING_ANSWER') {$result='MISSING_ANSWER'; last;}}
     }
     if ($result eq '' ) {
       foreach $award (@_) { if ($award eq 'ERROR') {$result='ERROR'; last;}}
     }
     if ($result eq '' ) {
       foreach $award (@_) { if ($award eq 'NO_RESPONSE') {$result='NO_RESPONSE'; last;} }
     }
   
     if ($result eq '' ) {
       foreach $award (@_) { 
         if ($award eq 'UNIT_FAIL' ||
     $award eq 'NO_UNIT' ||
     $award eq 'UNIT_NOTNEEDED') {
    $result=$award; last;
         }
       }
     }
     if ($result eq '' ) {
       foreach $award (@_) { 
         if ($award eq 'WANTED_NUMERIC' || 
     $award eq 'BAD_FORMULA') {$result=$award; last;}
       }
     }
     if ($result eq '' ) {
       foreach $award (@_) { if ($award eq 'SIG_FAIL') {$result=$award; last;} }
     }
     if ($result eq '' ) {
       foreach $award (@_) { if ($award eq 'INCORRECT') {$result=$award; last;} }
     }
     if ($result eq '' ) {
       foreach $award (@_) { if ($award eq 'SUBMITTED') {$result=$award; last;} }
     }
     if ($result eq '' ) {
       foreach $award (@_) { if ($award eq 'APPROX_ANS') {$result=$award; last;} }
     }
     if ($result eq '' ) { $result='EXACT_ANS'; }
     return $result
   }
   
   sub decideoutput {
     my ($award,$solved,$previous)=@_;
     my $message='';
     my $button=0;
     my $previousmsg;
   
     if ($previous) { $previousmsg='You have entered that answer before'; }
   
     if      ($solved =~ /^correct/) {
       $message = "<b>You are correct.</b> Your receipt is ".
         &Apache::lonnet::receipt;
       $button=0;
       $previousmsg='';
     } elsif ($solved =~ /^excused/) {
       $message = "<b>You are excused from the problem.</b>";
       $button=0;
       $previousmsg='';
     } elsif ($award eq 'EXACT_ANS' || $award eq 'APPROX_ANS' ) {
       if ($solved =~ /^incorrect/ || $solved eq '') {
         $message = "Incorrect";
         $button=1;
       } else {
         $message = "<b>You are correct.</b> Your receipt is ".
    &Apache::lonnet::receipt;
         $button=0;
         $previousmsg='';
       }
     } elsif ($award eq 'NO_RESPONSE') {
       $message = '';
       $button=1;
     } elsif ($award eq 'MISSING_ANSWER') {
       $message = 'Some parts were not submitted';
       $button = 1;
     } elsif ($award eq 'WANTED_NUMERIC') {
       $message = "This question expects a numeric answer";
       $button=1;
     } elsif ($award eq 'SIG_FAIL') {
       $message = "Please adjust significant figures.";# you provided %s significant figures";
       $button=1;
     } elsif ($award eq 'UNIT_FAIL') {
       $message = "Units incorrect."; #Computer reads units as %s";
       $button=1;
     } elsif ($award eq 'UNIT_NOTNEEDED') {
       $message = "Only a number required.";# Computer reads units of %s";
       $button=1;
     } elsif ($award eq 'NO_UNIT') {
       $message = "Units required";
       $button=1;
     } elsif ($award eq 'BAD_FORMULA') {
       $message = "Unable to understand formula";
       $button=1;
     } elsif ($award eq 'INCORRECT') {
       $message = "Incorrect";
       $button=1;
     } elsif ($award eq 'SUBMITTED') {
       $message = "Your submission has been recorded.";
       $button=1;
     } else {
       $message = "Unknown message: $award";
       $button=1;
     }
     return ($button,$message,$previousmsg);
   }
   
   sub setgradedata {
     my ($award,$id,$previously_used) = @_;
     # if the student already has it correct, don't modify the status
     if ($Apache::inputtags::status['-1'] ne 'CAN_ANSWER') {
       $Apache::lonhomework::results{"resource.$id.afterduedate"}=$award;
       return '';
     } elsif ( $Apache::lonhomework::history{"resource.$id.solved"} !~
          /^correct/ ) {
       #handle assignment of tries and solved status
       if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {
         $Apache::lonhomework::results{"resource.$id.afterduedate"}='';
       }
       if ( $award eq 'APPROX_ANS' || $award eq 'EXACT_ANS' ) {
         $Apache::lonhomework::results{"resource.$id.tries"} =
    $Apache::lonhomework::history{"resource.$id.tries"} + 1;
         $Apache::lonhomework::results{"resource.$id.solved"} =
    'correct_by_student';
         $Apache::lonhomework::results{"resource.$id.awarded"} = '1';
       } elsif ( $award eq 'INCORRECT' ) {
         $Apache::lonhomework::results{"resource.$id.tries"} =
    $Apache::lonhomework::history{"resource.$id.tries"} + 1;
         $Apache::lonhomework::results{"resource.$id.solved"} =
    'incorrect_attempted';
       } elsif ( $award eq 'SUBMITTED' ) {
         $Apache::lonhomework::results{"resource.$id.tries"} =
    $Apache::lonhomework::history{"resource.$id.tries"} + 1;
         $Apache::lonhomework::results{"resource.$id.solved"} =
    'ungraded_attempted';
       } elsif ( $award eq 'NO_RESPONSE' ) {
         return '';
       } else {
         $Apache::lonhomework::results{"resource.$id.solved"} =
    'incorrect_attempted';
       }
   
       # check if this was a previous submission if it was delete the
       # unneeded data and update the previously_used attribute
       if ( $previously_used eq 'PREVIOUSLY_USED') {
         delete($Apache::lonhomework::results{"resource.$id.tries"});
         $Apache::lonhomework::results{"resource.$id.previous"} = '1';
       } elsif ( $previously_used eq 'PREVIOUSLY_LAST') {
         #delete all data as they student didn't do anything, but save
         #the list of collaborators.
         foreach my $key (keys(%Apache::lonhomework::results)) {
    if (($key =~ /^resource\.$id\./) && ($key !~ /\.collaborators$/)) {
     &Apache::lonxml::debug("Removing $key");
     delete($Apache::lonhomework::results{$key});
    }
         }
         #and since they didn't do anything we were never here
         return '';
       } else {
         $Apache::lonhomework::results{"resource.$id.previous"} = '0';
       }
     }
     $Apache::lonhomework::results{"resource.$id.award"} = $award;
 }  }
   
 sub end_answergroup {  sub grade {
   my ($target,$token,$parstack,$parser,$safeeval)=@_;    my ($target) = @_;
   if ( $target == 'web' ) {    my $id = $Apache::inputtags::part;
     return '<input type="submit" name="'.$ENV{'form.request.prefix'}.'submit" value="Submit All Answers">';    my $response='';
     if ( defined $ENV{'form.submitted'}) {
       my @awards = ();
       foreach $response (@Apache::inputtags::responselist) {
         &Apache::lonxml::debug("looking for response.$id.$response.awarddetail");
         my $value=$Apache::lonhomework::results{"resource.$id.$response.awarddetail"};
         &Apache::lonxml::debug("keeping $value from $response for $id");
         push (@awards,$value);
       }
       my $finalaward = &finalizeawards(@awards);
       my $previously_used;
       if ( $#Apache::inputtags::previous eq $#awards ) {
         $previously_used = 'PREVIOUSLY_LAST';
         foreach my $value (@Apache::inputtags::previous) {
    if ($value eq 'PREVIOUSLY_USED' ) {
     $previously_used = $value;
     last;
    }
         }
       }
       &Apache::lonxml::debug("final award $finalaward, $previously_used");
       &setgradedata($finalaward,$id,$previously_used);
   }    }
     return '';
 }  }
   
   sub gradestatus {
     my ($id) = @_;
     my $showbutton = 1;
     my $message = '';
     my $latemessage = '';
     my $trystr='';
     my $button='';
     my $previousmsg='';
   
     my $status = $Apache::inputtags::status['-1'];
     &Apache::lonxml::debug("gradestatus has :$status:");
     if ( $status ne 'CLOSED' ) {  
       my $award = $Apache::lonhomework::history{"resource.$id.award"};
       my $solved = $Apache::lonhomework::history{"resource.$id.solved"};
       my $previous = $Apache::lonhomework::history{"resource.$id.previous"};
       &Apache::lonxml::debug("Found Award |$award|$solved|");
       if ( $award ne '' ) {
         &Apache::lonxml::debug('Getting message');
         ($showbutton,$message,$previousmsg) =
    &decideoutput($award,$solved,$previous);
         $message="<td bgcolor=\"#aaffaa\">$message</td>";
         if ($previousmsg) {
    $previousmsg="<td bgcolor=\"#ffaaaa\">$previousmsg</td>";
         }
       }
       my $tries = $Apache::lonhomework::history{"resource.$id.tries"};
       my $maxtries = &Apache::lonnet::EXT("resource.$id.maxtries");
       &Apache::lonxml::debug("got maxtries of :$maxtries:");
       if ( $tries eq '' ) { $tries = '0'; }
       if ( $maxtries eq '' ) { $maxtries = '2'; } 
       if ( $maxtries eq 'con_lost' ) { $maxtries = '0'; } 
       if ( $showbutton ) {
         $trystr = "<td>Tries $tries/$maxtries</td>";
       }
       if ( $status eq 'SHOW_ANSWER' || $status eq 'CANNOT_ANSWER') {$showbutton = 0;}
       if ( $showbutton ) { 
         $button = '<br /><input type="submit" name="submit" value="Submit Answer" />';
       }
       if ($Apache::lonhomework::history{"resource.$id.afterduedate"}) {
         #last submissions was after due date
         $latemessage="<td bgcolor=\"#ffaaaa\">The last submission was after the Due Date</td>";
       }
     }
     my $output= $previousmsg.$latemessage.$message.$trystr;
     if ($output =~ /^\s*$/) {
       return $button;
     } else {
       return $button.'<table><tr>'.$output.'</tr></table>';
     }
   }
 1;  1;
 __END__  __END__
     
Removed from v.1.4  
changed lines
  Added in v.1.58

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.