loncom/homework/essayresponse.pm - view

File: [LON-CAPA] / loncom / homework / essayresponse.pm
Revision 1.21: download - view: text, annotated - select for diffs
Fri Jan 24 18:45:23 2003 UTC (21 years, 3 months ago) by www
Branches: MAIN
CVS tags: HEAD

Enforce restrictions on uploaded filetypes

1: # The LearningOnline Network with CAPA 2: # essay (ungraded) style responses 3: # 4: # $Id: essayresponse.pm,v 1.21 2003/01/24 18:45:23 www Exp $ 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: # 28: # 4/3 Guy 29: # July, 2002, H. K. Ng 30: # 31: package Apache::essayresponse; 32: use strict; 33: use Apache::lonxml; 34: use Apache::lonnet; 35: 36: BEGIN { 37: &Apache::lonxml::register('Apache::essayresponse',('essayresponse')); 38: } 39: 40: sub start_essayresponse { 41: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 42: my $result; 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') { 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"}); 51: my $uploadedfiletypes= &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes"); 52: $uploadedfiletypes=~s/[^\w\,]//g; 53: my $uploadedfile= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.uploadedfile"}); 54: $result='<br /><table border="1">'; 55: if ($ncol > 0) { 56: $result .='<tr><td>'. 57: 'Collaborators: <input type="text" size="70" max="80" name="HWCOL'. 58: $part.'_'.$id.'" value="'.$coll.'" /><br />'. 59: '(Enter maximum '.$ncol.' collaborators using username or username@domain, e.g. '. 60: 'smithje or smithje@'.$ENV{'user.domain'}.'.)<br />'; 61: $result .= &check_collaborators($ncol,$coll) if ($coll =~ /\w+/); 62: $result .='</td></tr>'; 63: } 64: if ($uploadedfiletypes) { 65: $result.= 66: '<tr><td>Submit a file: <input type="file" size="50" name="HWFILE'. 67: $part.'_'.$id.'" onFocus="this.form.enctype='. 68: "'multipart/form-data'".';" /><br />Allowed filetypes: <b>'.$uploadedfiletypes.'</b><br />'; 69: if ($uploadedfile) { 70: $result.='Currently submitted: <tt><a href="'. 71: &Apache::lonnet::tokenwrapper($Apache::lonhomework::history{"resource.$part.$id.uploadedurl"}).'">'.$uploadedfile.'</a></tt>'; 72: } else { 73: $result.='(Hand in a file you have prepared on your computer)'; 74: } 75: $result.='</td></tr>'; 76: } 77: $result.='<tr><td>'. 78: '<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="yes" checked>'. 79: ' Submit text below as answer to receive credit <br />'. 80: '<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="no">'. 81: ' Save text below as a draft answer (not submitting it for credit yet) '. 82: '</td></tr></table>'; 83: } 84: return $result; 85: } 86: 87: sub end_essayresponse { 88: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 89: my $part = $Apache::inputtags::part; 90: my $id = $Apache::inputtags::response[-1]; 91: my $result; 92: if ( $target eq 'grade' ) { 93: my $collaborators = $ENV{'form.HWCOL'.$part.'_'.$id}; 94: if ($collaborators =~ /[^\s]/) { 95: my $previous_list= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"}); 96: $Apache::lonhomework::results{"resource.$part.$id.collaborators"}=$collaborators 97: if ($collaborators ne $previous_list); 98: } 99: my $filename= $ENV{'form.HWFILE'.$part.'_'.$id.'.filename'}; 100: if ($filename =~ /[^\s]/) { 101: my $uploadedfiletypes= &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes"); 102: $uploadedfiletypes=~s/[^\w\,]//g; 103: $uploadedfiletypes=','.$uploadedfiletypes.','; 104: my ($extension)=($filename=~/\.(\w+)$/); 105: if ($uploadedfiletypes=~/\,$extension\,/i) { 106: $Apache::lonhomework::results{"resource.$part.$id.uploadedfile"}=$filename; 107: $Apache::lonhomework::results{"resource.$part.$id.uploadedurl"}= 108: &Apache::lonnet::userfileupload('HWFILE'.$part.'_'.$id); 109: } 110: } 111: if ( defined $ENV{'form.submitted'}) { 112: my $response = $ENV{'form.HWVAL'.$id}; 113: if ( $response =~ /[^\s]/) { 114: my $award; 115: if ($ENV{'form.HWDRAFT'.$part.'_'.$id} eq 'yes') { 116: $award='SUBMITTED'; 117: } else { 118: $award='DRAFT'; 119: } 120: $Apache::lonhomework::results{"resource.$part.$id.submission"}=$response; 121: $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$award; 122: my %previous=&Apache::response::check_for_previous($response,$part,$id); 123: &Apache::response::handle_previous(\%previous,$award); 124: } 125: } 126: } elsif ($target eq 'edit') { 127: $result.=&Apache::edit::end_table(); 128: } elsif ($target eq 'tex') { 129: if ($Apache::lonhomework::type eq 'exam') { 130: $result.='\begin{enumerate}\item[\textbf{'.$Apache::lonxml::counter.'}.]\textit{Live blank on scoring form}\vskip 0 mm'; 131: &Apache::lonxml::increment_counter(); 132: $result.= '\item[\textbf{'.$Apache::lonxml::counter.'}.]\textit{Leave blank on scoring form}\vskip 0 mm \end{enumerate}'; 133: &Apache::lonxml::increment_counter(); 134: } 135: } 136: 137: &Apache::response::end_response; 138: return $result; 139: } 140: 141: sub check_collaborators { 142: my ($ncol,$coll) = @_; 143: my %classlist=&Apache::lonnet::dump('classlist', 144: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 145: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 146: my (@badcollaborators,$result); 147: my (@collaborators) = split(/\,?\s+/,$coll); 148: foreach (@collaborators) { 149: my $collaborator = $_; 150: if (/@/) { 151: $collaborator =~ s/@/:/; 152: } else { 153: $collaborator = $_.':'.$ENV{'user.domain'}; 154: } 155: push @badcollaborators, $_ if (!grep /^$collaborator/i,keys %classlist); 156: } 157: 158: if (scalar(@badcollaborators)) { 159: $result = '<table border="0"><tr bgcolor="#ffbbbb"><td> The following user'. 160: (scalar(@badcollaborators) > 1 ? 's are' : ' is').' invalid: '. 161: join(', ',@badcollaborators).'. Please correct.</td></tr></table>'; 162: } 163: my $toomany = scalar(@collaborators) - $ncol; 164: if ($toomany > 0) { 165: $result .= '<table border="0"><tr bgcolor="#ffbbbb"><td>'. 166: 'You have too many collaborators. Please remove '.$toomany.' collaborator'. 167: ($toomany > 1 ? 's' :'').'.</td></tr></table>'; 168: } 169: return $result; 170: } 171: 172: 1; 173: __END__