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.

# The LearningOnline Network with CAPA
# essay (ungraded) style responses
#
# $Id: essayresponse.pm,v 1.107 2010/06/17 00:13:20 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package Apache::essayresponse;
use strict;
use Apache::lonxml();
use Apache::lonnet;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);
 

BEGIN {
    &Apache::lonxml::register('Apache::essayresponse',('essayresponse'));
}

sub start_essayresponse {
    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
    my $result;
    my $id = &Apache::response::start_response($parstack,$safeeval);
    if ($target eq 'meta') {
	$result=&Apache::response::meta_package_write('essayresponse');
    } elsif ($target eq 'web' &&
	     $Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
	my $part= $Apache::inputtags::part;
	my $ncol= &Apache::lonnet::EXT("resource.$part".'_'."$id.maxcollaborators");
	my $coll= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"');
	my $uploadedfiletypes= &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes");
        $uploadedfiletypes=~s/[^\w\,]//g;
        my $maxfilesize=&Apache::lonnet::EXT("resource.$part".'_'."$id.maxfilesize");
        if (!defined($maxfilesize)) {
            $maxfilesize = 10.0; #FIXME This should become a domain configuration 
        }
	if (($Apache::lonhomework::type eq 'survey') ||
            ($Apache::lonhomework::type eq 'surveycred') ||
            ($Apache::lonhomework::type eq 'anonsurvey') ||
            ($Apache::lonhomework::type eq 'anonsurveycred')) {
	    $result.= '<input type="hidden" name="HWDRAFT'.$part.'_'.$id.'" value="yes" /> ';
	}
	$result.='<br /><table border="1">';
	if (($Apache::lonhomework::type ne 'survey') &&
            ($Apache::lonhomework::type ne 'surveycred') &&
            ($Apache::lonhomework::type ne 'anonsurvey') &&
            ($Apache::lonhomework::type ne 'anonsurveycred')) {
	    $result.= '<tr><td>'.
		'<label>'.
		'<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="yes" checked="checked" /> '.
		&mt('Submit entries below as answer to receive credit').
		'</label> <br />'.
		'<label>'.
		'<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="no" /> '.
		&mt('Save entries below (not submitted for credit yet)').
		'</label>'.
		'</td></tr>';
	}

	if ($ncol > 0) {
	    $result .='<tr><td>'.'<label>'.
		      &mt('Collaborators:').' <input type="text" size="70" max="80" name="HWCOL'.
		      $part.'_'.$id.'" value="'.$coll.'" /><br />'.
		      &mt('(Enter a maximum of [quant,_1,collaborator] using username or username:domain, e.g. smithje or smithje:[_2].)',$ncol,$env{'user.domain'});
            if ($ncol > 1) {
                $result .= '<br />'.&mt('If entering more than one, use spaces to separate the collaborators.');
            }
            $result .= '</label><br />';
	    $result .= &check_collaborators($ncol,$coll) if ($coll =~ /\w+/);
	    $result .='</td></tr>';
	}
        my $filesfrom = 'both';
        my $stuname = &Apache::lonnet::EXT('user.name');
        my $studom = &Apache::lonnet::EXT('user.domain');
        if (!&Apache::lonnet::usertools_access($stuname,$studom,'portfolio')) {
            $filesfrom = 'uploadonly';
        }
	$result.=&Apache::inputtags::file_selector($part,$id,$uploadedfiletypes,
						   $filesfrom,undef,$maxfilesize);
        $result.='</table>';
    } elsif ($target eq 'web' &&
	     $Apache::inputtags::status[-1] ne 'CAN_ANSWER') {
	my $part= $Apache::inputtags::part;
	my @msgs;
	if ($Apache::lonhomework::history{"resource.$part.$id.collaborators"} =~ /\S/) {
	    my $coll= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"');
	    $result .= '<td><i>'.&mt('Collaborated with [_1]',$coll).'</i></td>';
	}

	my $file_submission = 
	    &Apache::inputtags::show_past_file_submission($part,$id);
	if ($file_submission) {
	    $result .= '<td>'.$file_submission.'</td>';
	}

	my $port_submission = 
	    &Apache::inputtags::show_past_portfile_submission($part,$id);
	if ($port_submission) {
	    $result .= '<td>'.$port_submission.'</td>';
	}

	if ($result ne '') {
	    $result = 
		'<table class="LC_pastsubmission"><tr>'.$result.
		'</tr></table>';
	}
    }
    return $result;
}

