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