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 (14 years, 2 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>