sub end_essayresponse {
    my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
    my $part          = $Apache::inputtags::part;
    my $id            = $Apache::inputtags::response[-1];
    my $increment     = &Apache::response::repetition();
    my $result;
    if ( $target eq 'grade' ) {
# Deal with collaborators
	my $collaborators = $env{'form.HWCOL'.$part.'_'.$id};
	my $previous_list= &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"');
	if ($collaborators ne $previous_list) { 
#           &Apache::lonnet::logthis("New collaborators [$collaborators] [$previous_list]");
           $Apache::lonhomework::results{"resource.$part.$id.collaborators"}=$collaborators; 
        }
# Scantron
	if (  &Apache::response::submitted('scantron') ) {
	    $increment=&Apache::response::scored_response($part,$id);
	} elsif ( &Apache::response::submitted() ) {
	    my $response      = $env{'form.HWVAL_'.$id};
            my $filename = $env{'form.HWFILE'.$part.'_'.$id.'.filename'} || 
                           $env{'form.HWFILETOOBIG'.$part.'_'.$id};
            my $portfiles = $env{'form.HWPORT'.$part.'_'.$id};
	    if (( $response =~ /[^\s]/) || ($filename =~ /[^\s]/) || ($portfiles =~ /[^\s]/)) {
 		my $award='DRAFT';
        	if ($env{'form.HWDRAFT'.$part.'_'.$id} eq 'yes') {
                    if ($Apache::lonhomework::type eq 'anonsurvey') {
                        $award='ANONYMOUS';
                    } elsif ($Apache::lonhomework::type eq 'anonsurveycred') {
                        $award='ANONYMOUS_CREDIT';
                    } elsif ($Apache::lonhomework::type eq 'surveycred') {
                        $award='SUBMITTED_CREDIT';
                    } else {
		        $award='SUBMITTED';
                    }
		}
                my $uploadedflag=0;
                my $totalsize=0;
		&file_submission($part,$id,'filename',\$award,\$uploadedflag,\$totalsize);
		&file_submission($part,$id,'portfiles',\$award,\$uploadedflag,\$totalsize);
		$Apache::lonhomework::results{"resource.$part.$id.submission"}=$response;
		$Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$award;
		my %previous=&Apache::response::check_for_previous($response,$part,$id);
		if ($uploadedflag) {
                    if ($award eq 'FILENAME_INUSE') {
                        delete($Apache::lonhomework::results{"resource.$id.tries"});
                    }
                } else {
                    &Apache::response::handle_previous(\%previous,$award);
                }
#
# Store with resource author for similarity testing
#
                if ($award eq 'SUBMITTED') {
		    my ($symb,$crsid,$domain,$name)=
			&Apache::lonnet::whichuser();
		    if ($crsid) {
			my $akey=join('.',&escape($name),&escape($domain),
				      &escape($crsid));
			my $essayurl=
			    &Apache::lonnet::declutter($ENV{'REQUEST_URI'});
			my ($adom,$aname,$apath)=
			    ($essayurl=~/^($LONCAPA::domain_re)\/($LONCAPA::username_re)\/(.*)$/);
                        $apath=&escape($apath);
			$apath=~s/\W/\_/gs;
			&Apache::lonnet::put('nohist_essay_'.$apath,
					 { $akey => $response },$adom,$aname);
		    }
                }
	    }
	} 
    } elsif ($target eq 'edit') {
	$result.=&Apache::edit::end_table();

    } elsif ($target eq 'tex'
	     && $Apache::lonhomework::type eq 'exam') {
	$result .= &Apache::inputtags::exam_score_line($target);

    } elsif ($target eq 'answer') {
	$result.=&Apache::response::answer_header($$tagstack[-1]);
	my $answer = &mt('Essay will be hand graded.');
	$result.=&Apache::response::answer_part($$tagstack[-1],$answer,
						{'no_verbatim' => 1});
	$result.=&Apache::response::answer_footer($$tagstack[-1]);
    }
    if ($target eq 'web') {
	&Apache::response::setup_prior_tries_hash(\&format_prior_response,
						  ['portfiles',
						   'uploadedurl']);
    }

    if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' ||
	$target eq 'tex' || $target eq 'analyze') {
	&Apache::lonxml::increment_counter($increment, "$part.$id");

	if ($target eq 'analyze') {
            $Apache::lonhomework::analyze{"$part.$id.type"} = 'essayresponse';
            push (@{ $Apache::lonhomework::analyze{"parts"} },"$part.$id");
	    &Apache::lonhomework::set_bubble_lines();
	}
    }
    &Apache::response::end_response;

    return $result;
}

