--- loncom/homework/essayresponse.pm 2010/08/28 22:25:07 1.111
+++ loncom/homework/essayresponse.pm 2025/02/26 00:11:38 1.127
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# essay (ungraded) style responses
#
-# $Id: essayresponse.pm,v 1.111 2010/08/28 22:25:07 raeburn Exp $
+# $Id: essayresponse.pm,v 1.127 2025/02/26 00:11:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -47,93 +47,120 @@ sub start_essayresponse {
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
+ } elsif ($target eq 'web') {
+ my $part= $Apache::inputtags::part;
+ my $coll;
+ if ($Apache::lonhomework::history{"resource.$part.$id.collaborators"} =~ /\S/) {
+ $coll = &HTML::Entities::encode($Apache::lonhomework::history{"resource.$part.$id.collaborators"},'<>&"');
+ }
+ if ($Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
+ my $ncol= &Apache::lonnet::EXT("resource.$part".'_'."$id.maxcollaborators");
+ 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
+ }
+ my $hiddendraft;
+ if (($Apache::lonhomework::type eq 'survey') ||
+ ($Apache::lonhomework::type eq 'surveycred') ||
+ ($Apache::lonhomework::type eq 'anonsurvey') ||
+ ($Apache::lonhomework::type eq 'anonsurveycred')) {
+ $hiddendraft = '<input type="hidden" name="HWDRAFT'.$part.'_'.$id.'" value="yes" />';
+ } else {
+ $result = &draft_row($part,$id,$ncol,$uploadedfiletypes,'essayresponse');
+ }
+ if ($ncol > 0) {
+ $result .= &get_collab_row($part,$id,$coll,$ncol);
+ }
+ 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);
+ if ($result) {
+ $result =
+ '<div>'.$hiddendraft.
+ &Apache::lonhtmlcommon::start_pick_box().
+ $result.
+ &Apache::lonhtmlcommon::end_pick_box().'</div>';
+ } else {
+ $result = $hiddendraft;
+ }
+ } else {
+ $result = &show_status_table($part,$id,$coll);
}
- 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" />';
- }
- my $status_text = &mt('Submission type');
- if ($Apache::lonhomework::history{"resource.$part.award"} eq 'DRAFT') {
- $status_text .= '<br />'.&mt('(Currently -- draft)');
- }
- $result.= '<p>'.&Apache::lonhtmlcommon::start_pick_box().
- &Apache::lonhtmlcommon::row_title($status_text);
- if (($Apache::lonhomework::type ne 'survey') &&
- ($Apache::lonhomework::type ne 'surveycred') &&
- ($Apache::lonhomework::type ne 'anonsurvey') &&
- ($Apache::lonhomework::type ne 'anonsurveycred')) {
- my $closure;
- unless ($ncol || $uploadedfiletypes) {
- $closure = 1;
- }
- $result.=
- '<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>'.
- &Apache::lonhtmlcommon::row_closure($closure);
- }
+ }
+ return $result;
+}
- if ($ncol > 0) {
- $result.= &Apache::lonhtmlcommon::row_title(&mt('Collaborators')).
- '<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 .= &Apache::lonhtmlcommon::row_closure();
- }
- 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.=&Apache::lonhtmlcommon::end_pick_box().'</p>';
- } 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>';
- }
+sub draft_row {
+ my ($part,$id,$ncol,$uploadedfiletypes,$resptype) = @_;
+ my $status_text = &mt('Submission type');
+ if ($Apache::lonhomework::history{"resource.$part.award"} eq 'DRAFT') {
+ $status_text .= '<br />'.&mt('(Currently -- draft)');
+ }
+ my $closure;
+ unless ($ncol || $uploadedfiletypes) {
+ $closure = 1;
+ }
+ my %label = (
+ draft => {
+ essayresponse => &mt('Save entries below (not submitted for credit yet)'),
+ externalresponse => &mt('Save entries below (not submitted for grading yet)'),
+ },
+ submit => {
+ essayresponse => &mt('Submit entries below as answer to receive credit'),
+ externalresponse => &mt('Submit entries below for grading'),
+ }
+ );
+ return &Apache::lonhtmlcommon::row_title($status_text).
+ '<fieldset class="LC_landmark">'.
+ '<legend class="LC_visually_hidden">'.$status_text.'</legend>'.
+ '<div><label><input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="yes" checked="checked" />'.
+ ' '.$label{'submit'}{$resptype}.'</label></div>'.
+ '<div><label>'.
+ '<input type="radio" name="HWDRAFT'.$part.'_'.$id.'" value="no" /> '.
+ $label{'draft'}{$resptype}.'</label></div></fieldset>'.
+ &Apache::lonhtmlcommon::row_closure($closure);
+}
- my $current_files_display = &Apache::inputtags::current_file_submissions($part,$id);
- if ($current_files_display) {
- $result .= '<td><b>'.&mt('Submitted files:').'</b><br />'.
- $current_files_display.'</td>';
- }
+sub get_collab_row {
+ my ($part,$id,$coll,$ncol,$closure) = @_;
+ my $output = &Apache::lonhtmlcommon::row_title(&mt('Collaborators')).
+ '<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) {
+ $output .= '<br />'.&mt('If entering more than one, use spaces to separate the collaborators.');
+ }
+ $output .= '</label><br />';
+ $output .= &check_collaborators($ncol,$coll) if ($coll =~ /\w+/);
+ $output .= &Apache::lonhtmlcommon::row_closure($closure);
+ return $output;
+}
- if ($result ne '') {
- $result =
- '<table class="LC_pastsubmission"><tr>'.$result.
- '</tr></table>';
- }
+sub show_status_table {
+ my ($part,$id,$coll) = @_;
+ my $output;
+ if ($coll) {
+ $output = '<td><i>'.&mt('Collaborated with [_1]',$coll).'</i></td>';
}
- return $result;
+ my $current_files_display = &Apache::inputtags::current_file_submissions($part,$id);
+ if ($current_files_display) {
+ $output .= '<td><b>'.&mt('Submitted files:').'</b><br />'.
+ $current_files_display.'</td>';
+ }
+ if ($output ne '') {
+ return '<table class="LC_pastsubmission"><tr>'.$output.
+ '</tr></table>';
+ }
+ return;
}
sub end_essayresponse {
@@ -143,13 +170,7 @@ sub end_essayresponse {
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;
- }
+ &get_collaborators($part,$id);
# Scantron
if ( &Apache::response::submitted('scantron') ) {
$increment=&Apache::response::scored_response($part,$id);
@@ -206,16 +227,30 @@ sub end_essayresponse {
&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);
- }
+ if ($essayurl eq 'lib/templates/simpleproblem.problem') {
+ my %crsinfo = &Apache::lonnet::coursedescription($crsid);
+ my $cdom = $crsinfo{'domain'};
+ my $cnum = $crsinfo{'num'};
+ my ($map,$id,$res) = &Apache::lonnet::decode_symb($symb);
+ if ($map =~ m{^\Quploaded/$cdom/$cnum/\E(default(?:|_\d+)\.(?:sequence|page))$}) {
+ my $apath = $1.'_'.$id;
+ $apath=~s/\W/\_/gs;
+ my $akey = join('.',&escape($name),&escape($domain));
+ &Apache::lonnet::put('nohist_essay_'.$apath,
+ { $akey => $response },$cdom,$cnum);
+ }
+ } else {
+ 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();
@@ -251,6 +286,16 @@ sub end_essayresponse {
return $result;
}
+sub get_collaborators {
+ my ($part,$id) = @_;
+ 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::lonhomework::results{"resource.$part.$id.collaborators"}=$collaborators;
+ }
+}
+
sub format_prior_response {
my ($mode,$answer,$other_data) = @_;
my $output;
@@ -275,14 +320,14 @@ sub format_prior_response {
}
if ($answer =~ /\S/) {
$output.='<p>'.&mt('Submitted text').
- '<blockquote>'.$answer.'</blockquote></p>';
+ '<blockquote>'.&HTML::Entities::encode($answer, '"<>&').'</blockquote></p>';
}
return '<div class="LC_prior_essay">'.$output.'</div>';
}
sub file_submission {
- my ($part,$id,$award,$uploadedflag,$totalsize,$deletions)=@_;
+ my ($part,$id,$award,$uploadedflag,$totalsize,$deletions,$context,$info)=@_;
my $files;
my $jspart=$part;
$jspart=~s/\./_/g;
@@ -297,7 +342,14 @@ sub file_submission {
if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"} ||
$Apache::lonhomework::history{"resource.$part.$id.uploadedurl"}) {
if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"}) {
- @portfiles = split(/,/,$Apache::lonhomework::history{"resource.$part.$id.portfiles"});
+ my @possfiles = split(/,/,$Apache::lonhomework::history{"resource.$part.$id.portfiles"});
+ foreach my $file (@possfiles) {
+ my ($path,$name) = ($file =~ m{^(.*/)([^/]+)$});
+ my ($origname,$version,$ext) = &Apache::lonnet::file_name_version_ext($name);
+ unless ($version) {
+ push(@portfiles,$file);
+ }
+ }
}
$uploadedurl = $Apache::lonhomework::history{"resource.$part.$id.uploadedurl"};
if (ref($deletions) eq 'ARRAY') {
@@ -308,6 +360,8 @@ sub file_submission {
$port_delete{$file} = 1;
} elsif ($file =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/essayresponse/\Q$cdom\E/\Q$cnum\E/}) {
$uploaded_delete = $file;
+ } elsif ($file =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/essayresponse/[^/]+$}) {
+ $uploaded_delete = $file;
}
}
}
@@ -318,8 +372,12 @@ sub file_submission {
}
}
if ($uploaded_delete) {
- $Apache::lonhomework::results{"resource.$part.$id.uploadedfile"} = "";
- $Apache::lonhomework::results{"resource.$part.$id.uploadedurl"} = "";
+ if ($uploaded_delete eq $uploadedurl) {
+ $Apache::lonhomework::results{"resource.$part.$id.uploadedfile"} = "";
+ $Apache::lonhomework::results{"resource.$part.$id.uploadedurl"} = "";
+ } else {
+ undef($uploaded_delete);
+ }
}
}
if ($env{'form.HWPORT'.$jspart.'_'.$id} ne '') {
@@ -387,8 +445,11 @@ sub file_submission {
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;
+ my ($listref,$listerror) =
+ &Apache::lonnet::dirlist($fullpath,$udom,$uname,1);
+ if (ref($listref) eq 'ARRAY') {
+ $dirlist{$fullpath} = $listref;
+ }
}
if (ref($dirlist{$fullpath}) eq 'ARRAY') {
foreach my $dir_line (@{$dirlist{$fullpath}}) {
@@ -431,81 +492,58 @@ sub file_submission {
}
}
if ($accepted_upload ne '') {
- my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
- 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 $restitle=&Apache::lonnet::gettitle($symb);
- $restitle =~ s/\W+/_/g;
- 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 ($path,$multiresp) =
+ &Apache::loncommon::get_turnedin_filepath($symb,$uname,$udom,
+ 'submission');
+ if ($path eq '') {
+ $$award = 'INTERNAL_ERROR';
+ } else {
+ if ($multiresp) {
+ $path .= '/'.$jspart.'_'.$id;
+ }
+ my $prefix = 'portfolio';
+ my $formelement = 'HWFILE'.$jspart.'_'.$id;
+ my $fname = &Apache::lonnet::clean_filename($env{'form.'.$formelement.'.filename'});
+ my $url = '/uploaded/'.$udom.'/'.$uname.'/'.$prefix.$path.'/'.$fname;
+ my @stat = &Apache::lonnet::stat_file($url);
+ my $conflicts = 0;
+ if (@stat && $stat[0] ne 'no_such_dir') {
+ my $current_permissions =
+ &Apache::lonnet::get_portfile_permissions($udom,$uname);
+ if (ref($current_permissions) eq 'HASH') {
+ if (ref($current_permissions->{$path.'/'.$fname}) eq 'ARRAY') {
+ foreach my $record (@{$current_permissions->{$path.'/'.$fname}}) {
+ if (ref($record) eq 'ARRAY') {
+ next if (($record->[0] eq $symb) &&
+ ($record->[1] eq $crsid));
+ $conflicts ++;
+ }
}
}
}
- my $maptitle = $mapres->compTitle();
- $maptitle =~ s/\W+/_/g;
- if ($maptitle ne '') {
- push(@pathitems,$maptitle);
+ if ($conflicts) {
+ $$award = 'FILENAME_INUSE';
}
- } else {
- $$award = 'INTERNAL_ERROR';
}
- } else {
- $$award = 'INTERNAL_ERROR';
- }
- push(@pathitems,$restitle);
- $path .= join('/',@pathitems);
- my $formelement = 'HWFILE'.$jspart.'_'.$id;
- my $fname = &Apache::lonnet::clean_filename($env{'form.'.$formelement.'.filename'});
- 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,'',
+ unless ($conflicts) {
+ my ($mode,%allfiles,%codebase);
+ my $result = &Apache::lonnet::userfileupload($formelement,'',
$prefix.$path,$mode,\%allfiles,\%codebase);
- if ($result =~ m{^/uploaded/}) {
- $stored_upload = $path.'/'.$fname;
- $Apache::lonhomework::results{"resource.$part.$id.portfiles"} = $stored_upload;
- push(@tolock,$stored_upload);
- } else {
- $$award = 'INTERNAL_ERROR';
+ if ($result =~ m{^/uploaded/}) {
+ $stored_upload = $path.'/'.$fname;
+ unless (grep(/^\Q$stored_upload\E$/,@accepted_portfiles)) {
+ $Apache::lonhomework::results{"resource.$part.$id.portfiles"} = $stored_upload;
+ push(@tolock,$stored_upload);
+ }
+ } else {
+ $$award = 'INTERNAL_ERROR';
+ }
}
}
delete($env{'form.HWFILE'.$jspart.'_'.$id});
}
if (@accepted_portfiles) {
- if ($stored_upload) {
+ if ($Apache::lonhomework::results{"resource.$part.$id.portfiles"}) {
$Apache::lonhomework::results{"resource.$part.$id.portfiles"} .= ',';
}
$Apache::lonhomework::results{"resource.$part.$id.portfiles"}.=join(',',@accepted_portfiles);
@@ -516,11 +554,27 @@ sub file_submission {
$Apache::lonhomework::results{"resource.$part.$id.portfiles"} = "";
}
}
- if ($Apache::lonhomework::history{"resource.$part.$id.portfiles"} ne $Apache::lonhomework::results{"resource.$part.$id.portfiles"}) {
+ if (($Apache::lonhomework::history{"resource.$part.$id.portfiles"} ne
+ $Apache::lonhomework::results{"resource.$part.$id.portfiles"}) ||
+ ($uploaded_delete)) {
if (ref($uploadedflag)) {
$$uploadedflag=1;
}
}
+ if ($context eq 'externalresponse') {
+ my @todelete = map { "/uploaded/$udom/$uname/portfolio".$_; } keys(%port_delete);
+ if (@tolock || @todelete) {
+ if (ref($info) eq 'HASH') {
+ if (($info->{'ip'}) && ($info->{'is_submit'})) {
+ my @adds;
+ if (@tolock) {
+ @adds = map { "/uploaded/$udom/$uname/portfolio".$_; } @tolock;
+ }
+ &Apache::lonnet::automated_portfile_access('ip',\@adds,\@todelete,$info);
+ }
+ }
+ }
+ }
&Apache::lonnet::unmark_as_readonly($udom,$uname,[$symb,$crsid]);
&Apache::lonnet::mark_as_readonly($udom,$uname,[@tolock],[$symb,$crsid]);
&Apache::lonnet::clear_selected_files($uname);
@@ -604,8 +658,16 @@ described at http://www.lon-capa.org.
=item start_essayresponse()
+=item draft_row()
+
+=item get_collab_row()
+
+=item show_status_table()
+
=item end_essayresponse()
+=item get_collaborators()
+
=item format_prior_response()
=item file_submission()