Annotation of loncom/homework/essayresponse.pm, revision 1.32

1.1       albertel    1: # The LearningOnline Network with CAPA
                      2: # essay (ungraded) style responses
1.5       albertel    3: #
1.32    ! www         4: # $Id: essayresponse.pm,v 1.31 2003/04/21 20:59:02 albertel Exp $
1.5       albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: # 4/3 Guy
1.10      ng         29: # July, 2002, H. K. Ng
                     30: #
1.1       albertel   31: package Apache::essayresponse;
                     32: use strict;
1.16      sakharuk   33: use Apache::lonxml;
1.20      www        34: use Apache::lonnet;
1.1       albertel   35: 
1.6       harris41   36: BEGIN {
1.10      ng         37:     &Apache::lonxml::register('Apache::essayresponse',('essayresponse'));
1.1       albertel   38: }
                     39: 
                     40: sub start_essayresponse {
1.10      ng         41:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                     42:     my $result;
1.14      albertel   43:     my $id = &Apache::response::start_response($parstack,$safeeval);
                     44:     if ($target eq 'meta') {
                     45: 	$result=&Apache::response::meta_package_write('essayresponse');
                     46:     } elsif ($target eq 'web') {
1.10      ng         47: 	my $part= $Apache::inputtags::part;
                     48: 
                     49: 	my $ncol= &Apache::lonnet::EXT("resource.$part".'_'."$id.maxcollaborators");
                     50: 	my $coll= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"});
1.17      www        51: 	my $uploadedfiletypes= &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes");
1.21      www        52:         $uploadedfiletypes=~s/[^\w\,]//g;
1.17      www        53: 	my $uploadedfile= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.uploadedfile"});
1.13      ng         54: 	$result='<br /><table border="1">';
1.22      www        55: 	$result.='<tr><td>'.
                     56: 	    '<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="yes" checked>'.
                     57: 	    ' Submit entries below as answer to receive credit <br />'.
                     58: 	    '<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="no">'.
                     59: 	    ' Save entries below as a draft answer (not submitting them for credit yet) '.
                     60: 	    '</td></tr>';
1.10      ng         61: 	if ($ncol > 0) {
1.13      ng         62: 	    $result .='<tr><td>'.
                     63: 		'Collaborators: <input type="text" size="70" max="80" name="HWCOL'.
                     64: 		$part.'_'.$id.'" value="'.$coll.'" /><br />'.
1.10      ng         65: 		'(Enter maximum '.$ncol.' collaborators using username or username@domain, e.g. '.
                     66: 		'smithje or smithje@'.$ENV{'user.domain'}.'.)<br />';
                     67: 	    $result .= &check_collaborators($ncol,$coll) if ($coll =~ /\w+/);
1.13      ng         68: 	    $result .='</td></tr>';
1.10      ng         69: 	}
1.17      www        70:         if ($uploadedfiletypes) {
                     71:            $result.=
                     72: '<tr><td>Submit a file: <input type="file" size="50" name="HWFILE'.
1.19      www        73: 		$part.'_'.$id.'" onFocus="this.form.enctype='.
                     74: "'multipart/form-data'".';" /><br />Allowed filetypes: <b>'.$uploadedfiletypes.'</b><br />';
                     75:            if ($uploadedfile) {
1.20      www        76: 	       $result.='Currently submitted: <tt><a href="'.
1.23      www        77:                 &Apache::lonnet::tokenwrapper($Apache::lonhomework::history{"resource.$part.$id.uploadedurl"}).'"><img src="/adm/lonIcons/unknown.gif" border=0"> '.$uploadedfile.'</a></tt>';
1.19      www        78:            } else {
                     79:               $result.='(Hand in a file you have prepared on your computer)';
                     80:            }
                     81:            $result.='</td></tr>'; 
1.17      www        82:         }
1.22      www        83:         $result.='</table>';
1.10      ng         84:     }
                     85:     return $result;
1.1       albertel   86: }
                     87: 
                     88: sub end_essayresponse {
1.10      ng         89:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.13      ng         90:     my $part          = $Apache::inputtags::part;
1.14      albertel   91:     my $id            = $Apache::inputtags::response[-1];
1.27      albertel   92:     my $increment     = 1;
1.15      albertel   93:     my $result;
1.10      ng         94:     if ( $target eq 'grade' ) {
1.14      albertel   95: 	my $collaborators = $ENV{'form.HWCOL'.$part.'_'.$id};	
                     96: 	if ($collaborators =~ /[^\s]/) {
                     97: 	    my $previous_list= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"});
                     98: 	    $Apache::lonhomework::results{"resource.$part.$id.collaborators"}=$collaborators
                     99: 		if ($collaborators ne $previous_list);
                    100: 	}
1.27      albertel  101: 	if ( defined($ENV{'form.submitted'}) &&
1.28      albertel  102: 	     $ENV{'form.submitted'} eq 'scantron' ) {
1.31      albertel  103: 	    $increment=&Apache::response::scored_response($part,$id);
1.27      albertel  104: 	} elsif ( defined($ENV{'form.submitted'}) ) {
1.26      albertel  105: 	    my $response      = $ENV{'form.HWVAL_'.$id};
1.22      www       106:             my $filename= $ENV{'form.HWFILE'.$part.'_'.$id.'.filename'};
                    107: 	    if (( $response =~ /[^\s]/) || ($filename =~ /[^\s]/)) {
                    108:  		my $award;
1.14      albertel  109: 		if ($ENV{'form.HWDRAFT'.$part.'_'.$id} eq 'yes') {
                    110: 		    $award='SUBMITTED';
                    111: 		} else {
                    112: 		    $award='DRAFT';
                    113: 		}
1.22      www       114:                 my $uploadedflag=0;
                    115:                 if ($filename =~ /[^\s]/) {
                    116:  	           my $uploadedfiletypes= &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes");
                    117:                    $uploadedfiletypes=~s/[^\w\,]//g;
                    118:                    $uploadedfiletypes=','.$uploadedfiletypes.',';
                    119:                    my ($extension)=($filename=~/\.(\w+)$/);
                    120: 	           if ($uploadedfiletypes=~/\,$extension\,/i) {
                    121: 	              $Apache::lonhomework::results{"resource.$part.$id.uploadedfile"}=$filename;
                    122:                       $Apache::lonhomework::results{"resource.$part.$id.uploadedurl"}=
                    123:                          &Apache::lonnet::userfileupload('HWFILE'.$part.'_'.$id);
                    124:                       $uploadedflag=1;
                    125: 		   } else {
                    126: 		      $award='INVALID_FILETYPE';
                    127:                    }
                    128: 	        }
1.10      ng        129: 		$Apache::lonhomework::results{"resource.$part.$id.submission"}=$response;
1.14      albertel  130: 		$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$award;
1.10      ng        131: 		my %previous=&Apache::response::check_for_previous($response,$part,$id);
1.22      www       132: 		unless ($uploadedflag) { &Apache::response::handle_previous(\%previous,$award); }
1.32    ! www       133: #
        !           134: # Store with resource author for similarity testing
        !           135: #
        !           136:                 if ($award eq 'SUBMITTED') {
        !           137: 		    my ($symb,$crsid,$domain,$name)=
        !           138: 			&Apache::lonxml::whichuser();
        !           139: 		    if ($crsid) {
        !           140: 			my $akey=$name.'.'.$domain.'.'.$crsid;
        !           141: 			my $essayurl=
        !           142: 			    &Apache::lonnet::declutter($ENV{'REQUEST_URI'});
        !           143: 			my ($adom,$aname,$apath)=
        !           144: 			    ($essayurl=~/^(\w+)\/(\w+)\/(.*)$/);
        !           145:                         $apath=&Apache::lonnet::escape($apath);
        !           146: 			$apath=~s/\W/\_/gs;
        !           147: 			&Apache::lonnet::put('nohist_essay_'.$apath,
        !           148: 					 { $akey => $response },$adom,$aname);
        !           149: 		    }
        !           150:                }
1.10      ng        151: 	    }
                    152: 	}
1.15      albertel  153:     } elsif ($target eq 'edit') {
                    154: 	$result.=&Apache::edit::end_table();
1.16      sakharuk  155:     } elsif ($target eq 'tex') {
                    156: 	if ($Apache::lonhomework::type eq 'exam') {
1.27      albertel  157: 	    my $repetition=&Apache::response::repetition();
1.25      sakharuk  158: 	    $result.='\begin{enumerate}';
                    159: 	    for (my $i=0;$i<$repetition;$i++) {
1.27      albertel  160: 		$result.='\item[\textbf{'.($Apache::lonxml::counter+$i).
                    161: 		    '}.]\textit{Leave blank on scoring form}\vskip 0 mm';
1.25      sakharuk  162: 	    }
                    163: 	    $result.= '\end{enumerate}';
1.16      sakharuk  164: 	}
1.10      ng        165:     }
1.27      albertel  166:     if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' ||
                    167: 	$target eq 'tex' || $target eq 'analyze') {
                    168: 	&Apache::lonxml::increment_counter($increment);
                    169:     }