sub format_prior_response {
    my ($mode,$answer,$other_data) = @_;
    my $output;

    my (undef,undef,$udom,$uname) = &Apache::lonnet::whichuser();
    my $port_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio/';

    my $file_list;

    foreach my $file (split(/\s*,\s*/,
			    $other_data->[0].','.$other_data->[1])) {
	next if ($file!~/\S/);
	if ($file !~ m{^/uploaded/}) { $file=$port_url.$file; }
	$file=~s|/+|/|g;
	&Apache::lonnet::allowuploaded('/adm/essayresponse',$file);
	$file_list.='<li><span class="LC_nobreak"><a href="'.$file.'?rawmode=1" target="lonGRDs"><img src="'.
	    &Apache::loncommon::icon($file).'" alt="file icon" border="0" /> '.$file.
	    '</a></span></li>'."\n";
    }
    if ($file_list) {
	$output.= &mt('Submitted Files').'<ul>'.$file_list.'</ul>';
    }
    if ($answer =~ /\S/) {
	$output.='<p>'.&mt('Submitted text').
	    '<blockquote>'.$answer.'</blockquote></p>';
    }

    return '<div class="LC_prior_essay">'.$output.'</div>';
}

sub file_submission {
    my ($part,$id,$which,$award,$uploadedflag,$totalsize)=@_;
    my $files;
    my $jspart=$part;
    $jspart=~s/\./_/g;
    if ($which eq 'portfiles') { 
        $files= $env{'form.HWPORT'.$jspart.'_'.$id};
    } elsif ($which eq 'filename') {
        if ($env{'form.HWFILETOOBIG'.$jspart.'_'.$id} ne '') {
            $$award = 'EXCESS_FILESIZE';
            return;
        } else {
            $files = $env{'form.HWFILE'.$jspart.'_'.$id.'.filename'};
        }
    }
    my ($symb,$crsid,$udom,$uname)=&Apache::lonnet::whichuser();
    if ($files =~ /[^\s]/) {
	$files =~s/,$//;
        my (@submitted_files,@acceptable_files,@accepted_files);
        if ($which eq 'portfiles') {
            @submitted_files = split(/\s*,\s*/,$files);
        } else {
            @submitted_files = ($files);
        }
        my $uploadedfiletypes= 
            &Apache::lonnet::EXT("resource.$part".'_'."$id.uploadedfiletypes");
        if ($uploadedfiletypes ne '') {
            $uploadedfiletypes=~s/[^\w\,]//g;
            $uploadedfiletypes=','.$uploadedfiletypes.',';
            foreach my $file (@submitted_files) {
                my ($extension)=($file=~/\.(\w+)$/);
                if ($uploadedfiletypes=~/\,\s*\Q$extension\E\s*\,/i) {
                    push(@acceptable_files,$file);
                } else {
                    $$award='INVALID_FILETYPE';
                    if ($which eq 'filename') {
                        &delete_form_items($jspart,$id);
                    }
                }
            }
        } else {
            @acceptable_files = @submitted_files;
        }
        my $maxfilesize=&Apache::lonnet::EXT("resource.$part".'_'."$id.maxfilesize");
        if (!$maxfilesize) {
            $maxfilesize = 10.0; #FIXME This should become a domain configuration
        }
        my %dirlist;
        foreach my $file (@acceptable_files) {
            if ($which eq 'filename') {
                if (ref($totalsize)) {
                    $$totalsize += $env{'form.HWFILESIZE'.$jspart.'_'.$id};
                }
            } else {
                my ($path,$filename) = ($file =~ m{^(.*/)([^/]+)$});
                my $fullpath = '/userfiles/portfolio'.$path;
                if (!exists($dirlist{$fullpath})) {
                    my @list = &Apache::lonnet::dirlist($fullpath,$udom,$uname,1);
                    $dirlist{$fullpath} = \@list;
                }
                if (ref($dirlist{$fullpath}) eq 'ARRAY') {
                    foreach my $dir_line (@{$dirlist{$fullpath}}) {
                        my ($fname,$dom,undef,$testdir,undef,undef,undef,undef,
                            $size,undef,$mtime,undef,undef,undef,$obs,undef) = 
                        split(/\&/,$dir_line,16);
                        if ($filename eq $fname) {
                            my $mbsize = $size/(1024.0*1024.0);
                            if (ref($totalsize)) {
                                $$totalsize += $mbsize;
                            }
                            last;
                        }
                    }
                }
            }
            if (ref($totalsize)) {
                if ($$totalsize > $maxfilesize) {
                    $$award='EXCESS_FILESIZE';
                    if ($which eq 'filename') {
                        &delete_form_items($jspart,$id);
                    }
                    last;
                } else {
                    push(@accepted_files,$file);
                }
            } else {
                push(@accepted_files,$file);
            }
        }
        if ($which eq 'portfiles') {
            my @to_mark;
            if ($Apache::lonhomework::results{"resource.$part.$id.portfiles"}) {
                @to_mark = ($Apache::lonhomework::results{"resource.$part.$id.portfiles"});
            }
            if (@accepted_files) {
                if ($Apache::lonhomework::results{"resource.$part.$id.portfiles"}) {
                    $Apache::lonhomework::results{"resource.$part.$id.$which"} .= ',';
                }
                $Apache::lonhomework::results{"resource.$part.$id.$which"}.=join(',',@accepted_files);
                push(@to_mark,@accepted_files);
            }
            &Apache::lonnet::unmark_as_readonly($udom,$uname,[$symb,$crsid]);
            &Apache::lonnet::mark_as_readonly($udom,$uname,\@to_mark,[$symb,$crsid]);
            &Apache::lonnet::clear_selected_files($uname);
        }
        if (($$award eq 'INVALID_FILETYPE') || ($$award eq 'EXCESS_FILESIZE')) {
            if ($which eq 'filename') {
                delete($env{'form.HWFILE'.$jspart.'_'.$id});
            }
            return;
        }
	if (ref($uploadedflag)) {
	    $$uploadedflag=1;
	}
	if ($which eq 'filename') {
            my $cleanpart = $part;
            $cleanpart =~ s/\W/_/g;
            my $cleanid = $id;
            $cleanid =~ s/\W/_/g;
            my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
            my %crsdesc = &Apache::lonnet::coursedescription($crsid);
            my $turnindir;
            my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
            $turnindir = $userhash{'turnindir'};
            if ($turnindir eq '') {
                $turnindir = &mt('turned in');
                $turnindir =~ s/\W+/_/g;
                my %newhash = (
                                'turnindir' => $turnindir,
                              );
                &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
            }
            my $prefix = 'portfolio';
            my $path = '/'.$turnindir.'/';
            my $crsname = $crsdesc{'description'};
            my $restitle=&Apache::lonnet::gettitle($symb);
            foreach my $item ($crsname,$restitle) {
                $item =~ s/\W+/_/g;
            }
            if ($crsname eq '') {
                $crsname = $crsid;
            }
            if ($restitle eq '') {
                $restitle = ($resurl =~ m{/[^/]+$});
                if ($restitle eq '') {
                    $restitle = time;
                }
            }
            my @pathitems;
            my $navmap = Apache::lonnavmaps::navmap->new();
            if (defined($navmap)) {
                my $mapres = $navmap->getResourceByUrl($map);
                if (ref($mapres)) {
                    my $pcslist = $mapres->map_hierarchy();
                    if ($pcslist ne '') {
                        foreach my $pc (split(/,/,$pcslist)) {
                            my $res = $navmap->getByMapPc($pc);
                            if (ref($res)) {
                                my $title = $res->compTitle();
                                $title =~ s/\W+/_/g;
                                if ($title ne '') {
                                    push(@pathitems,$title);
                                }
                            }
                        }
                    }
                    my $maptitle = $mapres->compTitle();
                    $maptitle =~ s/\W+/_/g;
                    if ($maptitle ne '') {
                        push(@pathitems,$maptitle);
                    }
                } else {
                    $$award = 'INTERNAL_ERROR';
                }
            } else {
                $$award = 'INTERNAL_ERROR';
            }
            push(@pathitems,$restitle);
            unshift(@pathitems,$crsname);
            $path .= join('/',@pathitems);
            my $formelement = 'HWFILE'.$jspart.'_'.$id;
            my $fname = $env{'form.'.$formelement.'.filename'};
            &Apache::lonnet::clean_filename($fname);
            my $url = '/uploaded/'.$udom.'/'.$uname.'/'.$prefix.$path.'/'.$fname;
            my @stat = &Apache::lonnet::stat_file($url);
            if (@stat && $stat[0] ne 'no_such_dir') {
                $$award = 'FILENAME_INUSE';
            } else {
                my ($mode,%allfiles,%codebase);
                my $result = &Apache::lonnet::userfileupload($formelement,'',
                                 $prefix.$path,$mode,\%allfiles,\%codebase);
                if ($result =~ m{^/uploaded/}) {
                    $Apache::lonhomework::results{"resource.$part.$id.portfiles"} .= $path.'/'.$fname;
                    &Apache::lonnet::unmark_as_readonly($udom,$uname,[$symb,$crsid]);
     
                    &Apache::lonnet::mark_as_readonly($udom,$uname,[$path.'/'.$fname],[$symb,$crsid]);
                } else {
                    $$award = 'INTERNAL_ERROR';
                }
            }
            delete($env{'form.HWFILE'.$jspart.'_'.$id});
	}
    }
}

