Verifying Submission Receipt '. - $receipt.'
'."\n". - 'Resource: '.$env{'form.probTitle'}.''."\n"; + my $title = + '
'. + &mt('Verifying Receipt Number [_1]',$receipt). + '
'."\n"; my ($string,$contents,$matches) = ('','',0); my (undef,undef,$fullname) = &getclasslist('all','0'); my $receiptparts=0; - if ($env{"course.$courseid.receiptalg"} eq 'receipt2') { $receiptparts=1; } + if ($env{"course.$courseid.receiptalg"} eq 'receipt2' || + $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } my $parts=['0']; - if ($receiptparts) { ($parts)=&response_type($url,$symb); } + if ($receiptparts) { + my $res_error; + ($parts)=&response_type($symb,\$res_error); + if ($res_error) { + return &navmap_errormsg(); + } + } + + my $header = + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + '' + .&mt('No match found for the above receipt number.') + .'
'; } else { - $string = &jscriptNform($url,$symb).$title. - 'The above receipt matches the following student'. - ($matches <= 1 ? '.' : 's.')."\n". - ''."\n".
- '
|
'. + &mt('The above receipt number matches the following [quant,_1,student].',$matches). + '
'. + $header. + $contents. + &Apache::loncommon::end_data_table()."\n"; } - return $string.&show_grading_menu_form($symb,$url); + return $string; } #--- This is called by a number of programs. @@ -594,25 +1039,38 @@ sub verifyreceipt { #--- Also called directly when one clicks on the subm button # on the problem page. sub listStudents { - my ($request) = shift; + my ($request,$symb,$submitonly,$divforres) = @_; - my ($symb,$url) = &get_symb_and_url($request); + my $is_tool = ($symb =~ /ext\.tool$/); my $cdom = $env{"course.$env{'request.course.id'}.domain"}; my $cnum = $env{"course.$env{'request.course.id'}.num"}; my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; - my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; - - my $viewgrade = $env{'form.showgrading'} eq 'yes' ? 'View/Grade/Regrade' : 'View'; - $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? - &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; - - my $result=''.$viewgrade. - ' Submissions for a Student or a Group of Students
'; - - my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($url,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); + my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; + unless ($submitonly) { + $submitonly = $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; + } + + my $result=''; + my $res_error; + my ($partlist,$handgrade,$responseType,$numresp,$numessay) = &response_type($symb,\$res_error); + + my $table; + if (ref($partlist) eq 'ARRAY') { + if (scalar(@$partlist) > 1 ) { + $table = &showResourceInfo($symb,$partlist,$responseType,'gradesub',1); + } elsif ($divforres) { + $table = ''; + } else { + $table = ''; + } + } - $request->print(<
There are no students currently enrolled.'; + $gradeTable='
'.&mt('There are no students currently enrolled.').''; } else { my $submissions='submissions'; if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } - $gradeTable='
'. - 'No '.$submissions.' found for this resource for any students. ('.$num_students. - ' students checked for '.$submissions.')
'; + if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } + $gradeTable='
'. + &mt('No '.$submissions.' found for this resource for any students. ([quant,_1,student] checked for '.$submissions.')', + $num_students). + '
'; } } elsif ($ctr == 1) { - $gradeTable =~ s/type=checkbox/type=checkbox checked/; + $gradeTable =~ s/type="checkbox"/type="checkbox" checked="checked"/; } - $gradeTable.=&show_grading_menu_form($symb,$url); $request->print($gradeTable); return ''; } @@ -813,8 +1383,8 @@ LISTJAVASCRIPT #---- Called from the listStudents routine sub check_script { - my ($form, $type)=@_; - my $chkallscript=''."\n"; +'."\n"); return $chkallscript; } sub check_buttons { - my $buttons.=''; - $buttons.=' '; - $buttons.=''; + my $buttons.=''; + $buttons.=' '; + $buttons.=''; $buttons.=' '; return $buttons; } # Displays the submissions for one student or a group of students sub processGroup { - my ($request) = shift; + my ($request,$symb) = @_; my $ctr = 0; my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); my $total = scalar(@stuchecked)-1; - foreach (@stuchecked) { - my ($uname,$udom,$fullname) = split(/:/); + foreach my $student (@stuchecked) { + my ($uname,$udom,$fullname) = split(/:/,$student); $env{'form.student'} = $uname; $env{'form.userdom'} = $udom; $env{'form.fullname'} = $fullname; - &submission($request,$ctr,$total); + &submission($request,$ctr,$total,$symb); $ctr++; } return ''; @@ -883,8 +1453,9 @@ sub processGroup { #--- Javascript to handle the submission page functionality --- sub sub_page_js { my $request = shift; - $request->print(<
.
- '/check.gif){kind=small}
';
-
+ my $checkIcon = '.'/check.gif').'){kind=small}
';
my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname);
- my $wgtmsg = ($wgt > 0 ? '(problem weight)' :
- 'problem weight assigned by computer');
+ my $wgtmsg = ($wgt > 0) ? &mt('(problem weight)')
+ : ''.&mt('problem weight assigned by computer').'';
$wgt = ($wgt > 0 ? $wgt : '1');
my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ?
- '' : $$record{'resource.'.$partid.'.awarded'}*$wgt);
- my $result=''."\n";
-
- my $display_part=&get_display_part($partid,undef,$symb);
-
+ '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt));
+ my $data_WGT=''."\n";
+ my $display_part= &get_display_part($partid,$symb);
my %last_resets = &get_last_resets($symb,$env{'request.course.id'},
[$partid]);
my $aggtries = $$record{'resource.'.$partid.'.tries'};
if ($last_resets{$partid}) {
$aggtries = &get_num_tries($record,$last_resets{$partid},$partid);
}
-
- $result.='| '. - 'Part: '.$display_part.' Points: | '."\n";
-
+ my $result=&Apache::loncommon::start_data_table_row();
my $ctr = 0;
- $result.='
| or | '."\n"; - $result.=''."\n"; - $result.=' | /'.$wgt.' '.$wgtmsg. + $line.=' | /'.$wgt.' '.$wgtmsg. ($$record{'resource.'.$partid.'.solved'} eq 'correct_by_student' ? ' '.$checkIcon : ''). - ' | '."\n"; - - $result.=' | '."\n"; + $line.=''."\n"; - $result.=" \n"; + $line.=''."\n"; + + + $result .= + ' | '.$data_WGT.$display_part.' | '.$radio.' | '.&mt('or').' | '.$line.' | '; + $result.=&Apache::loncommon::end_data_table_row(); + $result.=&Apache::loncommon::start_data_table_row().''; $result.=''."\n". ''."\n". ''."\n". ''."\n"; - $result.=' | |||||||
'."\n"; + } + } + if ($file_counter) { + $result .= ''."\n". + ''. + '('.&mt('File(s) will be uploaded when you click on Save & Next below.',$file_counter).')
'; + } + } + return $result; +} + sub show_problem { - my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode) = @_; + my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode,$form) = @_; my $rendered; + my %form = ((ref($form) eq 'HASH')? %{$form} : ()); + &Apache::lonxml::remember_problem_counter(); if ($mode eq 'both' or $mode eq 'text') { $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, - $env{'request.course.id'}); + $env{'request.course.id'}, + undef,\%form); } if ($removeform) { $rendered=~s|
';
- $result.='
|
'; return $result; } +sub files_exist { + my ($r, $symb) = @_; + my @students = &Apache::loncommon::get_env_multiple('form.stuinfo'); + foreach my $student (@students) { + my ($uname,$udom,$fullname) = split(/:/,$student); + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'}, + $udom,$uname); + my ($string,$timestamp)= &get_last_submission(\%record); + foreach my $submission (@$string) { + my ($partid,$respid) = + ($submission =~ /^resource\.([^\.]*)\.([^\.]*)\.submission/); + my $files=&get_submitted_files($udom,$uname,$partid,$respid, + \%record); + return 1 if (@$files); + } + } + return 0; +} + +sub download_all_link { + my ($r,$symb) = @_; + unless (&files_exist($r, $symb)) { + $r->print(&mt('There are currently no submitted documents.')); + return; + } + my $all_students = + join("\n", &Apache::loncommon::get_env_multiple('form.stuinfo')); + + my $parts = + join("\n",&Apache::loncommon::get_env_multiple('form.vPart')); + + my $identifier = &Apache::loncommon::get_cgi_id(); + &Apache::lonnet::appenv({'cgi.'.$identifier.'.students' => $all_students, + 'cgi.'.$identifier.'.symb' => $symb, + 'cgi.'.$identifier.'.parts' => $parts,}); + $r->print(''. + &mt('Download All Submitted Documents').''); + return; +} + +sub submit_download_link { + my ($request,$symb) = @_; + if (!$symb) { return ''; } + my $res_error; + my ($partlist,$handgrade,$responseType,$numresp,$numessay,$numdropbox) = + &response_type($symb,\$res_error); + if ($res_error) { + $request->print(&mt('An error occurred retrieving response types')); + return; + } + unless ($numessay) { + $request->print(&mt('No essayresponse items found')); + return; + } + my @chosenparts = &Apache::loncommon::get_env_multiple('form.vPart'); + if (@chosenparts) { + $request->print(&showResourceInfo($symb,$partlist,$responseType, + undef,undef,1)); + } + if ($numessay) { + my $submitonly= $env{'form.submitonly'} eq '' ? 'all' : $env{'form.submitonly'}; + my $getsec = $env{'form.section'} eq '' ? 'all' : $env{'form.section'}; + my $getgroup = $env{'form.group'} eq '' ? 'all' : $env{'form.group'}; + (undef,undef,my $fullname) = &getclasslist($getsec,1,$getgroup,$symb,$submitonly,1); + if (ref($fullname) eq 'HASH') { + my @students = map { $_.':'.$fullname->{$_} } (keys(%{$fullname})); + if (@students) { + @{$env{'form.stuinfo'}} = @students; + if ($numdropbox) { + &download_all_link($request,$symb); + } else { + $request->print(&mt('No essayrespose items with dropbox found')); + } +# FIXME Need a mechanism to download essays, i.e., if $numessay > $numdropbox +# Needs to omit user's identity if resource instance is for an anonymous survey. + } else { + $request->print(&mt('No students match the criteria you selected')); + } + } else { + $request->print(&mt('Could not retrieve student information')); + } + } else { + $request->print(&mt('No essayresponse items found')); + } + return; +} + +sub build_section_inputs { + my $section_inputs; + if ($env{'form.section'} eq '') { + $section_inputs .= ''."\n"; + } else { + my @sections = &Apache::loncommon::get_env_multiple('form.section'); + foreach my $section (@sections) { + $section_inputs .= ''."\n"; + } + } + return $section_inputs; +} + # --------------------------- show submissions of a student, option to grade sub submission { - my ($request,$counter,$total) = @_; - - (my $url=$env{'form.url'})=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; + my ($request,$counter,$total,$symb,$divforres,$calledby) = @_; my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'}); $udom = ($udom eq '' ? $env{'user.domain'} : $udom); #has form.userdom changed for a student? my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'}); $env{'form.fullname'} = &Apache::loncommon::plainname($uname,$udom,'lastname') if $env{'form.fullname'} eq ''; - my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))); - if ($symb eq '') { $request->print("Unable to handle ambiguous references:$url:."); return ''; } + if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; } + my $probtitle=&Apache::lonnet::gettitle($symb); + my $is_tool = ($symb =~ /ext\.tool$/); + my ($essayurl,%coursedesc_by_cid); if (!&canview($usec)) { - $request->print('Unable to view requested student.('. - $uname.'@'.$udom.' in section '.$usec.' in course id '. - $env{'request.course.id'}.')'); - $request->print(&show_grading_menu_form($symb,$url)); + $request->print( + ''. + &mt('Unable to view requested student.'). + ' '.&mt('([_1] in section [_2] in course id [_3])', + $uname.':'.$udom,$usec,$env{'request.course.id'}). + ''); return; } + my $res_error; + my ($partlist,$handgrade,$responseType,$numresp,$numessay) = + &response_type($symb,\$res_error); + if ($res_error) { + $request->print(&navmap_errormsg()); + return; + } + if (!$env{'form.lastSub'}) { $env{'form.lastSub'} = 'datesub'; } - if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; } - if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; } + unless ($is_tool) { + if (!$env{'form.vProb'}) { $env{'form.vProb'} = 'yes'; } + if (!$env{'form.vAns'}) { $env{'form.vAns'} = 'yes'; } + } + if (($numessay) && ($calledby eq 'submission') && (!exists($env{'form.compmsg'}))) { + $env{'form.compmsg'} = 1; + } my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); - my $checkIcon = '
'); + } &sub_page_js($request); - &sub_page_kw_js($request) if ($env{'form.handgrade'} eq 'yes'); - $env{'form.probTitle'} = $env{'form.probTitle'} eq '' ? - &Apache::lonnet::gettitle($symb) : $env{'form.probTitle'}; - - $request->print('
Submission Record
'."\n". - ' Resource: '.$env{'form.probTitle'}.''."\n"); - - if ($env{'form.handgrade'} eq 'no') { - my $checkMark='Note: Part(s) graded correct by the computer is marked with a '. - $checkIcon.' symbol.'."\n"; - $request->print($checkMark); - } + &sub_grademessage_js($request) if ($env{'form.compmsg'}); + &sub_page_kw_js($request) if ($numessay); # option to display problem, only once else it cause problems # with the form later since the problem has a form. @@ -1534,61 +2368,61 @@ sub submission { } elsif ($env{'form.vAns'} eq 'yes') { $mode='answer'; } + &Apache::lonxml::clear_problem_counter(); $request->print(&show_problem($request,$symb,$uname,$udom,0,1,$mode)); } - - # kwclr is the only variable that is guaranteed to be non blank - # if this subroutine has been called once. + my %keyhash = (); - if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') { + if (($env{'form.kwclr'} eq '' && $numessay) || ($env{'form.compmsg'})) { %keyhash = &Apache::lonnet::dump('nohist_handgrade', $env{'course.'.$env{'request.course.id'}.'.domain'}, $env{'course.'.$env{'request.course.id'}.'.num'}); - + } + # kwclr is the only variable that is guaranteed not to be blank + # if this subroutine has been called once. + if ($env{'form.kwclr'} eq '' && $numessay) { my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; $env{'form.keywords'} = $keyhash{$symb.'_keywords'} ne '' ? $keyhash{$symb.'_keywords'} : ''; $env{'form.kwclr'} = $keyhash{$loginuser.'_kwclr'} ne '' ? $keyhash{$loginuser.'_kwclr'} : 'red'; $env{'form.kwsize'} = $keyhash{$loginuser.'_kwsize'} ne '' ? $keyhash{$loginuser.'_kwsize'} : '0'; $env{'form.kwstyle'} = $keyhash{$loginuser.'_kwstyle'} ne '' ? $keyhash{$loginuser.'_kwstyle'} : ''; - $env{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? - $keyhash{$symb.'_subject'} : $env{'form.probTitle'}; + } + if ($env{'form.compmsg'}) { + $env{'form.msgsub'} = $keyhash{$symb.'_subject'} ne '' ? + $keyhash{$symb.'_subject'} : $probtitle; $env{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; } - my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'}; - $request->print(''; $request->print($endform); } return ''; } +sub check_collaborators { + my ($symb,$uname,$udom,$record,$handgrade,$counter) = @_; + my ($result,@col_fullnames); + my ($classlist,undef,$fullname) = &getclasslist('all','0'); + foreach my $part (keys(%$handgrade)) { + my $ncol = &Apache::lonnet::EXT('resource.'.$part. + '.maxcollaborators', + $symb,$udom,$uname); + next if ($ncol <= 0); + $part =~ s/\_/\./g; + next if ($record->{'resource.'.$part.'.collaborators'} eq ''); + my (@good_collaborators, @bad_collaborators); + foreach my $possible_collaborator + (split(/[,;\s]+/,$record->{'resource.'.$part.'.collaborators'})) { + $possible_collaborator =~ s/[\$\^\(\)]//g; + next if ($possible_collaborator eq ''); + my ($co_name,$co_dom) = split(/:/,$possible_collaborator); + $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i); + next if ($co_name eq $uname && $co_dom eq $udom); + # Doing this grep allows 'fuzzy' specification + my @matches = grep(/^\Q$co_name\E:\Q$co_dom\E$/i, + keys(%$classlist)); + if (! scalar(@matches)) { + push(@bad_collaborators, $possible_collaborator); + } else { + push(@good_collaborators, @matches); + } + } + if (scalar(@good_collaborators) != 0) { + $result.='
'.&mt('Collaborators:').'
- ';
+ foreach my $name (@good_collaborators) {
+ my ($lastname,$givenn) = split(/,/,$$fullname{$name});
+ push(@col_fullnames, $givenn.' '.$lastname);
+ $result.='
- '.$fullname->{$name}.' '; + } + $result.='
'."\n"; + my ($part)=split(/\./,$part); + $result.=''. + "\n"; + } + if (scalar(@bad_collaborators) > 0) { + $result.='
';
+ $result.=&mt('This student has submitted [quant,_1,invalid collaborator]: [_2]',scalar(@bad_collaborators),join(', ',@bad_collaborators));
+ $result .= '
';
+ }
+ if (scalar(@bad_collaborators > $ncol)) {
+ $result .= '';
+ $result .= &mt('This student has submitted too many '.
+ 'collaborators. Maximum is [_1].',$ncol);
+ $result .= '
';
+ }
+ }
+ return ($result,$fullname,\@col_fullnames);
+}
+
#--- Retrieve the last submission for all the parts
sub get_last_submission {
- my ($returnhash)=@_;
- my (@string,$timestamp);
+ my ($returnhash,$is_tool)=@_;
+ my (@string,$timestamp,%lasthidden);
if ($$returnhash{'version'}) {
my %lasthash=();
my ($version);
for ($version=1;$version<=$$returnhash{'version'};$version++) {
- foreach (sort(split(/\:/,$$returnhash{$version.':keys'}))) {
- $lasthash{$_}=$$returnhash{$version.':'.$_};
- $timestamp = scalar(localtime($$returnhash{$version.':timestamp'}));
- }
- }
- foreach ((keys %lasthash)) {
- if ($_ =~ /\.submission$/) {
- my ($partid,$foo) = split(/submission$/,$_);
- my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ?
- 'Draft Copy ' : '';
- push @string, (join(':',$_,$draft.$lasthash{$_}));
- }
+ foreach my $key (sort(split(/\:/,
+ $$returnhash{$version.':keys'}))) {
+ $lasthash{$key}=$$returnhash{$version.':'.$key};
+ $timestamp =
+ &Apache::lonlocal::locallocaltime($$returnhash{$version.':timestamp'});
+ }
+ }
+ my (%typeparts,%randombytry);
+ my $showsurv =
+ &Apache::lonnet::allowed('vas',$env{'request.course.id'});
+ foreach my $key (sort(keys(%lasthash))) {
+ if ($key =~ /\.type$/) {
+ if (($lasthash{$key} eq 'anonsurvey') ||
+ ($lasthash{$key} eq 'anonsurveycred') ||
+ ($lasthash{$key} eq 'randomizetry')) {
+ my ($ign,@parts) = split(/\./,$key);
+ pop(@parts);
+ my $id = join('.',@parts);
+ if ($lasthash{$key} eq 'randomizetry') {
+ $randombytry{$ign.'.'.$id} = $lasthash{$key};
+ } else {
+ unless ($showsurv) {
+ $typeparts{$ign.'.'.$id} = $lasthash{$key};
+ }
+ }
+ delete($lasthash{$key});
+ }
+ }
+ }
+ my @hidden = keys(%typeparts);
+ my @randomize = keys(%randombytry);
+ foreach my $key (keys(%lasthash)) {
+ next if ($key !~ /\.submission$/);
+ my $hide;
+ if (@hidden) {
+ foreach my $id (@hidden) {
+ if ($key =~ /^\Q$id\E/) {
+ $hide = 'anon';
+ last;
+ }
+ }
+ }
+ unless ($hide) {
+ if (@randomize) {
+ foreach my $id (@randomize) {
+ if ($key =~ /^\Q$id\E/) {
+ $hide = 'rand';
+ last;
+ }
+ }
+ }
+ }
+ my ($partid,$foo) = split(/submission$/,$key);
+ my $draft = $lasthash{$partid.'awarddetail'} eq 'DRAFT' ? 1 : 0;
+ push(@string, join(':', $key, $hide, $draft, (
+ ref($lasthash{$key}) eq 'ARRAY' ?
+ join(',', @{$lasthash{$key}}) : $lasthash{$key}) ));
}
}
- @string = $string[0] eq '' ? 'Nothing submitted - no attempts.' : @string;
- return \@string,\$timestamp;
+ if (!@string) {
+ my $msg;
+ if ($is_tool) {
+ $msg = &mt('No grade passed back.');
+ } else {
+ $msg = &mt('Nothing submitted - no attempts.');
+ }
+ $string[0] =
+ ''.$msg.'';
+ }
+ return (\@string,\$timestamp);
}
#--- High light keywords, with style choosen by user.
@@ -1946,39 +2987,256 @@ sub keywords_highlight {
my $styleon = $env{'form.kwstyle'} eq '' ? '' : $env{'form.kwstyle'};
(my $styleoff = $styleon) =~ s/\$styleon$_$styleoff<\/font>/gi;
+ foreach my $keyword (@keylist) {
+ $string =~ s/\b\Q$keyword\E(\b|\.)/$styleon$keyword$styleoff<\/font>/gi;
}
return $string;
}
+# For Tasks provide a mechanism to display previous version for one specific student
+
+sub show_previous_task_version {
+ my ($request,$symb) = @_;
+ if ($symb eq '') {
+ $request->print(
+ ''.
+ &mt('Unable to handle ambiguous references.').
+ '');
+ return '';
+ }
+ my ($uname,$udom) = ($env{'form.student'},$env{'form.userdom'});
+ my $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
+ if (!&canview($usec)) {
+ $request->print(
+ ''.
+ &mt('Unable to view previous version for requested student.').
+ ' '.&mt('([_1] in section [_2] in course id [_3])',
+ $uname.':'.$udom,$usec,$env{'request.course.id'}).
+ '');
+ return;
+ }
+ my $mode = 'both';
+ my $isTask = ($symb =~/\.task$/);
+ if ($isTask) {
+ if ($env{'form.previousversion'} =~ /^\d+$/) {
+ if ($env{'form.fullname'} eq '') {
+ $env{'form.fullname'} =
+ &Apache::loncommon::plainname($uname,$udom,'lastname');
+ }
+ my $probtitle=&Apache::lonnet::gettitle($symb);
+ $request->print("\n\n".
+ ''.
+ '
");
+ }
+ }
+ return;
+}
+
+sub choose_task_version_form {
+ my ($symb,$uname,$udom,$nomenu) = @_;
+ my $isTask = ($symb =~/\.task$/);
+ my ($current,$version,$result,$js,$displayed,$rowtitle);
+ if ($isTask) {
+ my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},
+ $udom,$uname);
+ if (($record{'resource.0.version'} eq '') ||
+ ($record{'resource.0.version'} < 2)) {
+ return ($record{'resource.0.version'},
+ $record{'resource.0.version'},$result,$js);
+ } else {
+ $current = $record{'resource.0.version'};
+ }
+ if ($env{'form.previousversion'}) {
+ $displayed = $env{'form.previousversion'};
+ $rowtitle = &mt('Choose another version:')
+ } else {
+ $displayed = $current;
+ $rowtitle = &mt('Show earlier version:');
+ }
+ $result = ''.&nameUserString(undef,$env{'form.fullname'},$uname,$udom). + '
'."\n"); + &Apache::lonxml::clear_problem_counter(); + $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode, + {'previousversion' => $env{'form.previousversion'} })); + $request->print("\n';
+ my $list;
+ my $numversions = 0;
+ for (my $i=1; $i<=$record{'resource.0.version'}; $i++) {
+ if ($i == $current) {
+ if (!$env{'form.previousversion'} || $nomenu) {
+ next;
+ } else {
+ $list .= ''."\n";
+ $numversions ++;
+ }
+ } elsif (defined($record{'resource.'.$i.'.0.status'})) {
+ unless ($i == $env{'form.previousversion'}) {
+ $numversions ++;
+ }
+ $list .= ''."\n";
+ }
+ }
+ if ($numversions) {
+ $symb = &HTML::Entities::encode($symb,'<>"&');
+ $result .=
+ '';
+ $js = &previous_display_javascript($nomenu,$current);
+ } elsif ($displayed && $nomenu) {
+ $result .= ''.&mt('Close window').'';
+ } else {
+ $result .= &mt('No previous versions to show for this student');
+ }
+ $result .= '
';
+ }
+ return ($current,$displayed,$result,$js);
+}
+
+sub previous_display_javascript {
+ my ($nomenu,$current) = @_;
+ my $js = <<"JSONE";
+
+ENDJS
+
+}
+
#--- Called from submission routine
sub processHandGrade {
- my ($request) = shift;
- my $url = $env{'form.url'};
- my $symb = $env{'form.symb'};
+ my ($request,$symb) = @_;
+ my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb);
my $button = $env{'form.gradeOpt'};
my $ngrade = $env{'form.NCT'};
my $ntstu = $env{'form.NTSTU'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my ($res_error,%queueable);
+ my ($partlist,$handgrade,$responseType,$numresp,$numessay) = &response_type($symb,\$res_error);
+ if ($res_error) {
+ $request->print(&navmap_errormsg());
+ return;
+ } else {
+ foreach my $part (@{$partlist}) {
+ if (ref($responseType->{$part}) eq 'HASH') {
+ foreach my $id (keys(%{$responseType->{$part}})) {
+ if (($responseType->{$part}->{$id} eq 'essay') ||
+ (lc($handgrade->{$part.'_'.$id}) eq 'yes')) {
+ $queueable{$part} = 1;
+ last;
+ }
+ }
+ }
+ }
+ }
+
if ($button eq 'Save & Next') {
my $ctr = 0;
while ($ctr < $ngrade) {
my ($uname,$udom) = split(/:/,$env{'form.unamedom'.$ctr});
- my ($errorflag,$pts,$wgt) = &saveHandGrade($request,$url,$symb,$uname,$udom,$ctr);
+ my ($errorflag,$pts,$wgt,$numhidden) =
+ &saveHandGrade($request,$symb,$uname,$udom,$ctr,undef,undef,\%queueable);
if ($errorflag eq 'no_score') {
$ctr++;
next;
}
if ($errorflag eq 'not_allowed') {
- $request->print("Not allowed to modify grades for $uname:$udom");
+ $request->print(
+ ''
+ .&mt('Not allowed to modify grades for [_1]',"$uname:$udom")
+ .'');
$ctr++;
next;
}
+ if ($numhidden) {
+ $request->print(
+ ''
+ .&mt('For [_1]: [quant,_2,transaction] hidden',"$uname:$udom",$numhidden)
+ .''); + } my $includemsg = $env{'form.includemsg'.$ctr}; my ($subject,$message,$msgstatus) = ('','',''); + my $restitle = &Apache::lonnet::gettitle($symb); + my ($feedurl,$showsymb) = + &get_feedurl_and_symb($symb,$uname,$udom); + my $messagetail; if ($includemsg =~ /savemsg|newmsg\Q$ctr\E/) { $subject = $env{'form.msgsub'} if ($includemsg =~ /msgsub/); unless ($subject=~/\w/) { $subject=&mt('Grading Feedback'); } + $subject.=' ['.$restitle.']'; my (@msgnum) = split(/,/,$includemsg); foreach (@msgnum) { $message.=$env{'form.'.$_} if ($_ =~ /savemsg|newmsg/ && $_ ne ''); @@ -1986,32 +3244,39 @@ sub processHandGrade { $message =&Apache::lonfeedback::clear_out_html($message); if ($env{'form.withgrades'.$ctr}) { $message.="\n\nPoint".($pts > 1 ? 's':'').' awarded = '.$pts.' out of '.$wgt; - $message.=" for $env{'form.probTitle'}"; - } - $msgstatus = &Apache::lonmsg::user_normal_msg ($uname,$udom, - $subject.' ['. - &Apache::lonnet::declutter($url).']',$message); - $request->print('
'.&mt('Sending message to [_1]@[_2]',$uname,$udom).': '. - $msgstatus); + $messagetail = " for $restitle"; + } + $msgstatus = + &Apache::lonmsg::user_normal_msg($uname,$udom,$subject, + $message.$messagetail, + undef,$feedurl,undef, + undef,undef,$showsymb, + $restitle); + $request->print('
'.&mt('Sending message to [_1]',$uname.':'.$udom).': '. + $msgstatus.'
'); } if ($env{'form.collaborator'.$ctr}) { my @collabstrs=&Apache::loncommon::get_env_multiple("form.collaborator$ctr"); foreach my $collabstr (@collabstrs) { my ($part,@collaborators) = split(/:/,$collabstr); - foreach (@collaborators) { + foreach my $collaborator (@collaborators) { my ($errorflag,$pts,$wgt) = - &saveHandGrade($request,$url,$symb,$_,$udom,$ctr, - $env{'form.unamedom'.$ctr},$part); + &saveHandGrade($request,$symb,$collaborator,$udom,$ctr, + $env{'form.unamedom'.$ctr},$part,\%queueable); if ($errorflag eq 'not_allowed') { - $request->print("Not allowed to modify grades for $_:$udom"); + $request->print("".&mt('Not allowed to modify grades for [_1]',"$collaborator:$udom").""); next; - } else { - if ($message ne '') { - $msgstatus = &Apache::lonmsg::user_normal_msg($_,$udom,$env{'form.msgsub'},$message); + } elsif ($message ne '') { + my ($baseurl,$showsymb) = + &get_feedurl_and_symb($symb,$collaborator, + $udom); + if ($env{'form.withgrades'.$ctr}) { + $messagetail = " for $restitle"; } - + $msgstatus = + &Apache::lonmsg::user_normal_msg($collaborator,$udom,$subject,$message.$messagetail,undef,$baseurl,undef,undef,undef,$showsymb,$restitle); } } } @@ -2020,12 +3285,12 @@ sub processHandGrade { } } - if ($env{'form.handgrade'} eq 'yes') { + my %keyhash = (); + if ($numessay) { # Keywords sorted in alphabatical order my $loginuser = $env{'user.name'}.':'.$env{'user.domain'}; - my %keyhash = (); $env{'form.keywords'} =~ s/,\s{0,}|\s+/ /g; - $env{'form.keywords'} =~ s/^\s+|\s+$//; + $env{'form.keywords'} =~ s/^\s+|\s+$//g; my (@keywords) = sort(split(/\s+/,$env{'form.keywords'})); $env{'form.keywords'} = join(' ',@keywords); $keyhash{$symb.'_keywords'} = $env{'form.keywords'}; @@ -2033,7 +3298,9 @@ sub processHandGrade { $keyhash{$loginuser.'_kwclr'} = $env{'form.kwclr'}; $keyhash{$loginuser.'_kwsize'} = $env{'form.kwsize'}; $keyhash{$loginuser.'_kwstyle'} = $env{'form.kwstyle'}; + } + if ($env{'form.compmsg'}) { # message center - Order of message gets changed. Blank line is eliminated. # New messages are saved in env for the next student. # All messages are saved in nohist_handgrade.db @@ -2048,19 +3315,20 @@ sub processHandGrade { $ctr = 0; while ($ctr < $ngrade) { if ($env{'form.newmsg'.$ctr} ne '') { - $keyhash{$symb.'_savemsg'.$idx} = $env{'form.newmsg'.$ctr}; - $env{'form.savemsg'.$idx} = $env{'form.newmsg'.$ctr}; - $idx++; + $keyhash{$symb.'_savemsg'.$idx} = $env{'form.newmsg'.$ctr}; + $env{'form.savemsg'.$idx} = $env{'form.newmsg'.$ctr}; + $idx++; } $ctr++; } $env{'form.savemsgN'} = --$idx; $keyhash{$symb.'_savemsgN'} = $env{'form.savemsgN'}; - my $putresult = &Apache::lonnet::put - ('nohist_handgrade',\%keyhash, - $env{'course.'.$env{'request.course.id'}.'.domain'}, - $env{'course.'.$env{'request.course.id'}.'.num'}); } + if (($numessay) || ($env{'form.compmsg'})) { + my $putresult = &Apache::lonnet::put + ('nohist_handgrade',\%keyhash,$cdom,$cnum); + } + # Called by Save & Refresh from Highlight Attribute Window my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1'); if ($env{'form.refresh'} eq 'on') { @@ -2075,22 +3343,12 @@ sub processHandGrade { my $processUser = $env{'form.unamedom'.$ctr}; ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser); $env{'form.fullname'} = $$fullname{$processUser}; - &submission($request,$ctr,$total-1); + &submission($request,$ctr,$total-1,$symb); $ctr++; } return ''; } -# Go directly to grade student - from submission or link from chart page - if ($button eq 'Grade Student') { - (undef,undef,$env{'form.handgrade'},undef,undef) = &showResourceInfo($url); - my $processUser = $env{'form.unamedom'.$env{'form.studentNo'}}; - ($env{'form.student'},$env{'form.userdom'}) = split(/:/,$processUser); - $env{'form.fullname'} = $$fullname{$processUser}; - &submission($request,0,0); - return ''; - } - # Get the next/previous one or group of students my $firststu = $env{'form.unamedom0'}; my $laststu = $env{'form.unamedom'.($ngrade-1)}; @@ -2103,7 +3361,7 @@ sub processHandGrade { my (@parsedlist,@nextlist); my ($nextflg) = 0; - foreach (sort + foreach my $item (sort { if (lc($$fullname{$a}) ne lc($$fullname{$b})) { return (lc($$fullname{$a}) cmp lc($$fullname{$b})); @@ -2111,31 +3369,38 @@ sub processHandGrade { return $a cmp $b; } (keys(%$fullname))) { if ($nextflg == 1 && $button =~ /Next$/) { - push @parsedlist,$_; + push(@parsedlist,$item); } - $nextflg = 1 if ($_ eq $laststu); + $nextflg = 1 if ($item eq $laststu); if ($button eq 'Previous') { - last if ($_ eq $firststu); - push @parsedlist,$_; + last if ($item eq $firststu); + push(@parsedlist,$item); } } $ctr = 0; @parsedlist = reverse @parsedlist if ($button eq 'Previous'); - my ($partlist) = &response_type($url); foreach my $student (@parsedlist) { my $submitonly=$env{'form.submitonly'}; my ($uname,$udom) = split(/:/,$student); + + if ($submitonly eq 'queued') { + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + next if (!defined($queue_status{'gradingqueue'})); + } + if ($submitonly =~ /^(yes|graded|incorrect)$/) { # my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); - my %status=&student_gradeStatus($url,$symb,$udom,$uname,$partlist); + my %status=&student_gradeStatus($symb,$udom,$uname,$partlist); my $submitted = 0; my $ungraded = 0; my $incorrect = 0; - foreach (keys(%status)) { - $submitted = 1 if ($status{$_} ne 'nothing'); - $ungraded = 1 if ($status{$_} =~ /^ungraded/); - $incorrect = 1 if ($status{$_} =~ /^incorrect/); - my ($foo,$partid,$foo1) = split(/\./,$_); + foreach my $item (keys(%status)) { + $submitted = 1 if ($status{$item} ne 'nothing'); + $ungraded = 1 if ($status{$item} =~ /^ungraded/); + $incorrect = 1 if ($status{$item} =~ /^incorrect/); + my ($foo,$partid,$foo1) = split(/\./,$item); if ($status{'resource.'.$partid.'.submitted_by'} ne '') { $submitted = 0; } @@ -2146,7 +3411,7 @@ sub processHandGrade { next if (!$ungraded && ($submitonly eq 'graded')); next if (!$incorrect && $submitonly eq 'incorrect'); } - push @nextlist,$student if ($ctr < $ntstu); + push(@nextlist,$student) if ($ctr < $ntstu); last if ($ctr == $ntstu); $ctr++; } @@ -2154,19 +3419,16 @@ sub processHandGrade { $ctr = 0; my $total = scalar(@nextlist)-1; - foreach (sort @nextlist) { + foreach (sort(@nextlist)) { my ($uname,$udom,$submitter) = split(/:/); $env{'form.student'} = $uname; $env{'form.userdom'} = $udom; $env{'form.fullname'} = $$fullname{$_}; - &submission($request,$ctr,$total); + &submission($request,$ctr,$total,$symb); $ctr++; } if ($total < 0) { - my $the_end = '
LON-CAPA User Message
'."\n"; - $the_end.='Message: No more students for this section or class.
'."\n"; - $the_end.='Click on the button below to return to the grading menu.
'."\n"; - $the_end.=&show_grading_menu_form ($symb,$url); + my $the_end.='
'.&mt('[_1]Message:[_2] No more students for this section or class.','','').'
'."\n"; $request->print($the_end); } return ''; @@ -2174,19 +3436,25 @@ sub processHandGrade { #---- Save the score and award for each student, if changed sub saveHandGrade { - my ($request,$url,$symb,$stuname,$domain,$newflg,$submitter,$part) = @_; - my @v_flag; + my ($request,$symb,$stuname,$domain,$newflg,$submitter,$part,$queueable) = @_; + my @version_parts; my $usec = &Apache::lonnet::getsection($domain,$stuname, $env{'request.course.id'}); if (!&canmodify($usec)) { return('not_allowed'); } - my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname); + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$domain,$stuname); my @parts_graded; my %newrecord = (); - my ($pts,$wgt) = ('',''); + my ($pts,$wgt,$totchg) = ('','',0); my %aggregate = (); my $aggregateflag = 0; - foreach my $new_part (split(/:/,$env{'form.partlist'.$newflg})) { - #collaborator may vary for different parts + if ($env{'form.HIDE'.$newflg}) { + my ($version,$parts) = split(/:/,$env{'form.HIDE'.$newflg},2); + my $numchgs = &makehidden($version,$parts,\%record,$symb,$domain,$stuname,1); + $totchg += $numchgs; + } + my @parts = split(/:/,$env{'form.partlist'.$newflg}); + foreach my $new_part (@parts) { + #collaborator ($submi may vary for different parts if ($submitter && $new_part ne $part) { next; } my $dropMenu = $env{'form.GD_SEL'.$newflg.'_'.$new_part}; if ($dropMenu eq 'excused') { @@ -2195,11 +3463,11 @@ sub saveHandGrade { if (exists($record{'resource.'.$new_part.'.awarded'})) { $newrecord{'resource.'.$new_part.'.awarded'} = ''; } - $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; + $newrecord{'resource.'.$new_part.'.regrader'}="$env{'user.name'}:$env{'user.domain'}"; } } elsif ($dropMenu eq 'reset status' && exists($record{'resource.'.$new_part.'.solved'})) { #don't bother if no old records -> no attempts - foreach my $key (keys (%record)) { + foreach my $key (keys(%record)) { if ($key=~/^resource\.\Q$new_part\E\./) { $newrecord{$key} = ''; } } $newrecord{'resource.'.$new_part.'.regrader'}= @@ -2216,7 +3484,7 @@ sub saveHandGrade { my $solvedstatus = $record{'resource.'.$new_part.'.solved'}; if ($aggtries > 0) { - &decrement($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); + &decrement_aggs($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus); $aggregateflag = 1; } } elsif ($dropMenu eq '') { @@ -2231,9 +3499,10 @@ sub saveHandGrade { my $partial= $pts/$wgt; if ($partial eq $record{'resource.'.$new_part.'.awarded'}) { #do not update score for part if not changed. + &handback_files($request,$symb,$stuname,$domain,$newflg,$new_part,\%newrecord); next; } else { - push @parts_graded, $new_part; + push(@parts_graded,$new_part); } if ($record{'resource.'.$new_part.'.awarded'} ne $partial) { $newrecord{'resource.'.$new_part.'.awarded'} = $partial; @@ -2256,23 +3525,199 @@ sub saveHandGrade { "$env{'user.name'}:$env{'user.domain'}"; } # unless problem has been graded, set flag to version the submitted files - unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ || $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override') { - push (@v_flag,$new_part); + unless ($record{'resource.'.$new_part.'.solved'} =~ /^correct_/ || + $record{'resource.'.$new_part.'.solved'} eq 'incorrect_by_override' || + $dropMenu eq 'reset status') + { + push(@version_parts,$new_part); } } - if (scalar(keys(%newrecord)) > 0) { - if (scalar(@v_flag)) { - &version_portfiles(\%record, \@parts_graded, $env{'request.course.id'}, $symb, $domain, $stuname, \@v_flag); + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + + if (%newrecord) { + if (@version_parts) { + my @changed_keys = &version_portfiles(\%record, \@parts_graded, + $env{'request.course.id'}, $symb, $domain, $stuname, \@version_parts); + @newrecord{@changed_keys} = @record{@changed_keys}; + foreach my $new_part (@version_parts) { + &handback_files($request,$symb,$stuname,$domain,$newflg, + $new_part,\%newrecord); + } } &Apache::lonnet::cstore(\%newrecord,$symb, $env{'request.course.id'},$domain,$stuname); + &check_and_remove_from_queue(\@parts,\%record,\%newrecord,$symb, + $cdom,$cnum,$domain,$stuname,$queueable); } if ($aggregateflag) { &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate, - $env{'course.'.$env{'request.course.id'}.'.domain'}, - $env{'course.'.$env{'request.course.id'}.'.num'}); + $cdom,$cnum); } - return '',$pts,$wgt; + return ('',$pts,$wgt,$totchg); +} + +sub makehidden { + my ($version,$parts,$record,$symb,$domain,$stuname,$tolog) = @_; + return unless (ref($record) eq 'HASH'); + my %modified; + my $numchanged = 0; + if (exists($record->{$version.':keys'})) { + my $partsregexp = $parts; + $partsregexp =~ s/,/|/g; + foreach my $key (split(/\:/,$record->{$version.':keys'})) { + if ($key =~ /^resource\.(?:$partsregexp)\.([^\.]+)$/) { + my $item = $1; + unless (($item eq 'solved') || ($item =~ /^award(|msg|ed)$/)) { + $modified{$key} = $record->{$version.':'.$key}; + } + } elsif ($key =~ m{^(resource\.(?:$partsregexp)\.[^\.]+\.)(.+)$}) { + $modified{$1.'hidden'.$2} = $record->{$version.':'.$key}; + } elsif ($key =~ /^(ip|timestamp|host)$/) { + $modified{$key} = $record->{$version.':'.$key}; + } + } + if (keys(%modified)) { + if (&Apache::lonnet::putstore($env{'request.course.id'},$symb,$version,\%modified, + $domain,$stuname,$tolog) eq 'ok') { + $numchanged ++; + } + } + } + return $numchanged; +} + +sub check_and_remove_from_queue { + my ($parts,$record,$newrecord,$symb,$cdom,$cnum,$domain,$stuname,$queueable) = @_; + my @ungraded_parts; + foreach my $part (@{$parts}) { + if ( $record->{ 'resource.'.$part.'.awarded'} eq '' + && $record->{ 'resource.'.$part.'.solved' } ne 'excused' + && $newrecord->{'resource.'.$part.'.awarded'} eq '' + && $newrecord->{'resource.'.$part.'.solved' } ne 'excused' + ) { + if ($queueable->{$part}) { + push(@ungraded_parts, $part); + } + } + } + if ( !@ungraded_parts ) { + &Apache::bridgetask::remove_from_queue('gradingqueue',$symb,$cdom, + $cnum,$domain,$stuname); + } +} + +sub handback_files { + my ($request,$symb,$stuname,$domain,$newflg,$new_part,$newrecord) = @_; + my $portfolio_root = '/userfiles/portfolio'; + my $res_error; + my ($partlist,$handgrade,$responseType) = &response_type($symb,\$res_error); + if ($res_error) { + $request->print(''.&navmap_errormsg().'
'); + return; + } + my @handedback; + my $file_msg; + my @part_response_id = &flatten_responseType($responseType); + foreach my $part_response_id (@part_response_id) { + my ($part_id,$resp_id) = @{ $part_response_id }; + my $part_resp = join('_',@{ $part_response_id }); + if (($env{'form.'.$newflg.'_'.$part_resp.'_countreturndoc'} =~ /^\d+$/) & ($new_part eq $part_id)) { + for (my $counter=1; $counter<=$env{'form.'.$newflg.'_'.$part_resp.'_countreturndoc'}; $counter++) { + # if multiple files are uploaded names will be 'returndoc2','returndoc3' + if ($env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter}) { + my $fname=$env{'form.'.$newflg.'_'.$part_resp.'_returndoc'.$counter.'.filename'}; + my ($directory,$answer_file) = + ($env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter} =~ /^(.*?)([^\/]*)$/); + my ($answer_name,$answer_ver,$answer_ext) = + &Apache::lonnet::file_name_version_ext($answer_file); + my ($portfolio_path) = ($directory =~ /^.+$stuname\/portfolio(.*)/); + my $getpropath = 1; + my ($dir_list,$listerror) = + &Apache::lonnet::dirlist($portfolio_root.$portfolio_path, + $domain,$stuname,$getpropath); + my $version = &Apache::lonnet::get_next_version($answer_name,$answer_ext,$dir_list); + # fix filename + my ($save_file_name) = (($directory.$answer_name.".$version.".$answer_ext) =~ /^.+\/${stuname}\/(.*)/); + my $result=&Apache::lonnet::finishuserfileupload($stuname,$domain, + $newflg.'_'.$part_resp.'_returndoc'.$counter, + $save_file_name); + if ($result !~ m|^/uploaded/|) { + $request->print('
'. + &mt('An error occurred ([_1]) while trying to upload [_2].', + $result,$newflg.'_'.$part_resp.'_returndoc'.$counter). + ''); + } else { + # mark the file as read only + push(@handedback,$save_file_name); + if (exists($$newrecord{"resource.$new_part.$resp_id.handback"})) { + $$newrecord{"resource.$new_part.$resp_id.handback"}.=','; + } + $$newrecord{"resource.$new_part.$resp_id.handback"} .= $save_file_name; + $file_msg.= ''.$save_file_name."
"; + } + $request->print('
'.&mt('[_1] will be the uploaded filename [_2]',''.$fname.'',''.$env{'form.'.$newflg.'_'.$part_resp.'_origdoc'.$counter}.'')); + } + } + } + } + if (@handedback > 0) { + $request->print('
'); + my @what = ($symb,$env{'request.course.id'},'handback'); + &Apache::lonnet::mark_as_readonly($domain,$stuname,\@handedback,\@what); + my $user_lh = &Apache::loncommon::user_lang($stuname,$domain,$env{'request.course.id'}); + my ($subject,$message); + if (scalar(@handedback) == 1) { + $subject = &mt_user($user_lh,'File Handed Back by Instructor'); + $message = &mt_user($user_lh,'A file has been returned that was originally submitted in response to: '); + } else { + $subject = &mt_user($user_lh,'Files Handed Back by Instructor'); + $message = &mt_user($user_lh,'Files have been returned that were originally submitted in response to: '); + } + $message .= "
".&Apache::lonnet::gettitle($symb)."
"; + $message .= &mt_user($user_lh,'The returned file(s) are named: [_1]',"$file_msg
"). + &mt_user($user_lh,'The file(s) can be found in your [_1]portfolio[_2].','',''); + my ($feedurl,$showsymb) = + &get_feedurl_and_symb($symb,$domain,$stuname); + my $restitle = &Apache::lonnet::gettitle($symb); + $subject .= ' '.&mt_user($user_lh,'(File Returned)').' ['.$restitle.']'; + my $msgstatus = + &Apache::lonmsg::user_normal_msg($stuname,$domain,$subject, + $message,undef,$feedurl,undef,undef,undef,$showsymb, + $restitle); + if ($msgstatus) { + $request->print(&mt('Notification message status: [_1]',''.$msgstatus.'').'
'); + } + } + return; +} + +sub get_feedurl_and_symb { + my ($symb,$uname,$udom) = @_; + my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); + $url = &Apache::lonnet::clutter($url); + my $encrypturl=&Apache::lonnet::EXT('resource.0.encrypturl', + $symb,$udom,$uname); + if ($encrypturl =~ /^yes$/i) { + &Apache::lonenc::encrypted(\$url,1); + &Apache::lonenc::encrypted(\$symb,1); + } + return ($url,$symb); +} + +sub get_submitted_files { + my ($udom,$uname,$partid,$respid,$record) = @_; + my @files; + if ($$record{"resource.$partid.$respid.portfiles"}) { + my $file_url = '/uploaded/'.$udom.'/'.$uname.'/portfolio'; + foreach my $file (split(',',$$record{"resource.$partid.$respid.portfiles"})) { + push(@files,$file_url.$file); + } + } + if ($$record{"resource.$partid.$respid.uploadedurl"}) { + push(@files,$$record{"resource.$partid.$respid.uploadedurl"}); + } + return (\@files); } # ----------- Provides number of tries since last reset. @@ -2310,7 +3755,7 @@ sub decrement_aggs { if ($aggtries == $totaltries) { $decrement{'users'} = 1; } - foreach my $type (keys (%decrement)) { + foreach my $type (keys(%decrement)) { $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type}; } return; @@ -2336,58 +3781,24 @@ sub get_last_resets { # ----------- Handles creating versions for portfolio files as answers sub version_portfiles { - my ($record, $parts_graded, $courseid, $symb, $domain, $stuname, $v_flag) = @_; + my ($record, $parts_graded, $courseid, $symb, $domain, $stu_name, $v_flag) = @_; my $version_parts = join('|',@$v_flag); + my @returned_keys; my $parts = join('|', @$parts_graded); - my $portfolio_root = &Apache::loncommon::propath($domain, - $stuname). - '/userfiles/portfolio'; foreach my $key (keys(%$record)) { my $new_portfiles; - if ($key =~ /^resource\.($version_parts)\./ && $key =~ /\.portfiles$/ ) { - my @v_portfiles; - my @portfiles = split(/,/,$$record{$key}); - &Apache::lonnet::logthis("should be unmarking and remarking $key",@portfiles); - foreach my $file (@portfiles) { - &Apache::lonnet::unmark_as_readonly($domain,$stuname,[$symb,$env{'request.course.id'}],$file); - my ($directory,$answer_file) =($file =~ /^(.*?)([^\/]*$)/); - my $version = 0; - my @answer_file_parts = split(/\./, $answer_file); - my @dir_list = &Apache::lonnet::dirlist($directory,$domain,$stuname,$portfolio_root); - my @file_names; - my @file_name_parts; - foreach my $row (@dir_list) { - @file_names = split(/\&/,$row,2); - @file_name_parts = split(/\./, $file_names[0]); - # ($file_name_parts[scalar @file_name_parts] eq $answer_file_parts[scalar @answer_file_parts]) - if (($file_name_parts[0] eq $answer_file_parts[0]) && - ($file_name_parts[-1] eq $answer_file_parts[-1])) { - # gets here if filename and extension match, regardless of version - if (scalar @file_name_parts == 3) { # a versioned file is found - # so save it for later - if ($file_name_parts[1] > $version) {$version = $file_name_parts[1]}; - } - } - } - $version++; - $env{'form.copy'} = &Apache::lonnet::getfile("/uploaded/$domain/$stuname/portfolio$directory$answer_file"); - if($env{'form.copy'} eq '-1') { - &Apache::lonnet::logthis('problem getting file '.$directory.$answer_file); - } else { - my $copy_result = &Apache::lonnet::finishuserfileupload($stuname,$domain,'copy', - '/portfolio'.$directory.$answer_file_parts[0].'.'.$version.'.'.$answer_file_parts[-1]); - push(@v_portfiles, $directory.$answer_file_parts[0].'.'.$version.'.'.$answer_file_parts[-1]); - &Apache::lonnet::mark_as_readonly($domain,$stuname, - ['/portfolio'.$directory.$answer_file_parts[0].'.'.$version.'.'.$answer_file_parts[-1]], - [$symb,$env{'request.course.id'},'graded']); - } + my @versioned_portfiles; + my @portfiles = split(/\s*,\s*/,$$record{$key}); + if (@portfiles) { + &Apache::lonnet::portfiles_versioning($symb,$domain,$stu_name,\@portfiles, + \@versioned_portfiles); } - $$record{$key} = join(',',@v_portfiles); + $$record{$key} = join(',',@versioned_portfiles); + push(@returned_keys,$key); } } - return 'ok'; - + return (@returned_keys); } #-------------------------------------------------------------------------------------- @@ -2398,15 +3809,16 @@ sub version_portfiles { sub viewgrades_js { my ($request) = shift; - $request->print(<