loncom/homework/essayresponse.pm - view

File: [LON-CAPA] / loncom / homework / essayresponse.pm
Revision 1.107: download - view: text, annotated - select for diffs
Thu Jun 17 00:13:20 2010 UTC (13 years, 10 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- bug 5933.
  Files submitted to essayresponse items directly from user's desktop
  instead of selecting from portfolio now stored in user's portfolio.
  Instructors can now return files to student for this type of upload.

  Work in progress.

1: # The LearningOnline Network with CAPA 2: # essay (ungraded) style responses 3: # 4: # $Id: essayresponse.pm,v 1.107 2010/06/17 00:13:20 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 ne '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><i>'.&mt('Collaborated with [_1]',$coll).'</i></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: # Deal with collaborators 140: my $collaborators = $env{'form.HWCOL'.$part.'_'.$id}; 141: my $previous_list= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"'); 142: if ($collaborators ne $previous_list) { 143: # &Apache::lonnet::logthis("New collaborators [$collaborators] [$previous_list]"); 144: $Apache::lonhomework::results{"resource.$part.$id.collaborators"}=$collaborators; 145: } 146: # Scantron 147: if ( &Apache::response::submitted('scantron') ) { 148: $increment=&Apache::response::scored_response($part,$id); 149: } elsif ( &Apache::response::submitted() ) { 150: my $response = $env{'form.HWVAL_'.$id}; 151: my $filename = $env{'form.HWFILE'.$part.'_'.$id.'.filename'} || 152: $env{'form.HWFILETOOBIG'.$part.'_'.$id}; 153: my $portfiles = $env{'form.HWPORT'.$part.'_'.$id}; 154: if (( $response =~ /[^\s]/) || ($filename =~ /[^\s]/) || ($portfiles =~ /[^\s]/)) { 155: my $award='DRAFT'; 156: if ($env{'form.HWDRAFT'.$part.'_'.$id} eq 'yes') { 157: if ($Apache::lonhomework::type eq 'anonsurvey') { 158: $award='ANONYMOUS'; 159: } elsif ($Apache::lonhomework::type eq 'anonsurveycred') { 160: $award='ANONYMOUS_CREDIT'; 161: } elsif ($Apache::lonhomework::type eq 'surveycred') { 162: $award='SUBMITTED_CREDIT'; 163: } else { 164: $award='SUBMITTED'; 165: } 166: } 167: my $uploadedflag=0; 168: my $totalsize=0; 169: &file_submission($part,$id,'filename',\$award,\$uploadedflag,\$totalsize); 170: &file_submission($part,$id,'portfiles',\$award,\$uploadedflag,\$totalsize); 171: $Apache::lonhomework::results{"resource.$part.$id.submission"}=$response; 172: $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$award; 173: my %previous=&Apache::response::check_for_previous($response,$part,$id); 174: if ($uploadedflag) { 175: if ($award eq 'FILENAME_INUSE') { 176: delete($Apache::lonhomework::results{"resource.$id.tries"}); 177: } 178: } else { 179: &Apache::response::handle_previous(\%previous,$award); 180: } 181: # 182: # Store with resource author for similarity testing 183: # 184: if ($award eq 'SUBMITTED') { 185: my ($symb,$crsid,$domain,$name)= 186: &Apache::lonnet::whichuser(); 187: if ($crsid) { 188: my $akey=join('.',&escape($name),&escape($domain), 189: &escape($crsid)); 190: my $essayurl= 191: &Apache::lonnet::declutter($ENV{'REQUEST_URI'}); 192: my ($adom,$aname,$apath)= 193: ($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); 194: $apath=&escape($apath); 195: $apath=~s/\W/\_/gs; 196: &Apache::lonnet::put('nohist_essay_'.$apath, 197: { $akey => $response },$adom,$aname); 198: } 199: } 200: } 201: } 202: } elsif ($target eq 'edit') { 203: $result.=&Apache::edit::end_table(); 204: 205: } elsif ($target eq 'tex' 206: && $Apache::lonhomework::type eq 'exam') { 207: $result .= &Apache::inputtags::exam_score_line($target); 208: 209: } elsif ($target eq 'answer') { 210: $result.=&Apache::response::answer_header($$tagstack[-1]); 211: my $answer = &mt('Essay will be hand graded.'); 212: $result.=&Apache::response::answer_part($$tagstack[-1],$answer, 213: {'no_verbatim' => 1}); 214: $result.=&Apache::response::answer_footer($$tagstack[-1]); 215: } 216: if ($target eq 'web') { 217: &Apache::response::setup_prior_tries_hash(\&format_prior_response, 218: ['portfiles', 219: 'uploadedurl']); 220: } 221: 222: if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' || 223: $target eq 'tex' || $target eq 'analyze') { 224: &Apache::lonxml::increment_counter($increment, "$part.$id"); 225: 226: if ($target eq 'analyze') { 227: $Apache::lonhomework::analyze{"$part.$id.type"} = 'essayresponse'; 228: push (@{ $Apache::lonhomework::analyze{"parts"} },"$part.$id"); 229: &Apache::lonhomework::set_bubble_lines(); 230: } 231: } 232: &Apache::response::end_response; 233: 234: return $result; 235: } 236: 237: sub format_prior_response { 238: my ($mode,$answer,$other_data) = @_; 239: my $output; 240: 241: my (undef,undef,$udom,$uname) = &Apache::lonnet::whichuser(); 242: my $port_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio/'; 243: 244: my $file_list; 245: 246: foreach my $file (split(/\s*,\s*/, 247: $other_data->[0].','.$other_data->[1])) { 248: next if ($file!~/\S/); 249: if ($file !~ m{^/uploaded/}) { $file=$port_url.$file; } 250: $file=~s|/+|/|g; 251: &Apache::lonnet::allowuploaded('/adm/essayresponse',$file); 252: $file_list.='<li><span class="LC_nobreak"><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'. 253: &Apache::loncommon::icon($file).'" alt="file icon" border="0" /> '.$file. 254: '</a></span></li>'."\n"; 255: } 256: if ($file_list) { 257: $output.= &mt('Submitted Files').'<ul>'.$file_list.'</ul>'; 258: } 259: if ($answer =~ /\S/) { 260: $output.='<p>'.&mt('Submitted text'). 261: '<blockquote>'.$answer.'</blockquote></p>'; 262: } 263: 264: return '<div class="LC_prior_essay">'.$output.'</div>'; 265: } 266: 267: sub file_submission { 268: my ($part,$id,$which,$award,$uploadedflag,$totalsize)=@_; 269: my $files; 270: my $jspart=$part; 271: $jspart=~s/\./_/g; 272: if ($which eq 'portfiles') { 273: $files= $env{'form.HWPORT'.$jspart.'_'.$id}; 274: } elsif ($which eq 'filename') { 275: if ($env{'form.HWFILETOOBIG'.$jspart.'_'.$id} ne '') { 276: $$award = 'EXCESS_FILESIZE'; 277: return; 278: } else { 279: $files = $env{'form.HWFILE'.$jspart.'_'.$id.'.filename'}; 280: } 281: } 282: my ($symb,$crsid,$udom,$uname)=&Apache::lonnet::whichuser(); 283: if ($files =~ /[^\s]/) { 284: $files =~s/,$//; 285: my (@submitted_files,@acceptable_files,@accepted_files); 286: if ($which eq 'portfiles') { 287: @submitted_files = split(/\s*,\s*/,$files); 288: } else { 289: @submitted_files = ($files); 290: } 291: my $uploadedfiletypes= 292: &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes"); 293: if ($uploadedfiletypes ne '') { 294: $uploadedfiletypes=~s/[^\w\,]//g; 295: $uploadedfiletypes=','.$uploadedfiletypes.','; 296: foreach my $file (@submitted_files) { 297: my ($extension)=($file=~/\.(\w+)$/); 298: if ($uploadedfiletypes=~/\,\s*\Q$extension\E\s*\,/i) { 299: push(@acceptable_files,$file); 300: } else { 301: $$award='INVALID_FILETYPE'; 302: if ($which eq 'filename') { 303: &delete_form_items($jspart,$id); 304: } 305: } 306: } 307: } else { 308: @acceptable_files = @submitted_files; 309: } 310: my $maxfilesize=&Apache::lonnet::EXT("resource.$part".'_'."$id.maxfilesize"); 311: if (!$maxfilesize) { 312: $maxfilesize = 10.0; #FIXME This should become a domain configuration 313: } 314: my %dirlist; 315: foreach my $file (@acceptable_files) { 316: if ($which eq 'filename') { 317: if (ref($totalsize)) { 318: $$totalsize += $env{'form.HWFILESIZE'.$jspart.'_'.$id}; 319: } 320: } else { 321: my ($path,$filename) = ($file =~ m{^(.*/)([^/]+)$}); 322: my $fullpath = '/userfiles/portfolio'.$path; 323: if (!exists($dirlist{$fullpath})) { 324: my @list = &Apache::lonnet::dirlist($fullpath,$udom,$uname,1); 325: $dirlist{$fullpath} = \@list; 326: } 327: if (ref($dirlist{$fullpath}) eq 'ARRAY') { 328: foreach my $dir_line (@{$dirlist{$fullpath}}) { 329: my ($fname,$dom,undef,$testdir,undef,undef,undef,undef, 330: $size,undef,$mtime,undef,undef,undef,$obs,undef) = 331: split(/\&/,$dir_line,16); 332: if ($filename eq $fname) { 333: my $mbsize = $size/(1024.0*1024.0); 334: if (ref($totalsize)) { 335: $$totalsize += $mbsize; 336: } 337: last; 338: } 339: } 340: } 341: } 342: if (ref($totalsize)) { 343: if ($$totalsize > $maxfilesize) { 344: $$award='EXCESS_FILESIZE'; 345: if ($which eq 'filename') { 346: &delete_form_items($jspart,$id); 347: } 348: last; 349: } else { 350: push(@accepted_files,$file); 351: } 352: } else { 353: push(@accepted_files,$file); 354: } 355: } 356: if ($which eq 'portfiles') { 357: my @to_mark; 358: if ($Apache::lonhomework::results{"resource.$part.$id.portfiles"}) { 359: @to_mark = ($Apache::lonhomework::results{"resource.$part.$id.portfiles"}); 360: } 361: if (@accepted_files) { 362: if ($Apache::lonhomework::results{"resource.$part.$id.portfiles"}) { 363: $Apache::lonhomework::results{"resource.$part.$id.$which"} .= ','; 364: } 365: $Apache::lonhomework::results{"resource.$part.$id.$which"}.=join(',',@accepted_files); 366: push(@to_mark,@accepted_files); 367: } 368: &Apache::lonnet::unmark_as_readonly($udom,$uname,[$symb,$crsid]); 369: &Apache::lonnet::mark_as_readonly($udom,$uname,\@to_mark,[$symb,$crsid]); 370: &Apache::lonnet::clear_selected_files($uname); 371: } 372: if (($$award eq 'INVALID_FILETYPE') || ($$award eq 'EXCESS_FILESIZE')) { 373: if ($which eq 'filename') { 374: delete($env{'form.HWFILE'.$jspart.'_'.$id}); 375: } 376: return; 377: } 378: if (ref($uploadedflag)) { 379: $$uploadedflag=1; 380: } 381: if ($which eq 'filename') { 382: my $cleanpart = $part; 383: $cleanpart =~ s/\W/_/g; 384: my $cleanid = $id; 385: $cleanid =~ s/\W/_/g; 386: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb); 387: my %crsdesc = &Apache::lonnet::coursedescription($crsid); 388: my $turnindir; 389: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir'); 390: $turnindir = $userhash{'turnindir'}; 391: if ($turnindir eq '') { 392: $turnindir = &mt('turned in'); 393: $turnindir =~ s/\W+/_/g; 394: my %newhash = ( 395: 'turnindir' => $turnindir, 396: ); 397: &Apache::lonnet::put('environment',\%newhash,$udom,$uname); 398: } 399: my $prefix = 'portfolio'; 400: my $path = '/'.$turnindir.'/'; 401: my $crsname = $crsdesc{'description'}; 402: my $restitle=&Apache::lonnet::gettitle($symb); 403: foreach my $item ($crsname,$restitle) { 404: $item =~ s/\W+/_/g; 405: } 406: if ($crsname eq '') { 407: $crsname = $crsid; 408: } 409: if ($restitle eq '') { 410: $restitle = ($resurl =~ m{/[^/]+$}); 411: if ($restitle eq '') { 412: $restitle = time; 413: } 414: } 415: my @pathitems; 416: my $navmap = Apache::lonnavmaps::navmap->new(); 417: if (defined($navmap)) { 418: my $mapres = $navmap->getResourceByUrl($map); 419: if (ref($mapres)) { 420: my $pcslist = $mapres->map_hierarchy(); 421: if ($pcslist ne '') { 422: foreach my $pc (split(/,/,$pcslist)) { 423: my $res = $navmap->getByMapPc($pc); 424: if (ref($res)) { 425: my $title = $res->compTitle(); 426: $title =~ s/\W+/_/g; 427: if ($title ne '') { 428: push(@pathitems,$title); 429: } 430: } 431: } 432: } 433: my $maptitle = $mapres->compTitle(); 434: $maptitle =~ s/\W+/_/g; 435: if ($maptitle ne '') { 436: push(@pathitems,$maptitle); 437: } 438: } else { 439: $$award = 'INTERNAL_ERROR'; 440: } 441: } else { 442: $$award = 'INTERNAL_ERROR'; 443: } 444: push(@pathitems,$restitle); 445: unshift(@pathitems,$crsname); 446: $path .= join('/',@pathitems); 447: my $formelement = 'HWFILE'.$jspart.'_'.$id; 448: my $fname = $env{'form.'.$formelement.'.filename'}; 449: &Apache::lonnet::clean_filename($fname); 450: my $url = '/uploaded/'.$udom.'/'.$uname.'/'.$prefix.$path.'/'.$fname; 451: my @stat = &Apache::lonnet::stat_file($url); 452: if (@stat && $stat[0] ne 'no_such_dir') { 453: $$award = 'FILENAME_INUSE'; 454: } else { 455: my ($mode,%allfiles,%codebase); 456: my $result = &Apache::lonnet::userfileupload($formelement,'', 457: $prefix.$path,$mode,\%allfiles,\%codebase); 458: if ($result =~ m{^/uploaded/}) { 459: $Apache::lonhomework::results{"resource.$part.$id.portfiles"} .= $path.'/'.$fname; 460: &Apache::lonnet::unmark_as_readonly($udom,$uname,[$symb,$crsid]); 461: 462: &Apache::lonnet::mark_as_readonly($udom,$uname,[$path.'/'.$fname],[$symb,$crsid]); 463: } else { 464: $$award = 'INTERNAL_ERROR'; 465: } 466: } 467: delete($env{'form.HWFILE'.$jspart.'_'.$id}); 468: } 469: } 470: } 471: 472: sub delete_form_items { 473: my ($jspart,$id) = @_; 474: delete($env{'form.HWFILE'.$jspart.'_'.$id.'.filename'}); 475: delete($env{'form.HWFILE'.$jspart.'_'.$id.'.mimetype'}); 476: delete($env{'form.HWFILE'.$jspart.'_'.$id}); 477: } 478: 479: sub check_collaborators { 480: my ($ncol,$coll) = @_; 481: my %classlist=&Apache::lonnet::dump('classlist', 482: $env{'course.'.$env{'request.course.id'}.'.domain'}, 483: $env{'course.'.$env{'request.course.id'}.'.num'}); 484: my (@badcollaborators,$result); 485: 486: my (@collaborators) = split(/[,;\s]+/,$coll); 487: foreach my $entry (@collaborators) { 488: my $collaborator; 489: if ($entry =~ /:/) { 490: $collaborator = $entry; 491: } else { 492: $collaborator = $entry.':'.$env{'user.domain'}; 493: } 494: if ($collaborator !~ /^$match_username:$match_domain$/) { 495: if (!grep(/^\Q$entry\E$/,@badcollaborators)) { 496: push(@badcollaborators,$entry); 497: } 498: } elsif (!grep(/^\Q$collaborator\E$/i,keys(%classlist))) { 499: if (!grep(/^\Q$entry\E$/,@badcollaborators)) { 500: push(@badcollaborators,$entry); 501: } 502: } 503: } 504: 505: my $numbad = scalar(@badcollaborators); 506: if ($numbad) { 507: $result = '<table border="0"><tr bgcolor="#ffbbbb"><td>'; 508: if ($numbad == 1) { 509: $result .= &mt('The following user is invalid:'); 510: } else { 511: $result .= &mt('The following [_1] users are invalid:',$numbad); 512: } 513: $result .= ' '.join(', ',@badcollaborators).'. '.&mt('Please correct.'). 514: '</td></tr></table>'; 515: } 516: my $toomany = scalar(@collaborators) - $ncol; 517: if ($toomany > 0) { 518: $result .= '<table border="0"><tr bgcolor="#ffbbbb"><td>'. 519: &mt('You have too many collaborators.').' '. 520: &mt('Please remove [quant,_1,collaborator].',$toomany). 521: '</td></tr></table>'; 522: } 523: return $result; 524: } 525: 526: 1; 527: __END__ 528: 529: 530: =pod 531: 532: =head1 NAME 533: 534: Apache::essayresponse 535: 536: =head1 SYNOPSIS 537: 538: Handler to evaluate essay (ungraded) style responses. 539: 540: This is part of the LearningOnline Network with CAPA project 541: described at http://www.lon-capa.org. 542: 543: =head1 SUBROUTINES 544: 545: =over 546: 547: =item start_essayresponse() 548: 549: =item end_essayresponse() 550: 551: =item format_prior_response() 552: 553: =item file_submission() 554: 555: =item delete_form_items() 556: 557: =item check_collaborators() 558: 559: =back 560: 561: =cut