sub delete_form_items {
    my ($jspart,$id) = @_;
    delete($env{'form.HWFILE'.$jspart.'_'.$id.'.filename'});
    delete($env{'form.HWFILE'.$jspart.'_'.$id.'.mimetype'});
    delete($env{'form.HWFILE'.$jspart.'_'.$id});
}

sub check_collaborators {
    my ($ncol,$coll) = @_;
    my %classlist=&Apache::lonnet::dump('classlist',
					$env{'course.'.$env{'request.course.id'}.'.domain'},
					$env{'course.'.$env{'request.course.id'}.'.num'});
    my (@badcollaborators,$result);
  
    my (@collaborators) = split(/[,;\s]+/,$coll);
    foreach my $entry (@collaborators) {
        my $collaborator;
	if ($entry =~ /:/) {
	    $collaborator = $entry;
	} else {
	    $collaborator = $entry.':'.$env{'user.domain'};
	}
        if ($collaborator !~ /^$match_username:$match_domain$/) {
            if (!grep(/^\Q$entry\E$/,@badcollaborators)) {
	        push(@badcollaborators,$entry);
            }
        } elsif (!grep(/^\Q$collaborator\E$/i,keys(%classlist))) {
            if (!grep(/^\Q$entry\E$/,@badcollaborators)) {
                push(@badcollaborators,$entry);
            }
        }
    }
    
    my $numbad = scalar(@badcollaborators);
    if ($numbad) {
	$result = '<table border="0"><tr bgcolor="#ffbbbb"><td>';
        if ($numbad == 1) {
            $result .= &mt('The following user is invalid:');
        } else {
            $result .= &mt('The following [_1] users are invalid:',$numbad);
        }
	$result .= ' '.join(', ',@badcollaborators).'. '.&mt('Please correct.').
                   '</td></tr></table>';
    }
    my $toomany = scalar(@collaborators) - $ncol;
    if ($toomany > 0) {
	$result .= '<table border="0"><tr bgcolor="#ffbbbb"><td>'.
	           &mt('You have too many collaborators.').' '.
                   &mt('Please remove [quant,_1,collaborator].',$toomany).
	           '</td></tr></table>';
    }
    return $result;
}

1;
__END__


=pod

=head1 NAME

Apache::essayresponse

=head1 SYNOPSIS

Handler to evaluate essay (ungraded) style responses.

This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.

=head1 SUBROUTINES

=over 

=item start_essayresponse()

=item end_essayresponse()

=item format_prior_response()

=item file_submission()

=item delete_form_items()

=item check_collaborators()

=back

=cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>