loncom/homework/essayresponse.pm - view

File: [LON-CAPA] / loncom / homework / essayresponse.pm
Revision 1.102: download - view: text, annotated - select for diffs
Sun Feb 28 23:37:03 2010 UTC (14 years, 2 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- New awards for surveys:
 ANONYMOUS ANONYMOUS_CREDIT SUBMITTED_CREDIT
  - given for question types: anonsurvey, anonsurvey_cred, survey_cred.
    - anonsurvey -- course personnel can not view both identity of submitter
                    and submission details.
    - anonsurveycred -- same anonymity, but submitter receives 'awarded' for
                        submission
    - surveycred - submitter receives 'awarded' for submission to survey.

1: # The LearningOnline Network with CAPA 2: # essay (ungraded) style responses 3: # 4: # $Id: essayresponse.pm,v 1.102 2010/02/28 23:37:03 raeburn 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: 29: package Apache::essayresponse; 30: use strict; 31: use Apache::lonxml(); 32: use Apache::lonnet; 33: use Apache::lonlocal; 34: use LONCAPA qw(:DEFAULT :match); 35: 36: 37: BEGIN { 38: &Apache::lonxml::register('Apache::essayresponse',('essayresponse')); 39: } 40: 41: sub start_essayresponse { 42: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 43: my $result; 44: my $id = &Apache::response::start_response($parstack,$safeeval); 45: if ($target eq 'meta') { 46: $result=&Apache::response::meta_package_write('essayresponse'); 47: } elsif ($target eq 'web' && 48: $Apache::inputtags::status[-1] eq 'CAN_ANSWER') { 49: my $part= $Apache::inputtags::part; 50: my $ncol= &Apache::lonnet::EXT("resource.$part".'_'."$id.maxcollaborators"); 51: my $coll= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"'); 52: my $uploadedfiletypes= &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes"); 53: $uploadedfiletypes=~s/[^\w\,]//g; 54: my $maxfilesize=&Apache::lonnet::EXT("resource.$part".'_'."$id.maxfilesize"); 55: if (!defined($maxfilesize)) { 56: $maxfilesize = 10.0; #FIXME This should become a domain configuration 57: } 58: if (($Apache::lonhomework::type eq 'survey') || 59: ($Apache::lonhomework::type eq 'surveycred') || 60: ($Apache::lonhomework::type eq 'anonsurvey') || 61: ($Apache::lonhomework::type eq 'anonsurveycred')) { 62: $result.= '<input type="hidden" name="HWDRAFT'.$part.'_'.$id.'" value="yes" /> '; 63: } 64: $result.='<br /><table border="1">'; 65: if (($Apache::lonhomework::type ne 'survey') && 66: ($Apache::lonhomework::type ne 'surveycred') && 67: ($Apache::lonhomework::type eq 'anonsurvey') && 68: ($Apache::lonhomework::type ne 'anonsurveycred')) { 69: $result.= '<tr><td>'. 70: '<label>'. 71: '<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="yes" checked="checked" /> '. 72: &mt('Submit entries below as answer to receive credit'). 73: '</label> <br />'. 74: '<label>'. 75: '<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="no" /> '. 76: &mt('Save entries below (not submitted for credit yet)'). 77: '</label>'. 78: '</td></tr>'; 79: } 80: 81: if ($ncol > 0) { 82: $result .='<tr><td>'.'<label>'. 83: &mt('Collaborators:').' <input type="text" size="70" max="80" name="HWCOL'. 84: $part.'_'.$id.'" value="'.$coll.'" /><br />'. 85: &mt('(Enter a maximum of [quant,_1,collaborator] using username or username:domain, e.g. smithje or smithje:[_2].)',$ncol,$env{'user.domain'}); 86: if ($ncol > 1) { 87: $result .= '<br />'.&mt('If entering more than one, use spaces to separate the collaborators.'); 88: } 89: $result .= '</label><br />'; 90: $result .= &check_collaborators($ncol,$coll) if ($coll =~ /\w+/); 91: $result .='</td></tr>'; 92: } 93: my $filesfrom = 'both'; 94: my $stuname = &Apache::lonnet::EXT('user.name'); 95: my $studom = &Apache::lonnet::EXT('user.domain'); 96: if (!&Apache::lonnet::usertools_access($stuname,$studom,'portfolio')) { 97: $filesfrom = 'uploadonly'; 98: } 99: $result.=&Apache::inputtags::file_selector($part,$id,$uploadedfiletypes, 100: $filesfrom,undef,$maxfilesize); 101: $result.='</table>'; 102: } elsif ($target eq 'web' && 103: $Apache::inputtags::status[-1] ne 'CAN_ANSWER') { 104: my $part= $Apache::inputtags::part; 105: my @msgs; 106: if ($Apache::lonhomework::history{"resource.$part.$id.collaborators"} =~ /\S/) { 107: my $coll= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"'); 108: $result .= '<td>'.&mt('Collaborated with [_1]',$coll).'</td>'; 109: } 110: 111: my $file_submission = 112: &Apache::inputtags::show_past_file_submission($part,$id); 113: if ($file_submission) { 114: $result .= '<td>'.$file_submission.'</td>'; 115: } 116: 117: my $port_submission = 118: &Apache::inputtags::show_past_portfile_submission($part,$id); 119: if ($port_submission) { 120: $result .= '<td>'.$port_submission.'</td>'; 121: } 122: 123: if ($result ne '') { 124: $result = 125: '<table class="LC_pastsubmission"><tr>'.$result. 126: '</tr></table>'; 127: } 128: } 129: return $result; 130: } 131: 132: sub end_essayresponse { 133: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 134: my $part = $Apache::inputtags::part; 135: my $id = $Apache::inputtags::response[-1]; 136: my $increment = &Apache::response::repetition(); 137: my $result; 138: if ( $target eq 'grade' ) { 139: my $collaborators = $env{'form.HWCOL'.$part.'_'.$id}; 140: if ($collaborators =~ /[^\s]/) { 141: my $previous_list= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"'); 142: $Apache::lonhomework::results{"resource.$part.$id.collaborators"}=$collaborators 143: if ($collaborators ne $previous_list); 144: } 145: if ( &Apache::response::submitted('scantron') ) { 146: $increment=&Apache::response::scored_response($part,$id); 147: } elsif ( &Apache::response::submitted() ) { 148: my $response = $env{'form.HWVAL_'.$id}; 149: my $filename = $env{'form.HWFILE'.$part.'_'.$id.'.filename'} || 150: $env{'form.HWFILETOOBIG'.$part.'_'.$id}; 151: my $portfiles = $env{'form.HWPORT'.$part.'_'.$id}; 152: if (( $response =~ /[^\s]/) || ($filename =~ /[^\s]/) || ($portfiles =~ /[^\s]/)) { 153: my $award='DRAFT'; 154: if ($env{'form.HWDRAFT'.$part.'_'.$id} eq 'yes') { 155: if ($Apache::lonhomework::type eq 'anonsurvey') { 156: $award='ANONYMOUS'; 157: } elsif ($Apache::lonhomework::type eq 'anonsurveycred') { 158: $award='ANONYMOUS_CREDIT'; 159: } elsif ($Apache::lonhomework::type eq 'surveycred') { 160: $award='SUBMITTED_CREDIT'; 161: } else { 162: $award='SUBMITTED'; 163: } 164: } 165: my $uploadedflag=0; 166: my $totalsize=0; 167: &file_submission($part,$id,'filename',\$award,\$uploadedflag,\$totalsize); 168: &file_submission($part,$id,'portfiles',\$award,\$uploadedflag,\$totalsize); 169: $Apache::lonhomework::results{"resource.$part.$id.submission"}=$response; 170: $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$award; 171: my %previous=&Apache::response::check_for_previous($response,$part,$id); 172: unless ($uploadedflag) { &Apache::response::handle_previous(\%previous,$award); } 173: # 174: # Store with resource author for similarity testing 175: # 176: if ($award eq 'SUBMITTED') { 177: my ($symb,$crsid,$domain,$name)= 178: &Apache::lonnet::whichuser(); 179: if ($crsid) { 180: my $akey=join('.',&escape($name),&escape($domain), 181: &escape($crsid)); 182: my $essayurl= 183: &Apache::lonnet::declutter($ENV{'REQUEST_URI'}); 184: my ($adom,$aname,$apath)= 185: ($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); 186: $apath=&escape($apath); 187: $apath=~s/\W/\_/gs; 188: &Apache::lonnet::put('nohist_essay_'.$apath, 189: { $akey => $response },$adom,$aname); 190: } 191: } 192: } 193: } 194: } elsif ($target eq 'edit') { 195: $result.=&Apache::edit::end_table(); 196: 197: } elsif ($target eq 'tex' 198: && $Apache::lonhomework::type eq 'exam') { 199: $result .= &Apache::inputtags::exam_score_line($target); 200: 201: } elsif ($target eq 'answer') { 202: $result.=&Apache::response::answer_header($$tagstack[-1]); 203: my $answer = &mt('Essay will be hand graded.'); 204: $result.=&Apache::response::answer_part($$tagstack[-1],$answer, 205: {'no_verbatim' => 1}); 206: $result.=&Apache::response::answer_footer($$tagstack[-1]); 207: } 208: if ($target eq 'web') { 209: &Apache::response::setup_prior_tries_hash(\&format_prior_response, 210: ['portfiles', 211: 'uploadedurl']); 212: } 213: 214: if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' || 215: $target eq 'tex' || $target eq 'analyze') { 216: &Apache::lonxml::increment_counter($increment, "$part.$id"); 217: 218: if ($target eq 'analyze') { 219: $Apache::lonhomework::analyze{"$part.$id.type"} = 'essayresponse'; 220: push (@{ $Apache::lonhomework::analyze{"parts"} },"$part.$id"); 221: &Apache::lonhomework::set_bubble_lines(); 222: } 223: } 224: &Apache::response::end_response; 225: 226: return $result; 227: } 228: 229: sub format_prior_response { 230: my ($mode,$answer,$other_data) = @_; 231: my $output; 232: 233: my (undef,undef,$udom,$uname) = &Apache::lonnet::whichuser(); 234: my $port_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio/'; 235: 236: my $file_list; 237: 238: foreach my $file (split(/\s*,\s*/, 239: $other_data->[0].','.$other_data->[1])) { 240: next if ($file!~/\S/); 241: if ($file !~ m{^/uploaded/}) { $file=$port_url.$file; } 242: $file=~s|/+|/|g; 243: &Apache::lonnet::allowuploaded('/adm/essayresponse',$file); 244: $file_list.='<li><span class="LC_nobreak"><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'. 245: &Apache::loncommon::icon($file).'" alt="file icon" border="0" /> '.$file. 246: '</a></span></li>'."\n"; 247: } 248: if ($file_list) { 249: $output.= &mt('Submitted Files').'<ul>'.$file_list.'</ul>'; 250: } 251: if ($answer =~ /\S/) { 252: $output.='<p>'.&mt('Submitted text'). 253: '<blockquote>'.$answer.'</blockquote></p>'; 254: } 255: 256: return '<div class="LC_prior_essay">'.$output.'</div>'; 257: } 258: 259: sub file_submission { 260: my ($part,$id,$which,$award,$uploadedflag,$totalsize)=@_; 261: my $files; 262: my $jspart=$part; 263: $jspart=~s/\./_/g; 264: if ($which eq 'portfiles') { 265: $files= $env{'form.HWPORT'.$jspart.'_'.$id}; 266: } elsif ($which eq 'filename') { 267: if ($env{'form.HWFILETOOBIG'.$jspart.'_'.$id} ne '') { 268: $$award = 'EXCESS_FILESIZE'; 269: return; 270: } else { 271: $files = $env{'form.HWFILE'.$jspart.'_'.$id.'.filename'}; 272: } 273: } 274: if ($files =~ /[^\s]/) { 275: $files =~s/,$//; 276: my (@submitted_files,@acceptable_files,@accepted_files); 277: if ($which eq 'portfiles') { 278: @submitted_files = split(/\s*,\s*/,$files); 279: } else { 280: @submitted_files = ($files); 281: } 282: my $uploadedfiletypes= 283: &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes"); 284: if ($uploadedfiletypes ne '') { 285: $uploadedfiletypes=~s/[^\w\,]//g; 286: $uploadedfiletypes=','.$uploadedfiletypes.','; 287: foreach my $file (@submitted_files) { 288: my ($extension)=($file=~/\.(\w+)$/); 289: if ($uploadedfiletypes=~/\,\s*\Q$extension\E\s*\,/i) { 290: push(@acceptable_files,$file); 291: } else { 292: $$award='INVALID_FILETYPE'; 293: if ($which eq 'filename') { 294: &delete_form_items($jspart,$id); 295: } 296: } 297: } 298: } else { 299: @acceptable_files = @submitted_files; 300: } 301: my $maxfilesize=&Apache::lonnet::EXT("resource.$part".'_'."$id.maxfilesize"); 302: if (!$maxfilesize) { 303: $maxfilesize = 10.0; #FIXME This should become a domain configuration 304: } 305: my %dirlist; 306: foreach my $file (@acceptable_files) { 307: if ($which eq 'filename') { 308: if (ref($totalsize)) { 309: $$totalsize += $env{'form.HWFILESIZE'.$jspart.'_'.$id}; 310: } 311: } else { 312: my ($symb,$crsid,$udom,$uname) = &Apache::lonnet::whichuser(); 313: my ($path,$filename) = ($file =~ m{^(.*/)([^/]+)$}); 314: my $fullpath = '/userfiles/portfolio'.$path; 315: if (!exists($dirlist{$fullpath})) { 316: my @list = &Apache::lonnet::dirlist($fullpath,$udom,$uname,1); 317: $dirlist{$fullpath} = \@list; 318: } 319: if (ref($dirlist{$fullpath}) eq 'ARRAY') { 320: foreach my $dir_line (@{$dirlist{$fullpath}}) { 321: my ($fname,$dom,undef,$testdir,undef,undef,undef,undef, 322: $size,undef,$mtime,undef,undef,undef,$obs,undef) = 323: split(/\&/,$dir_line,16); 324: if ($filename eq $fname) { 325: my $mbsize = $size/(1024.0*1024.0); 326: if (ref($totalsize)) { 327: $$totalsize += $mbsize; 328: } 329: last; 330: } 331: } 332: } 333: } 334: if (ref($totalsize)) { 335: if ($$totalsize > $maxfilesize) { 336: $$award='EXCESS_FILESIZE'; 337: if ($which eq 'filename') { 338: &delete_form_items($jspart,$id); 339: } 340: last; 341: } else { 342: push(@accepted_files,$file); 343: } 344: } else { 345: push(@accepted_files,$file); 346: } 347: } 348: $Apache::lonhomework::results{"resource.$part.$id.$which"}=join(',',@accepted_files); 349: if (($$award eq 'INVALID_FILETYPE') || ($award eq 'EXCESS_FILESIZE')) { 350: return; 351: } 352: if (ref($uploadedflag)) { 353: $$uploadedflag=1; 354: } 355: my ($symb,$crsid,$domain,$name)=&Apache::lonnet::whichuser(); 356: if ($which eq 'portfiles') { 357: &Apache::lonnet::unmark_as_readonly($domain,$name,[$symb,$crsid]); 358: &Apache::lonnet::mark_as_readonly($domain,$name,\@submitted_files,[$symb,$crsid]); 359: &Apache::lonnet::clear_selected_files($name); 360: } 361: if ($which eq 'filename') { 362: $Apache::lonhomework::results{"resource.$part.$id.uploadedfile"}= 363: $files; 364: my $cleanpart = $part; 365: $cleanpart =~ s/\W/_/g; 366: my $cleanid = $id; 367: $cleanid =~ s/\W/_/g; 368: my ($map,$resid,$res)=&Apache::lonnet::decode_symb($symb); 369: my $container; 370: if ($map =~ /^uploaded/) { 371: (my $prefix,$container) = ($map =~ m{^uploaded/[^/]+/[^/]+/(default|supplemental)_?([^.]*)\.(?:sequence|page)$}); 372: if (length($container) > 10) { 373: $container = substr($container,-10,10); 374: } 375: if ($container ne '') { 376: $container = $prefix.'_'.$container; 377: } else { 378: $container = $prefix; 379: } 380: } else { 381: ($container) = ($map =~ m{(.+)\.(?:sequence|page)$}); 382: $container =~ s/\W/_/g; 383: if (length($container) > 255) { 384: $container = substr($container,0,254); 385: } 386: } 387: my $subdir = 'essayresponse'; 388: my %crsdesc = &Apache::lonnet::coursedescription($crsid); 389: foreach my $item ($crsdesc{'domain'},$crsdesc{'num'},$container,$resid,$cleanpart,$cleanid) { 390: if ($item ne '') { 391: $subdir .= '/'.$item; 392: } 393: } 394: $Apache::lonhomework::results{"resource.$part.$id.uploadedurl"}= 395: &Apache::lonnet::userfileupload('HWFILE'.$jspart.'_'.$id,undef, 396: $subdir); 397: delete($env{'form.HWFILE'.$jspart.'_'.$id}); 398: } 399: } elsif ($which eq 'portfiles' && 400: $Apache::lonhomework::history{"resource.$part.$id.$which"}) { 401: my ($symb,$crsid,$domain,$name)=&Apache::lonnet::whichuser(); 402: &Apache::lonnet::unmark_as_readonly($domain,$name,[$symb,$crsid]); 403: $Apache::lonhomework::results{"resource.$part.$id.$which"}=""; 404: } 405: } 406: 407: sub delete_form_items { 408: my ($jspart,$id) = @_; 409: delete($env{'form.HWFILE'.$jspart.'_'.$id.'.filename'}); 410: delete($env{'form.HWFILE'.$jspart.'_'.$id.'.mimetype'}); 411: delete($env{'form.HWFILE'.$jspart.'_'.$id}); 412: } 413: 414: 415: sub check_collaborators { 416: my ($ncol,$coll) = @_; 417: my %classlist=&Apache::lonnet::dump('classlist', 418: $env{'course.'.$env{'request.course.id'}.'.domain'}, 419: $env{'course.'.$env{'request.course.id'}.'.num'}); 420: my (@badcollaborators,$result); 421: 422: my (@collaborators) = split(/,?\s+/,$coll); 423: foreach my $entry (@collaborators) { 424: my $collaborator; 425: if ($entry =~ /:/) { 426: $collaborator = $entry; 427: } else { 428: $collaborator = $entry.':'.$env{'user.domain'}; 429: } 430: if ($collaborator !~ /^$match_username:$match_domain$/) { 431: if (!grep(/^\Q$entry\E$/,@badcollaborators)) { 432: push(@badcollaborators,$entry); 433: } 434: } elsif (!grep(/^\Q$collaborator\E$/i,keys(%classlist))) { 435: if (!grep(/^\Q$entry\E$/,@badcollaborators)) { 436: push(@badcollaborators,$entry); 437: } 438: } 439: } 440: 441: my $numbad = scalar(@badcollaborators); 442: if ($numbad) { 443: $result = '<table border="0"><tr bgcolor="#ffbbbb"><td>'; 444: if ($numbad == 1) { 445: $result .= &mt('The following user is invalid:'); 446: } else { 447: $result .= &mt('The following [_1] users are invalid:',$numbad); 448: } 449: $result .= ' '.join(', ',@badcollaborators).'. '.&mt('Please correct.'). 450: '</td></tr></table>'; 451: } 452: my $toomany = scalar(@collaborators) - $ncol; 453: if ($toomany > 0) { 454: $result .= '<table border="0"><tr bgcolor="#ffbbbb"><td>'. 455: &mt('You have too many collaborators.').' '. 456: &mt('Please remove [quant,_1,collaborator].',$toomany). 457: '</td></tr></table>'; 458: } 459: return $result; 460: } 461: 462: 1; 463: __END__ 464: 465: 466: =pod 467: 468: =head1 NAME 469: 470: Apache::easyresponse 471: 472: =head1 SYNOPSIS 473: 474: Handler to evaluate essay (ungraded) style responses. 475: 476: This is part of the LearningOnline Network with CAPA project 477: described at http://www.lon-capa.org. 478: 479: =head1 SUBROUTINES 480: 481: =over 482: 483: =item start_essayresponse() 484: 485: =item end_essayresponse() 486: 487: =item format_prior_response() 488: 489: =item file_submission() 490: 491: =item delete_form_items() 492: 493: =item check_collaborators() 494: 495: =back 496: 497: =cut