loncom/homework/essayresponse.pm - view

File: [LON-CAPA] / loncom / homework / essayresponse.pm
Revision 1.109: download - view: text, annotated - select for diffs
Sun Aug 22 19:00:15 2010 UTC (13 years, 8 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Bug 6349.
- Path needed to &current_file_submissions().

1: # The LearningOnline Network with CAPA 2: # essay (ungraded) style responses 3: # 4: # $Id: essayresponse.pm,v 1.109 2010/08/22 19:00:15 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::lonhtmlcommon; 33: use Apache::loncommon; 34: use Apache::lonnet; 35: use Apache::lonnavmaps; 36: use Apache::lonlocal; 37: use LONCAPA qw(:DEFAULT :match); 38: 39: 40: BEGIN { 41: &Apache::lonxml::register('Apache::essayresponse',('essayresponse')); 42: } 43: 44: sub start_essayresponse { 45: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 46: my $result; 47: my $id = &Apache::response::start_response($parstack,$safeeval); 48: if ($target eq 'meta') { 49: $result=&Apache::response::meta_package_write('essayresponse'); 50: } elsif ($target eq 'web' && 51: $Apache::inputtags::status[-1] eq 'CAN_ANSWER') { 52: my $part= $Apache::inputtags::part; 53: my $ncol= &Apache::lonnet::EXT("resource.$part".'_'."$id.maxcollaborators"); 54: my $coll= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"'); 55: my $uploadedfiletypes= &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes"); 56: $uploadedfiletypes=~s/[^\w\,]//g; 57: my $maxfilesize=&Apache::lonnet::EXT("resource.$part".'_'."$id.maxfilesize"); 58: if (!defined($maxfilesize)) { 59: $maxfilesize = 10.0; #FIXME This should become a domain configuration 60: } 61: if (($Apache::lonhomework::type eq 'survey') || 62: ($Apache::lonhomework::type eq 'surveycred') || 63: ($Apache::lonhomework::type eq 'anonsurvey') || 64: ($Apache::lonhomework::type eq 'anonsurveycred')) { 65: $result.= '<input type="hidden" name="HWDRAFT'.$part.'_'.$id.'" value="yes" />'; 66: } 67: my $status_text = &mt('Submission type'); 68: if ($Apache::lonhomework::history{"resource.$part.award"} eq 'DRAFT') { 69: $status_text .= '<br />'.&mt('(Currently -- draft)'); 70: } 71: $result.= '<p>'.&Apache::lonhtmlcommon::start_pick_box(). 72: &Apache::lonhtmlcommon::row_title($status_text); 73: if (($Apache::lonhomework::type ne 'survey') && 74: ($Apache::lonhomework::type ne 'surveycred') && 75: ($Apache::lonhomework::type ne 'anonsurvey') && 76: ($Apache::lonhomework::type ne 'anonsurveycred')) { 77: my $closure; 78: unless ($ncol || $uploadedfiletypes) { 79: $closure = 1; 80: } 81: $result.= 82: '<label>'. 83: '<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="yes" checked="checked" /> '. 84: &mt('Submit entries below as answer to receive credit'). 85: '</label> <br />'. 86: '<label>'. 87: '<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="no" /> '. 88: &mt('Save entries below (not submitted for credit yet)'). 89: '</label>'. 90: &Apache::lonhtmlcommon::row_closure($closure); 91: } 92: 93: if ($ncol > 0) { 94: $result.= &Apache::lonhtmlcommon::row_title(&mt('Collaborators')). 95: '<label>'. 96: &mt('Collaborators:').' <input type="text" size="70" max="80" name="HWCOL'. 97: $part.'_'.$id.'" value="'.$coll.'" /><br />'. 98: &mt('(Enter a maximum of [quant,_1,collaborator] using username or username:domain, e.g. smithje or smithje:[_2].)',$ncol,$env{'user.domain'}); 99: if ($ncol > 1) { 100: $result .= '<br />'.&mt('If entering more than one, use spaces to separate the collaborators.'); 101: } 102: $result .= '</label><br />'; 103: $result .= &check_collaborators($ncol,$coll) if ($coll =~ /\w+/); 104: $result .= &Apache::lonhtmlcommon::row_closure(); 105: } 106: my $filesfrom = 'both'; 107: my $stuname = &Apache::lonnet::EXT('user.name'); 108: my $studom = &Apache::lonnet::EXT('user.domain'); 109: if (!&Apache::lonnet::usertools_access($stuname,$studom,'portfolio')) { 110: $filesfrom = 'uploadonly'; 111: } 112: $result.=&Apache::inputtags::file_selector($part,$id,$uploadedfiletypes, 113: $filesfrom,undef,$maxfilesize); 114: $result.=&Apache::lonhtmlcommon::end_pick_box().'</p>'; 115: } elsif ($target eq 'web' && 116: $Apache::inputtags::status[-1] ne 'CAN_ANSWER') { 117: my $part= $Apache::inputtags::part; 118: my @msgs; 119: if ($Apache::lonhomework::history{"resource.$part.$id.collaborators"} =~ /\S/) { 120: my $coll= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"'); 121: $result .= '<td><i>'.&mt('Collaborated with [_1]',$coll).'</i></td>'; 122: } 123: 124: my $current_files_display = &Apache::inputtags::current_file_submissions($part,$id); 125: if ($current_files_display) { 126: $result .= '<td><b>'.&mt('Submitted files:').'</b><br />'. 127: $current_files_display.'</td>'; 128: } 129: 130: if ($result ne '') { 131: $result = 132: '<table class="LC_pastsubmission"><tr>'.$result. 133: '</tr></table>'; 134: } 135: } 136: return $result; 137: } 138: 139: sub end_essayresponse { 140: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 141: my $part = $Apache::inputtags::part; 142: my $id = $Apache::inputtags::response[-1]; 143: my $increment = &Apache::response::repetition(); 144: my $result; 145: if ( $target eq 'grade' ) { 146: # Deal with collaborators 147: my $collaborators = $env{'form.HWCOL'.$part.'_'.$id}; 148: my $previous_list= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"'); 149: if ($collaborators ne $previous_list) { 150: # &Apache::lonnet::logthis("New collaborators [$collaborators] [$previous_list]"); 151: $Apache::lonhomework::results{"resource.$part.$id.collaborators"}=$collaborators; 152: } 153: # Scantron 154: if ( &Apache::response::submitted('scantron') ) { 155: $increment=&Apache::response::scored_response($part,$id); 156: } elsif ( &Apache::response::submitted() ) { 157: my $response = $env{'form.HWVAL_'.$id}; 158: my $filename = $env{'form.HWFILE'.$part.'_'.$id.'.filename'} || 159: $env{'form.HWFILETOOBIG'.$part.'_'.$id}; 160: my $portfiles = $env{'form.HWPORT'.$part.'_'.$id}; 161: my @deletions = &Apache::loncommon::get_env_multiple('form.HWFILE'.$part.'_'.$id.'_delete'); 162: my ($is_submit,$was_draft); 163: if ($env{'form.HWDRAFT'.$part.'_'.$id} eq 'yes') { 164: $is_submit = 1; 165: } 166: if ($Apache::lonhomework::history{"resource.$part.award"} eq 'DRAFT') { 167: $was_draft = 1; 168: } 169: if (($response =~ /[^\s]/) || ($filename =~ /[^\s]/) || ($portfiles =~ /[^\s]/) || 170: (@deletions > 0) || ($was_draft && $is_submit)) { 171: my $award='DRAFT'; 172: if ($env{'form.HWDRAFT'.$part.'_'.$id} eq 'yes') { 173: if ($Apache::lonhomework::type eq 'anonsurvey') { 174: $award='ANONYMOUS'; 175: } elsif ($Apache::lonhomework::type eq 'anonsurveycred') { 176: $award='ANONYMOUS_CREDIT'; 177: } elsif ($Apache::lonhomework::type eq 'surveycred') { 178: $award='SUBMITTED_CREDIT'; 179: } else { 180: $award='SUBMITTED'; 181: } 182: } 183: my $uploadedflag=0; 184: my $totalsize=0; 185: &file_submission($part,$id,\$award,\$uploadedflag,\$totalsize,\@deletions); 186: $Apache::lonhomework::results{"resource.$part.$id.submission"}=$response; 187: $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$award; 188: my %previous=&Apache::response::check_for_previous($response,$part,$id); 189: if ($uploadedflag) { 190: if ($award eq 'FILENAME_INUSE') { 191: delete($Apache::lonhomework::results{"resource.$id.tries"}); 192: } 193: } else { 194: &Apache::response::handle_previous(\%previous,$award); 195: } 196: # 197: # Store with resource author for similarity testing 198: # 199: if ($award eq 'SUBMITTED') { 200: my ($symb,$crsid,$domain,$name)= 201: &Apache::lonnet::whichuser(); 202: if ($crsid) { 203: my $akey=join('.',&escape($name),&escape($domain), 204: &escape($crsid)); 205: my $essayurl= 206: &Apache::lonnet::declutter($ENV{'REQUEST_URI'}); 207: my ($adom,$aname,$apath)= 208: ($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/); 209: $apath=&escape($apath); 210: $apath=~s/\W/\_/gs; 211: &Apache::lonnet::put('nohist_essay_'.$apath, 212: { $akey => $response },$adom,$aname); 213: } 214: } 215: } 216: } 217: } elsif ($target eq 'edit') { 218: $result.=&Apache::edit::end_table(); 219: 220: } elsif ($target eq 'tex' 221: && $Apache::lonhomework::type eq 'exam') { 222: $result .= &Apache::inputtags::exam_score_line($target); 223: 224: } elsif ($target eq 'answer') { 225: $result.=&Apache::response::answer_header($$tagstack[-1]); 226: my $answer = &mt('Essay will be hand graded.'); 227: $result.=&Apache::response::answer_part($$tagstack[-1],$answer, 228: {'no_verbatim' => 1}); 229: $result.=&Apache::response::answer_footer($$tagstack[-1]); 230: } 231: if ($target eq 'web') { 232: &Apache::response::setup_prior_tries_hash(\&format_prior_response, 233: ['portfiles', 234: 'uploadedurl']); 235: } 236: 237: if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' || 238: $target eq 'tex' || $target eq 'analyze') { 239: &Apache::lonxml::increment_counter($increment, "$part.$id"); 240: 241: if ($target eq 'analyze') { 242: $Apache::lonhomework::analyze{"$part.$id.type"} = 'essayresponse'; 243: push (@{ $Apache::lonhomework::analyze{"parts"} },"$part.$id"); 244: &Apache::lonhomework::set_bubble_lines(); 245: } 246: } 247: &Apache::response::end_response; 248: 249: return $result; 250: } 251: 252: sub format_prior_response { 253: my ($mode,$answer,$other_data) = @_; 254: my $output; 255: 256: my (undef,undef,$udom,$uname) = &Apache::lonnet::whichuser(); 257: my $port_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio/'; 258: 259: my $file_list; 260: 261: foreach my $file (split(/\s*,\s*/, 262: $other_data->[0].','.$other_data->[1])) { 263: next if ($file!~/\S/); 264: if ($file !~ m{^/uploaded/}) { $file=$port_url.$file; } 265: $file=~s|/+|/|g; 266: &Apache::lonnet::allowuploaded('/adm/essayresponse',$file); 267: $file_list.='<li><span class="LC_nobreak"><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'. 268: &Apache::loncommon::icon($file).'" alt="file icon" border="0" /> '.$file. 269: '</a></span></li>'."\n"; 270: } 271: if ($file_list) { 272: $output.= &mt('Submitted Files').'<ul>'.$file_list.'</ul>'; 273: } 274: if ($answer =~ /\S/) { 275: $output.='<p>'.&mt('Submitted text'). 276: '<blockquote>'.$answer.'</blockquote></p>'; 277: } 278: 279: return '<div class="LC_prior_essay">'.$output.'</div>'; 280: } 281: 282: sub file_submission { 283: my ($part,$id,$award,$uploadedflag,$totalsize,$deletions)=@_; 284: my $files; 285: my $jspart=$part; 286: $jspart=~s/\./_/g; 287: my ($symb,$crsid,$udom,$uname) = &Apache::lonnet::whichuser(); 288: my %crsinfo = &Apache::lonnet::coursedescription($crsid); 289: my $cdom = $crsinfo{'domain'}; 290: my $cnum = $crsinfo{'num'}; 291: my (@portfiles,$uploadedurl,@submitted_portfiles,$submitted_upload, 292: @acceptable_portfiles,$acceptable_upload,@accepted_portfiles, 293: $accepted_upload,@savedportfiles,$stored_upload,@tolock, 294: %port_delete,$uploaded_delete); 295: if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"} || 296: $Apache::lonhomework::history{"resource.$part.$id.uploadedurl"}) { 297: if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"}) { 298: @portfiles = split(/,/,$Apache::lonhomework::history{"resource.$part.$id.portfiles"}); 299: } 300: $uploadedurl = $Apache::lonhomework::history{"resource.$part.$id.uploadedurl"}; 301: if (ref($deletions) eq 'ARRAY') { 302: if (@{$deletions} > 0) { 303: foreach my $file (@{$deletions}) { 304: $file = &HTML::Entities::decode($file); 305: if (grep(/^\Q$file\E$/,@portfiles)) { 306: $port_delete{$file} = 1; 307: } elsif ($file =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/essayresponse/\Q$cdom\E/\Q$cnum\E/}) { 308: $uploaded_delete = $file; 309: } 310: } 311: } 312: } 313: foreach my $current (@portfiles) { 314: unless ($port_delete{$current}) { 315: push(@savedportfiles,$current); 316: } 317: } 318: if ($uploaded_delete) { 319: $Apache::lonhomework::results{"resource.$part.$id.uploadedfile"} = ""; 320: $Apache::lonhomework::results{"resource.$part.$id.uploadedurl"} = ""; 321: } 322: } 323: if ($env{'form.HWPORT'.$jspart.'_'.$id} ne '') { 324: my $newfiles= $env{'form.HWPORT'.$jspart.'_'.$id}; 325: $newfiles =~s/,$//; 326: if ($newfiles =~ /[^\s]/) { 327: foreach my $file (split(/\s*,\s*/,$newfiles)) { 328: if ($file =~ /[^\s]/) { 329: push(@submitted_portfiles,$file); 330: } 331: } 332: } 333: } 334: if ($env{'form.HWFILETOOBIG'.$jspart.'_'.$id} ne '') { 335: $$award = 'EXCESS_FILESIZE'; 336: } elsif ($env{'form.HWFILE'.$jspart.'_'.$id.'.filename'} ne '') { 337: my $newfile = $env{'form.HWFILE'.$jspart.'_'.$id.'.filename'}; 338: if ($newfile =~ /[^\s]/) { 339: $submitted_upload = $newfile; 340: } 341: } 342: if (@savedportfiles) { 343: foreach my $file (reverse(@savedportfiles)) { 344: unless(grep(/^\Q$file\E$/,@submitted_portfiles)) { 345: unshift(@submitted_portfiles,$file); 346: } 347: } 348: } 349: if (@submitted_portfiles || $submitted_upload) { 350: my $uploadedfiletypes= 351: &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes"); 352: if ($uploadedfiletypes ne '') { 353: $uploadedfiletypes=~s/[^\w\,]//g; 354: $uploadedfiletypes=','.$uploadedfiletypes.','; 355: if (@submitted_portfiles) { 356: foreach my $file (@submitted_portfiles) { 357: my ($extension)=($file=~/\.(\w+)$/); 358: if ($uploadedfiletypes=~/\,\s*\Q$extension\E\s*\,/i) { 359: push(@acceptable_portfiles,$file); 360: } 361: } 362: } 363: if ($submitted_upload) { 364: my ($upload_ext)=($submitted_upload=~/\.(\w+)$/); 365: if ($uploadedfiletypes=~/\,\s*\Q$upload_ext\E\s*\,/i) { 366: $acceptable_upload = $submitted_upload; 367: } else { 368: $$award='INVALID_FILETYPE'; 369: &delete_form_items($jspart,$id); 370: } 371: } 372: } else { 373: @acceptable_portfiles = @submitted_portfiles; 374: $acceptable_upload = $submitted_upload; 375: } 376: } 377: if ((@acceptable_portfiles) || ($acceptable_upload ne '')) { 378: my $maxfilesize=&Apache::lonnet::EXT("resource.$part".'_'."$id.maxfilesize"); 379: if (!$maxfilesize) { 380: $maxfilesize = 10.0; #FIXME This should become a domain configuration 381: } 382: my %dirlist; 383: if (@acceptable_portfiles) { 384: foreach my $file (@acceptable_portfiles) { 385: my ($path,$filename) = ($file =~ m{^(.*/)([^/]+)$}); 386: my $fullpath = '/userfiles/portfolio'.$path; 387: if (!exists($dirlist{$fullpath})) { 388: my @list = &Apache::lonnet::dirlist($fullpath,$udom,$uname,1); 389: $dirlist{$fullpath} = \@list; 390: } 391: if (ref($dirlist{$fullpath}) eq 'ARRAY') { 392: foreach my $dir_line (@{$dirlist{$fullpath}}) { 393: my ($fname,$dom,undef,$testdir,undef,undef,undef,undef, 394: $size,undef,$mtime,undef,undef,undef,$obs,undef) = 395: split(/\&/,$dir_line,16); 396: if ($filename eq $fname) { 397: my $mbsize = $size/(1024.0*1024.0); 398: if (ref($totalsize)) { 399: $$totalsize += $mbsize; 400: } 401: last; 402: } 403: } 404: } 405: if (ref($totalsize)) { 406: if ($$totalsize > $maxfilesize) { 407: $$award='EXCESS_FILESIZE'; 408: &delete_form_items($jspart,$id); 409: } else { 410: push(@accepted_portfiles,$file); 411: } 412: } else { 413: push(@accepted_portfiles,$file); 414: } 415: } 416: } 417: if ($acceptable_upload ne '') { 418: if (ref($totalsize)) { 419: $$totalsize += $env{'form.HWFILESIZE'.$jspart.'_'.$id}; 420: if ($$totalsize > $maxfilesize) { 421: $$award='EXCESS_FILESIZE'; 422: delete($env{'form.HWFILE'.$jspart.'_'.$id}); 423: } else { 424: $accepted_upload = $acceptable_upload; 425: } 426: } else { 427: $accepted_upload = $acceptable_upload; 428: } 429: } 430: } 431: if ($accepted_upload ne '') { 432: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb); 433: my $turnindir; 434: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir'); 435: $turnindir = $userhash{'turnindir'}; 436: if ($turnindir eq '') { 437: $turnindir = &mt('turned in'); 438: $turnindir =~ s/\W+/_/g; 439: my %newhash = ( 440: 'turnindir' => $turnindir, 441: ); 442: &Apache::lonnet::put('environment',\%newhash,$udom,$uname); 443: } 444: my $prefix = 'portfolio'; 445: my $path = '/'.$turnindir.'/'; 446: my $restitle=&Apache::lonnet::gettitle($symb); 447: $restitle =~ s/\W+/_/g; 448: if ($restitle eq '') { 449: $restitle = ($resurl =~ m{/[^/]+$}); 450: if ($restitle eq '') { 451: $restitle = time; 452: } 453: } 454: my @pathitems; 455: my $navmap = Apache::lonnavmaps::navmap->new(); 456: if (defined($navmap)) { 457: my $mapres = $navmap->getResourceByUrl($map); 458: if (ref($mapres)) { 459: my $pcslist = $mapres->map_hierarchy(); 460: if ($pcslist ne '') { 461: foreach my $pc (split(/,/,$pcslist)) { 462: my $res = $navmap->getByMapPc($pc); 463: if (ref($res)) { 464: my $title = $res->compTitle(); 465: $title =~ s/\W+/_/g; 466: if ($title ne '') { 467: push(@pathitems,$title); 468: } 469: } 470: } 471: } 472: my $maptitle = $mapres->compTitle(); 473: $maptitle =~ s/\W+/_/g; 474: if ($maptitle ne '') { 475: push(@pathitems,$maptitle); 476: } 477: } else { 478: $$award = 'INTERNAL_ERROR'; 479: } 480: } else { 481: $$award = 'INTERNAL_ERROR'; 482: } 483: push(@pathitems,$restitle); 484: $path .= join('/',@pathitems); 485: my $formelement = 'HWFILE'.$jspart.'_'.$id; 486: my $fname = $env{'form.'.$formelement.'.filename'}; 487: &Apache::lonnet::clean_filename($fname); 488: my $url = '/uploaded/'.$udom.'/'.$uname.'/'.$prefix.$path.'/'.$fname; 489: my @stat = &Apache::lonnet::stat_file($url); 490: if (@stat && $stat[0] ne 'no_such_dir') { 491: $$award = 'FILENAME_INUSE'; 492: } else { 493: my ($mode,%allfiles,%codebase); 494: my $result = &Apache::lonnet::userfileupload($formelement,'', 495: $prefix.$path,$mode,\%allfiles,\%codebase); 496: if ($result =~ m{^/uploaded/}) { 497: $stored_upload = $path.'/'.$fname; 498: $Apache::lonhomework::results{"resource.$part.$id.portfiles"} = $stored_upload; 499: push(@tolock,$stored_upload); 500: } else { 501: $$award = 'INTERNAL_ERROR'; 502: } 503: } 504: delete($env{'form.HWFILE'.$jspart.'_'.$id}); 505: } 506: if (@accepted_portfiles) { 507: if ($stored_upload) { 508: $Apache::lonhomework::results{"resource.$part.$id.portfiles"} .= ','; 509: } 510: $Apache::lonhomework::results{"resource.$part.$id.portfiles"}.=join(',',@accepted_portfiles); 511: push(@tolock,@accepted_portfiles); 512: } 513: if (!defined($Apache::lonhomework::results{"resource.$part.$id.portfiles"})) { 514: if (keys(%port_delete) > 0) { 515: $Apache::lonhomework::results{"resource.$part.$id.portfiles"} = ""; 516: } 517: } 518: if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"} ne $Apache::lonhomework::results{"resource.$part.$id.portfiles"}) { 519: if (ref($uploadedflag)) { 520: $$uploadedflag=1; 521: } 522: } 523: &Apache::lonnet::unmark_as_readonly($udom,$uname,[$symb,$crsid]); 524: &Apache::lonnet::mark_as_readonly($udom,$uname,[@tolock],[$symb,$crsid]); 525: &Apache::lonnet::clear_selected_files($uname); 526: return; 527: } 528: 529: sub delete_form_items { 530: my ($jspart,$id) = @_; 531: delete($env{'form.HWFILE'.$jspart.'_'.$id.'.filename'}); 532: delete($env{'form.HWFILE'.$jspart.'_'.$id.'.mimetype'}); 533: delete($env{'form.HWFILE'.$jspart.'_'.$id}); 534: } 535: 536: sub check_collaborators { 537: my ($ncol,$coll) = @_; 538: my %classlist=&Apache::lonnet::dump('classlist', 539: $env{'course.'.$env{'request.course.id'}.'.domain'}, 540: $env{'course.'.$env{'request.course.id'}.'.num'}); 541: my (@badcollaborators,$result); 542: 543: my (@collaborators) = split(/[,;\s]+/,$coll); 544: foreach my $entry (@collaborators) { 545: my $collaborator; 546: if ($entry =~ /:/) { 547: $collaborator = $entry; 548: } else { 549: $collaborator = $entry.':'.$env{'user.domain'}; 550: } 551: if ($collaborator !~ /^$match_username:$match_domain$/) { 552: if (!grep(/^\Q$entry\E$/,@badcollaborators)) { 553: push(@badcollaborators,$entry); 554: } 555: } elsif (!grep(/^\Q$collaborator\E$/i,keys(%classlist))) { 556: if (!grep(/^\Q$entry\E$/,@badcollaborators)) { 557: push(@badcollaborators,$entry); 558: } 559: } 560: } 561: 562: my $numbad = scalar(@badcollaborators); 563: if ($numbad) { 564: $result = '<table border="0"><tr bgcolor="#ffbbbb"><td>'; 565: if ($numbad == 1) { 566: $result .= &mt('The following user is invalid:'); 567: } else { 568: $result .= &mt('The following [_1] users are invalid:',$numbad); 569: } 570: $result .= ' '.join(', ',@badcollaborators).'. '.&mt('Please correct.'). 571: '</td></tr></table>'; 572: } 573: my $toomany = scalar(@collaborators) - $ncol; 574: if ($toomany > 0) { 575: $result .= '<table border="0"><tr bgcolor="#ffbbbb"><td>'. 576: &mt('You have too many collaborators.').' '. 577: &mt('Please remove [quant,_1,collaborator].',$toomany). 578: '</td></tr></table>'; 579: } 580: return $result; 581: } 582: 583: 1; 584: __END__ 585: 586: 587: =pod 588: 589: =head1 NAME 590: 591: Apache::essayresponse 592: 593: =head1 SYNOPSIS 594: 595: Handler to evaluate essay (ungraded) style responses. 596: 597: This is part of the LearningOnline Network with CAPA project 598: described at http://www.lon-capa.org. 599: 600: =head1 SUBROUTINES 601: 602: =over 603: 604: =item start_essayresponse() 605: 606: =item end_essayresponse() 607: 608: =item format_prior_response() 609: 610: =item file_submission() 611: 612: =item delete_form_items() 613: 614: =item check_collaborators() 615: 616: =back 617: 618: =cut