1.10      ng        170:     &Apache::response::end_response;
1.15      albertel  171:     return $result;
1.10      ng        172: }
                    173: 
                    174: sub check_collaborators {
1.11      ng        175:     my ($ncol,$coll) = @_;
1.10      ng        176:     my %classlist=&Apache::lonnet::dump('classlist',
                    177: 					$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
                    178: 					$ENV{'course.'.$ENV{'request.course.id'}.'.num'});
                    179:     my (@badcollaborators,$result);
                    180:     my (@collaborators) = split(/\,?\s+/,$coll);
                    181:     foreach (@collaborators) {
                    182: 	my $collaborator = $_;
                    183: 	if (/@/) {
                    184: 	    $collaborator =~ s/@/:/;
                    185: 	} else {
                    186: 	    $collaborator = $_.':'.$ENV{'user.domain'};
                    187: 	}
                    188: 	push @badcollaborators, $_ if (!grep /^$collaborator/i,keys %classlist);
                    189:     }
                    190:     
                    191:     if (scalar(@badcollaborators)) {
1.11      ng        192: 	$result = '<table border="0"><tr bgcolor="#ffbbbb"><td> The following user'.
                    193: 	    (scalar(@badcollaborators) > 1 ? 's are' : ' is').' invalid: '.
                    194: 	    join(', ',@badcollaborators).'. Please correct.</td></tr></table>';
1.10      ng        195:     }
                    196:     my $toomany = scalar(@collaborators) - $ncol;
                    197:     if ($toomany > 0) {
                    198: 	$result .= '<table border="0"><tr bgcolor="#ffbbbb"><td>'.
                    199: 	    'You have too many collaborators. Please remove '.$toomany.' collaborator'.
                    200: 	    ($toomany > 1 ? 's' :'').'.</td></tr></table>';
                    201:     }
                    202:     return $result;
1.1       albertel  203: }
1.2       albertel  204: 
                    205: 1;
                    206: __END__

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.