--- loncom/homework/grades.pm 2003/04/04 23:35:17 1.83 +++ loncom/homework/grades.pm 2006/03/19 21:38:55 1.336 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.83 2003/04/04 23:35:17 albertel Exp $ +# $Id: grades.pm,v 1.336 2006/03/19 21:38:55 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,15 +25,6 @@ # # http://www.lon-capa.org/ # -# 2/9,2/13 Guy Albertelli -# 6/8 Gerd Kortemeyer -# 7/26 H.K. Ng -# 8/20 Gerd Kortemeyer -# Year 2002 -# June-August H.K. Ng -# Year 2003 -# February, March H.K. Ng -# package Apache::grades; use strict; @@ -41,153 +32,440 @@ use Apache::style; use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; +use Apache::lonhtmlcommon; use Apache::lonnavmaps; use Apache::lonhomework; use Apache::loncoursedata; use Apache::lonmsg qw(:user_normal_msg); use Apache::Constants qw(:common); +use Apache::lonlocal; +use String::Similarity; +use POSIX qw(floor); + +my %oldessays=(); +my %perm=(); # ----- These first few routines are general use routines.---- # -# --- Retrieve the parts that matches stores_\d+ from the metadata file.--- +# --- Retrieve the parts from the metadata file.--- sub getpartlist { - my ($url) = @_; - my @parts =(); - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); - foreach my $key (@metakeys) { - if ( $key =~ m/stores_(\w+)_.*/) { - push(@parts,$key); + my ($symb) = @_; + my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); + my $partorder = &Apache::lonnet::metadata($url, 'partorder'); + my @parts; + if ($partorder) { + for my $part (split (/,/,$partorder)) { + if (!&Apache::loncommon::check_if_partid_hidden($part,$symb)) { + push(@parts, $part); + } + } + } else { + my $metadata = &Apache::lonnet::metadata($url, 'packages'); + foreach (split(/\,/,$metadata)) { + if ($_ =~ /^part_(.*)$/) { + if (!&Apache::loncommon::check_if_partid_hidden($1,$symb)) { + push(@parts, $1); + } + } } } - return @parts; + my @stores; + foreach my $part (@parts) { + my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); + foreach my $key (@metakeys) { + if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } + } + } + return @stores; } # --- Get the symbolic name of a problem and the url -sub get_symb_and_url { - my ($request) = @_; - (my $url=$ENV{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; - 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 ''; } - return ($symb,$url); -} - -# --- Retrieve the fullname for a user. Return lastname, first middle --- -# --- Generation is attached next to the lastname if it exists. --- -sub get_fullname { - my ($uname,$udom) = @_; - my %name=&Apache::lonnet::get('environment', ['lastname','generation', - 'firstname','middlename'], - $udom,$uname); - my $fullname; - my ($tmp) = keys(%name); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $fullname = &Apache::loncoursedata::ProcessFullName - (@name{qw/lastname generation firstname middlename/}); +sub get_symb { + my ($request,$silent) = @_; + (my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; + my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))); + if ($symb eq '') { + if (!$silent) { + $request->print("Unable to handle ambiguous references:$url:."); + return (); + } + } + return ($symb); +} + +#--- Format fullname, username:domain if different for display +#--- Use anywhere where the student names are listed +sub nameUserString { + my ($type,$fullname,$uname,$udom) = @_; + if ($type eq 'header') { + return ' Fullname (Username)'; } else { - &Apache::lonnet::logthis('grades.pm: no name data for '.$uname. - '@'.$udom.':'.$tmp); + return ' '.$fullname.' ('.$uname. + ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; } - return $fullname; } #--- Get the partlist and the response type for a given problem. --- #--- Indicate if a response type is coded handgraded or not. --- sub response_type { - my ($url) = shift; + my ($symb) = shift; + my (undef,undef,$url) = &Apache::lonnet::decode_symb($symb); my $allkeys = &Apache::lonnet::metadata($url,'keys'); + my %vPart; + foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { + $vPart{$partid}=1; + } my %seen = (); - my (@partlist,%handgrade); + my (@partlist,%handgrade,%responseType); foreach (split(/,/,&Apache::lonnet::metadata($url,'packages'))) { - if (/^\w+response_\w+.*/) { + if (/^\w+response_.*/ || /^Task_/) { my ($responsetype,$part) = split(/_/,$_,2); my ($partid,$respid) = split(/_/,$part); - $handgrade{$part} = $responsetype.':'.($allkeys =~ /parameter_$part\_handgrade/ ? 'yes' : 'no'); + if ($responsetype eq 'Task') { $respid='0'; } + if (&Apache::loncommon::check_if_partid_hidden($partid,$symb)) { + next; + } + if (%vPart && !exists($vPart{$partid})) { + next; + } + $responsetype =~ s/response$//; # make it compatible w/ navmaps - should move to that!! + my ($value) = &Apache::lonnet::EXT('resource.'.$part.'.handgrade',$symb); + $handgrade{$part} = ($value eq 'yes' ? 'yes' : 'no'); + if (!exists($responseType{$partid})) { $responseType{$partid}={}; } + $responseType{$partid}->{$respid}=$responsetype; next if ($seen{$partid} > 0); $seen{$partid}++; push @partlist,$partid; } } - return \@partlist,\%handgrade; + return (\@partlist,\%handgrade,\%responseType); +} + +sub get_display_part { + my ($partID,$symb)=@_; + my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); + if (defined($display) and $display ne '') { + $display.= " (id $partID)"; + } else { + $display=$partID; + } + return $display; +} + +#--- Show resource title +#--- and parts and response type +sub showResourceInfo { + my ($symb,$probTitle,$checkboxes) = @_; + my $col=3; + if ($checkboxes) { $col=4; } + my $result =''. + ''."\n"; + my ($partlist,$handgrade,$responseType) = &response_type($symb); + my %resptype = (); + my $hdgrade='no'; + my %partsseen; + for my $part_resID (sort keys(%$handgrade)) { + my $handgrade=$$handgrade{$part_resID}; + my ($partID,$resID) = split(/_/,$part_resID); + my $responsetype = $responseType->{$partID}->{$resID}; + $hdgrade = $handgrade if ($handgrade eq 'yes'); + $result.=''; + if ($checkboxes) { + if (exists($partsseen{$partID})) { + $result.=""; + } else { + $result.=""; + } + $partsseen{$partID}=1; + } + my $display_part=&get_display_part($partID,$symb); + $result.=''. + ''; +# ''; + } + $result.='
'.&mt('Current Resource').': '. + $probTitle.'
 Part: '.$display_part.' '. + $resID.'Type: '.$responsetype.'
Handgrade: '.$handgrade.'
'."\n"; + return $result,$responseType,$hdgrade,$partlist,$handgrade; +} + + +sub get_order { + my ($partid,$respid,$symb,$uname,$udom)=@_; + my (undef,undef,$url)=&Apache::lonnet::decode_symb($symb); + $url=&Apache::lonnet::clutter($url); + my $subresult=&Apache::lonnet::ssi($url, + ('grade_target' => 'analyze'), + ('grade_domain' => $udom), + ('grade_symb' => $symb), + ('grade_courseid' => + $env{'request.course.id'}), + ('grade_username' => $uname)); + (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); + my %analyze=&Apache::lonnet::str2hash($subresult); + return ($analyze{"$partid.$respid.shown"}); +} +#--- Clean response type for display +#--- Currently filters option/rank/radiobutton/match/essay/Task +# response types only. +sub cleanRecord { + my ($answer,$response,$symb,$partid,$respid,$record,$order,$version, + $uname,$udom) = @_; + my $grayFont = ''; + if ($response =~ /^(option|rank)$/) { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my ($toprow,$bottomrow); + foreach my $foil (@$order) { + if ($grading{$foil} == 1) { + $toprow.=''.$answer{$foil}.' '; + } else { + $toprow.=''.$answer{$foil}.' '; + } + $bottomrow.=''.$grayFont.$foil.' '; + } + return '
'. + ''.$toprow.''. + ''. + $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'; + } elsif ($response eq 'match') { + my %answer=&Apache::lonnet::str2hash($answer); + my %grading=&Apache::lonnet::str2hash($record->{$version."resource.$partid.$respid.submissiongrading"}); + my @items=&Apache::lonnet::str2array($record->{$version."resource.$partid.$respid.submissionitems"}); + my ($toprow,$middlerow,$bottomrow); + foreach my $foil (@$order) { + my $item=shift(@items); + if ($grading{$foil} == 1) { + $toprow.=''.$item.' '; + $middlerow.=''.$grayFont.$answer{$foil}.' '; + } else { + $toprow.=''.$item.' '; + $middlerow.=''.$grayFont.$answer{$foil}.' '; + } + $bottomrow.=''.$grayFont.$foil.' '; + } + return '
'. + ''.$toprow.''. + ''. + $middlerow.''. + ''. + $bottomrow.''.'
Answer
'.$grayFont.'Item ID
'.$grayFont.'Option ID
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my ($toprow,$bottomrow); + my $correct=($order->[0])+1; + for (my $i=1;$i<=$#$order;$i++) { + my $foil=$order->[$i]; + if (exists($answer{$foil})) { + if ($i == $correct) { + $toprow.='true'; + } else { + $toprow.='true'; + } + } else { + $toprow.='false'; + } + $bottomrow.=''.$grayFont.$foil.' '; + } + return '
'. + ''.$toprow.''. + ''. + $grayFont.$bottomrow.''.'
Answer
'.$grayFont.'Option ID
'; + } elsif ($response eq 'essay') { + if (! exists ($env{'form.'.$symb})) { + my (%keyhash) = &Apache::lonnet::dump('nohist_handgrade', + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + + 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.'.$symb} = 1; # so that we don't have to read it from disk for multiple sub of the same prob. + } + $answer =~ s-\n-
-g; + return '

'.&keywords_highlight($answer).'
'; + } elsif ( $response eq 'organic') { + my $result='Smile representation: "'.$answer.'"'; + my $jme=$record->{$version."resource.$partid.$respid.molecule"}; + $result.=&Apache::chemresponse::jme_img($jme,$answer,400); + return $result; + } elsif ( $response eq 'Task') { + if ( $answer eq 'SUBMITTED') { + my $files = $record->{$version."resource.$respid.$partid.bridgetask.portfiles"}; + my $result = &Apache::bridgetask::file_list($files,$uname,$udom); + return $result; + } elsif ( grep(/^\Q$version\E.*?\.instance$/, keys(%{$record})) ) { + my @matches = grep(/^\Q$version\E.*?\.instance$/, + keys(%{$record})); + return join('
',($version,@matches)); + + + } else { + my $result = + '

' + .&mt('Overall result: [_1]', + $record->{$version."resource.$respid.$partid.status"}) + .'

'; + + $result .= ''; + return $result; + } + + } + return $answer; +} + +#-- A couple of common js functions +sub commonJSfunctions { + my $request = shift; + $request->print(< + function radioSelection(radioButton) { + var selection=null; + if (radioButton.length > 1) { + for (var i=0; i 1) { + for (var i=0; i +COMMONJSFUNCTIONS } #--- Dumps the class list with usernames,list of sections, #--- section, ids and fullnames for each user. sub getclasslist { my ($getsec,$filterlist) = @_; + my @getsec; + if (!ref($getsec)) { + if ($getsec ne '' && $getsec ne 'all') { + @getsec=($getsec); + } + } else { + @getsec=@{$getsec}; + } + if (grep(/^all$/,@getsec)) { undef(@getsec); } + my $classlist=&Apache::loncoursedata::get_classlist(); # Bail out if we were unable to get the classlist return if (! defined($classlist)); # my %sections; my %fullnames; - foreach (keys(%$classlist)) { - # the following undefs are for 'domain', and 'username' respectively. - my (undef,undef,$end,$start,$id,$section,$fullname,$status)= - @{$classlist->{$_}}; + foreach my $student (keys(%$classlist)) { + my $end = + $classlist->{$student}->[&Apache::loncoursedata::CL_END()]; + my $start = + $classlist->{$student}->[&Apache::loncoursedata::CL_START()]; + my $id = + $classlist->{$student}->[&Apache::loncoursedata::CL_ID()]; + my $section = + $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + my $fullname = + $classlist->{$student}->[&Apache::loncoursedata::CL_FULLNAME()]; + my $status = + $classlist->{$student}->[&Apache::loncoursedata::CL_STATUS()]; # filter students according to status selected - if ($filterlist && $ENV{'form.status'} ne 'Any') { - if ($ENV{'form.status'} ne $status) { - delete ($classlist->{$_}); + if ($filterlist && $env{'form.Status'} ne 'Any') { + if ($env{'form.Status'} ne $status) { + delete ($classlist->{$student}); next; } } - $section = ($section ne '' ? $section : 'no'); - if ($getsec eq 'all' || $getsec eq $section) { - $sections{$section}++; - $fullnames{$_}=$fullname; - } else { - delete($classlist->{$_}); - } + $section = ($section ne '' ? $section : 'none'); + if (&canview($section)) { + if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { + $sections{$section}++; + $fullnames{$student}=$fullname; + } else { + delete($classlist->{$student}); + } + } else { + delete($classlist->{$student}); + } } my %seen = (); my @sections = sort(keys(%sections)); return ($classlist,\@sections,\%fullnames); } -#find user domain -sub finduser { - my ($name) = @_; - my $domain = ''; - if ( $Apache::grades::viewgrades eq 'F' ) { - my %classlist=&Apache::lonnet::dump('classlist', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - my (@fields) = grep /^$name:/, keys %classlist; - ($name, $domain) = split(/:/,$fields[0]); - return ($name,$domain); - } else { - return ($ENV{'user.name'},$ENV{'user.domain'}); +sub canmodify { + my ($sec)=@_; + if ($perm{'mgr'}) { + if (!defined($perm{'mgr_section'})) { + # can modify whole class + return 1; + } else { + if ($sec eq $perm{'mgr_section'}) { + #can modify the requested section + return 1; + } else { + # can't modify the request section + return 0; + } + } } + #can't modify + return 0; } -#--- Prompts a user to enter a username. -sub moreinfo { - my ($request,$reason) = @_; - $request->print("Unable to process request: $reason"); - if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print('
'."\n"); - if ($ENV{'form.url'}) { - $request->print(''."\n"); - } - if ($ENV{'form.symb'}) { - $request->print(''."\n"); - } - $request->print(''."\n"); - $request->print("Student:".''."
\n"); - $request->print("Domain:".''."
\n"); - $request->print(''."
\n"); - $request->print('
'); +sub canview { + my ($sec)=@_; + if ($perm{'vgr'}) { + if (!defined($perm{'vgr_section'})) { + # can modify whole class + return 1; + } else { + if ($sec eq $perm{'vgr_section'}) { + #can modify the requested section + return 1; + } else { + # can't modify the request section + return 0; + } + } } - return ''; + #can't modify + return 0; } #--- Retrieve the grade status of a student for all the parts sub student_gradeStatus { - my ($url,$symb,$udom,$uname,$partlist) = @_; - my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); + my ($symb,$udom,$uname,$partlist) = @_; + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); my %partstatus = (); foreach (@$partlist) { - my ($status,$foo) = split(/_/,$record{"resource.$_.solved"},2); + my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); $status = 'nothing' if ($status eq ''); $partstatus{$_} = $status; my $subkey = "resource.$_.submitted_by"; @@ -200,7 +478,7 @@ sub student_gradeStatus { # Use by verifyscript and viewgrades # Shows a student's view of problem and submission sub jscriptNform { - my ($url,$symb) = @_; + my ($symb) = @_; my $jscript=''."\n"; $jscript.= '
'."\n". ''."\n". - ''."\n". - ''."\n". - ''."\n". + ''."\n". + ''."\n". + ''."\n". ''."\n". ''."\n". ''."\n". @@ -220,7 +498,82 @@ sub jscriptNform { return $jscript; } +# Given the score (as a number [0-1] and the weight) what is the final +# point value? This function will round to the nearest tenth, third, +# or quarter if one of those is within the tolerance of .00001. +sub compute_points { + my ($score, $weight) = @_; + + my $tolerance = .00001; + my $points = $score * $weight; + + # Check for nearness to 1/x. + my $check_for_nearness = sub { + my ($factor) = @_; + my $num = ($points * $factor) + $tolerance; + my $floored_num = floor($num); + if ($num - $floored_num < 2 * $tolerance * $factor) { + return $floored_num / $factor; + } + return $points; + }; + + $points = $check_for_nearness->(10); + $points = $check_for_nearness->(3); + $points = $check_for_nearness->(4); + + return $points; +} + #------------------ End of general use routines -------------------- + +# +# Find most similar essay +# + +sub most_similar { + my ($uname,$udom,$uessay)=@_; + +# ignore spaces and punctuation + + $uessay=~s/\W+/ /gs; + +# ignore empty submissions (occuring when only files are sent) + + unless ($uessay=~/\w+/) { return ''; } + +# these will be returned. Do not care if not at least 50 percent similar + my $limit=0.6; + my $sname=''; + my $sdom=''; + my $scrsid=''; + my $sessay=''; +# go through all essays ... + foreach my $tkey (keys %oldessays) { + my ($tname,$tdom,$tcrsid)=split(/\./,$tkey); +# ... except the same student + if (($tname ne $uname) || ($tdom ne $udom)) { + my $tessay=$oldessays{$tkey}; + $tessay=~s/\W+/ /gs; +# String similarity gives up if not even limit + my $tsimilar=&String::Similarity::similarity($uessay,$tessay,$limit); +# Found one + if ($tsimilar>$limit) { + $limit=$tsimilar; + $sname=$tname; + $sdom=$tdom; + $scrsid=$tcrsid; + $sessay=$oldessays{$tkey}; + } + } + } + if ($limit>0.6) { + return ($sname,$sdom,$scrsid,$sessay,$limit); + } else { + return ('','','','',0); + } +} + #------------------------------------------------------------------- #------------------------------------ Receipt Verification Routines @@ -229,51 +582,65 @@ sub jscriptNform { sub verifyreceipt { my $request = shift; - my $courseid = $ENV{'request.course.id'}; - my $receipt = unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. - $ENV{'form.receipt'}; + my $courseid = $env{'request.course.id'}; + my $receipt = &Apache::lonnet::recprefix($courseid).'-'. + $env{'form.receipt'}; $receipt =~ s/[^\-\d]//g; - my $url = $ENV{'form.url'}; - my $symb = $ENV{'form.symb'}; - unless ($symb) { - $symb = &Apache::lonnet::symbread($url); - } + my $symb = &Apache::lonnet::symbread(); my $title.='

Verifying Submission Receipt '. $receipt.'

'."\n". - 'Problem: '.$ENV{'form.probTitle'}.'

'."\n"; + 'Resource: '.$env{'form.probTitle'}.'

'."\n"; my ($string,$contents,$matches) = ('','',0); my (undef,undef,$fullname) = &getclasslist('all','0'); - - foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + + my $receiptparts=0; + if ($env{"course.$courseid.receiptalg"} eq 'receipt2') { $receiptparts=1; } + my $parts=['0']; + if ($receiptparts) { ($parts)=&response_type($symb); } + foreach (sort + { + if (lc($$fullname{$a}) ne lc($$fullname{$b})) { + return (lc($$fullname{$a}) cmp lc($$fullname{$b})); + } + return $a cmp $b; + } (keys(%$fullname))) { my ($uname,$udom)=split(/\:/); - if ($receipt eq - &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { - $contents.=' '."\n". - ''.$$fullname{$_}.' '."\n". - ' '.$uname.' '. - ' '.$udom.' '."\n"; - - $matches++; + foreach my $part (@$parts) { + if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { + $contents.=' '."\n". + ''.$$fullname{$_}.' '."\n". + ' '.$uname.' '. + ' '.$udom.' '; + if ($receiptparts) { + $contents.=' '.$part.' '; + } + $contents.=''."\n"; + + $matches++; + } } } if ($matches == 0) { $string = $title.'No match found for the above receipt.'; } else { - $string = &jscriptNform($url,$symb).$title. + $string = &jscriptNform($symb).$title. 'The above receipt matches the following student'. ($matches <= 1 ? '.' : 's.')."\n". '
'."\n". ''."\n". ''."\n". ''."\n". - ''."\n". - $contents. + ''; + if ($receiptparts) { + $string.=''; + } + $string.=''."\n".$contents. '
 Fullname  Username  Domain 
 Domain  Problem Part 
'."\n"; } - return $string.&show_grading_menu_form($symb,$url); + return $string.&show_grading_menu_form($symb); } #--- This is called by a number of programs. @@ -283,166 +650,299 @@ sub verifyreceipt { sub listStudents { my ($request) = shift; - my ($symb,$url) = &get_symb_and_url($request); - 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 ($symb) = &get_symb($request); + 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; - my ($partlist,$handgrade) = &response_type($url); - for (sort keys(%$handgrade)) { - my ($responsetype,$handgrade)=split(/:/,$$handgrade{$_}); - $ENV{'form.handgrade'} = 'yes' if ($handgrade eq 'yes'); - $result.='Part '.(split(/_/))[0].''. - 'Type: '.$responsetype.''. - 'Handgrade: '.$handgrade.''; - } - $result.=''."\n"; + my $result='

 '.$viewgrade. + ' Submissions for a Student or a Group of Students

'; - my $viewgrade = $ENV{'form.handgrade'} eq 'yes' ? 'View/Grade' : 'View'; - $ENV{'form.probTitle'} = $ENV{'form.probTitle'} eq '' ? - &Apache::lonnet::gettitle($symb) : $ENV{'form.probTitle'}; - - $result='

 '. - $viewgrade. - ' Submissions for a Student or a Group of Students

'. - ''.$result; + my ($table,undef,$hdgrade,$partlist,$handgrade) = &showResourceInfo($symb,$env{'form.probTitle'},($env{'form.showgrading'} eq 'yes')); $request->print(< - function checkSelect(checkBox) { - var ctr=0; - var sense=""; - if (checkBox.length > 1) { - for (var i=0; i 1) { + for (var i=0; i LISTJAVASCRIPT + &commonJSfunctions($request); $request->print($result); - my $checkhdgrade = $ENV{'form.handgrade'} eq 'yes' ? 'checked' : ''; - my $checklastsub = $ENV{'form.handgrade'} eq 'yes' ? '' : 'checked'; - - my $gradeTable=''."\n". - ' View Problem: no '."\n". - ' one student '."\n". - ' all students
'."\n". + my $checkhdgrade = ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1 ) ? 'checked' : ''; + my $checklastsub = $checkhdgrade eq '' ? 'checked' : ''; + my $gradeTable=''. + "\n".$table. + ' View Problem Text: '."\n". + ''."\n". + '
'."\n". + ' View Answer: '."\n". + ''."\n". + '
'."\n". ' Submissions: '."\n"; - if ($ENV{'form.handgrade'} eq 'yes') { - $gradeTable.=' handgrade only'."\n"; + if ($env{'form.handgrade'} eq 'yes' && scalar(@$partlist) > 1) { + $gradeTable.=''."\n"; } - $gradeTable.=' last sub only'."\n". - ' last sub & parts info'."\n". - ' all details'."\n". + + my $saveStatus = $env{'form.Status'} eq '' ? 'Active' : $env{'form.Status'}; + $env{'form.Status'} = $saveStatus; + + $gradeTable.=''."\n". + ''."\n". + ''."\n". + ''."\n". ''."\n". ''."\n". - ''."\n". - '
'."\n". - '
'."\n". - ''."\n". - ''."\n". - ''."\n". + '
'."\n". + '
'."\n". + ''."\n". + ''."\n". ''."\n". - 'To '.lc($viewgrade).' a submission, click on the check box next to the student\'s name. Then '."\n". - 'click on the '.$viewgrade.' button. To view the submissions for a group of students, click'."\n". - ' on the check boxes for the group of students.
'."\n". - ''."\n". - ''."\n"; + + if (exists($env{'form.gradingMenu'}) && exists($env{'form.Status'})) { + $gradeTable.=''."\n"; + } else { + $gradeTable.='Student Status: '. + &Apache::lonhtmlcommon::StatusOptions($saveStatus,undef,1,'javascript:reLoadList(this.form);').'
'; + } + + $gradeTable.='To '.lc($viewgrade).' a submission or a group of submissions, click on the check box(es) '. + 'next to the student\'s name(s). Then click on the Next button.
'."\n". + ''."\n"; + +# checkall buttons + $gradeTable.=&check_script('gradesub', 'stuinfo'); + $gradeTable.=''."\n"; - - my (undef,undef,$fullname) = &getclasslist($getsec,$ENV{'form.showgrading'} eq 'yes' ? '1' : '0'); - + 'value="Next->" />
'."\n"; + $gradeTable.=&check_buttons(); + $gradeTable.=''; + my ($classlist, undef, $fullname) = &getclasslist($getsec,'1'); $gradeTable.='
'. - 'Problem: '.$ENV{'form.probTitle'}.'
'. - ''. - ''. - ''; - foreach (sort(@$partlist)) { - $gradeTable.=''; + '
 Select  Fullname  Username  Domain  Part '.(split(/_/))[0].' Status 
'; + my $loop = 0; + while ($loop < 2) { + $gradeTable.=''. + ''; + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { + foreach (sort(@$partlist)) { + my $display_part=&get_display_part((split(/_/))[0],$symb); + $gradeTable.=''; + } + } elsif ($submitonly eq 'queued') { + $gradeTable.=''; + } + $loop++; +# $gradeTable.='' if ($loop%2 ==1); } $gradeTable.=''."\n"; my $ctr = 0; - foreach my $student (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) { + foreach my $student (sort + { + if (lc($$fullname{$a}) ne lc($$fullname{$b})) { + return (lc($$fullname{$a}) cmp lc($$fullname{$b})); + } + return $a cmp $b; + } + (keys(%$fullname))) { my ($uname,$udom) = split(/:/,$student); - my (%status) =&student_gradeStatus($url,$symb,$udom,$uname,$partlist); - my $statusflg = ''; - foreach (keys(%status)) { - $statusflg = 1 if ($status{$_} ne 'nothing'); - my ($foo,$partid,$foo1) = split(/\./,$_); - if ($status{'resource.'.$partid.'.submitted_by'} ne '') { - $statusflg = ''; - $gradeTable.=''; + + my %status = (); + + if ($submitonly eq 'queued') { + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + next if (!defined($queue_status{'gradingqueue'})); + $status{'gradingqueue'} = $queue_status{'gradingqueue'}; + } + + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { + (%status) =&student_gradeStatus($symb,$udom,$uname,$partlist); + my $submitted = 0; + my $graded = 0; + my $incorrect = 0; + foreach (keys(%status)) { + $submitted = 1 if ($status{$_} ne 'nothing'); + $graded = 1 if ($status{$_} =~ /^ungraded/); + $incorrect = 1 if ($status{$_} =~ /^incorrect/); + + my ($foo,$partid,$foo1) = split(/\./,$_); + if ($status{'resource.'.$partid.'.submitted_by'} ne '') { + $submitted = 0; + my ($part)=split(/\./,$partid); + $gradeTable.=''; + } } + + next if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')); + next if (!$graded && ($submitonly eq 'graded')); + next if (!$incorrect && $submitonly eq 'incorrect'); } - next if ($statusflg eq '' && $submitonly eq 'yes'); $ctr++; - if ( $Apache::grades::viewgrades eq 'F' ) { - $gradeTable.=''. - ''."\n". - ''."\n". - ''."\n". - ''."\n"; - - foreach (sort keys(%status)) { - next if (/^resource.*?submitted_by$/); - $gradeTable.=''."\n"; + my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + + if ( $perm{'vgr'} eq 'F' ) { + $gradeTable.='' if ($ctr%2 ==1); + $gradeTable.=''. + ''."\n".''."\n"; + + if ($env{'form.showgrading'} eq 'yes' && $submitonly ne 'all') { + foreach (sort keys(%status)) { + next if (/^resource.*?submitted_by$/); + $gradeTable.=''."\n"; + } } - $gradeTable.=''."\n"; +# $gradeTable.='' if ($ctr%2 ==1); + $gradeTable.=''."\n" if ($ctr%2 ==0); } } - $gradeTable.='
 No.  Select '.&nameUserString('header').' Section/Group Part: '.$display_part. + ' Status  '.&mt('Queue Status').' 
 '.$$fullname{$student}.'  '.$uname.'  '.$udom.'  '.$status{$_}.' 
'.$ctr.' '. + &nameUserString(undef,$$fullname{$student},$uname,$udom). + ' '.$section.' '.$status{$_}.' 
'. + if ($ctr%2 ==1) { + $gradeTable.='   '; + if ($env{'form.showgrading'} eq 'yes' + && $submitonly ne 'queued' + && $submitonly ne 'all') { + foreach (@$partlist) { + $gradeTable.=' '; + } + } elsif ($submitonly eq 'queued') { + $gradeTable.=' '; + } + $gradeTable.=''; + } + + $gradeTable.=''."\n". '
'."\n"; + 'value="Next->" />'."\n"; if ($ctr == 0) { - $gradeTable='
 '. - 'No submission found for this resource.
'; + my $num_students=(scalar(keys(%$fullname))); + if ($num_students eq 0) { + $gradeTable='
 There are no students currently enrolled.'; + } else { + my $submissions='submissions'; + if ($submitonly eq 'incorrect') { $submissions = 'incorrect submissions'; } + if ($submitonly eq 'graded' ) { $submissions = 'ungraded submissions'; } + if ($submitonly eq 'queued' ) { $submissions = 'queued submissions'; } + $gradeTable='
 '. + 'No '.$submissions.' found for this resource for any students. ('.$num_students. + ' students checked for '.$submissions.')
'; + } } elsif ($ctr == 1) { $gradeTable =~ s/type=checkbox/type=checkbox checked/; } - $gradeTable.=&show_grading_menu_form($symb,$url); + $gradeTable.=&show_grading_menu_form($symb); $request->print($gradeTable); return ''; } #---- Called from the listStudents routine + +sub check_script { + my ($form, $type)=@_; + my $chkallscript=''."\n"; + return $chkallscript; +} + +sub check_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 $ctr = 0; - my @stuchecked = (ref($ENV{'form.stuinfo'}) ? @{$ENV{'form.stuinfo'}} - : ($ENV{'form.stuinfo'})); + my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); my $total = scalar(@stuchecked)-1; foreach (@stuchecked) { my ($uname,$udom,$fullname) = split(/:/); - $ENV{'form.student'} = $uname; - $ENV{'form.userdom'} = $udom; - $ENV{'form.fullname'} = $fullname; + $env{'form.student'} = $uname; + $env{'form.userdom'} = $udom; + $env{'form.fullname'} = $fullname; &submission($request,$ctr,$total); $ctr++; } @@ -460,9 +960,9 @@ sub sub_page_js { $request->print(< function updateRadio(formname,id,weight) { - var gradeBox = eval("formname.GD_BOX"+id); - var radioButton = eval("formname.RADVAL"+id); - var oldpts = eval("formname.oldpts"+id+".value"); + var gradeBox = formname["GD_BOX"+id]; + var radioButton = formname["RADVAL"+id]; + var oldpts = formname["oldpts"+id].value; var pts = checkSolved(formname,id) == 'update' ? gradeBox.value : oldpts; gradeBox.value = pts; var resetbox = false; @@ -484,7 +984,7 @@ sub sub_page_js { var resp = confirm("You entered a value ("+pts+ ") greater than the weight for the part. Accept?"); if (resp == false) { - gradeBox.value = ""; + gradeBox.value = oldpts; return; } } @@ -496,18 +996,17 @@ sub sub_page_js { } } updateSelect(formname,id); - var stores = eval("formname.stores"+id); - stores.value = "0"; + formname["stores"+id].value = "0"; } function writeBox(formname,id,pts) { - var gradeBox = eval("formname.GD_BOX"+id); + var gradeBox = formname["GD_BOX"+id]; if (checkSolved(formname,id) == 'update') { gradeBox.value = pts; } else { - var oldpts = eval("formname.oldpts"+id+".value"); + var oldpts = formname["oldpts"+id].value; gradeBox.value = oldpts; - var radioButton = eval("formname.RADVAL"+id); + var radioButton = formname["RADVAL"+id]; for (var i=0; idir_config('lonIconsURL'); + &commonJSfunctions($request); + my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); + $docopen=~s/^document\.//; $request->print(< //===================== Show list of keywords ==================== - function keywords(keyform) { - var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",keyform.value); + function keywords(formname) { + var nret = prompt("Keywords list, separated by a space. Add/delete to list if desired.",formname.keywords.value); if (nret==null) return; - keyform.value = nret; + formname.keywords.value = nret; - document.SCORE.refresh.value = "on"; - if (document.SCORE.keywords.value != "") { - document.SCORE.submit(); + if (formname.keywords.value != "") { + formname.refresh.value = "on"; + formname.submit(); } return; } @@ -666,10 +1174,9 @@ sub sub_page_kw_js { } var nret = prompt("Add selection to keyword list? Edit if desired.",cleantxt); if (nret==null) return; - var curlist = document.SCORE.keywords.value; - document.SCORE.keywords.value = curlist+" "+nret; - document.SCORE.refresh.value = "on"; + document.SCORE.keywords.value = document.SCORE.keywords.value+" "+nret; if (document.SCORE.keywords.value != "") { + document.SCORE.refresh.value = "on"; document.SCORE.submit(); } return; @@ -686,21 +1193,23 @@ sub sub_page_kw_js { var Nmsg = msgform.savemsgN.value; savedMsgHeader(Nmsg,usrctr,fullname); var subject = msgform.msgsub.value; - var rtrchk = eval("document.SCORE.includemsg"+usrctr); - var msgchk = rtrchk.value; + var msgchk = document.SCORE["includemsg"+usrctr].value; re = /msgsub/; var shwsel = ""; if (re.test(msgchk)) { shwsel = "checked" } - displaySubject(subject,shwsel); + subject = (document.SCORE.shownSub.value == 0 ? checkEntities(subject) : subject); + displaySubject(checkEntities(subject),shwsel); for (var i=1; i<=Nmsg; i++) { - var testpt = "savemsg"+i+","; - re = /testpt/; + var testmsg = "savemsg"+i+","; + re = new RegExp(testmsg,"g"); shwsel = ""; if (re.test(msgchk)) { shwsel = "checked" } - var message = eval("document.SCORE.savemsg"+i+".value"); - displaySavedMsg(i,message,shwsel); + var message = document.SCORE["savemsg"+i].value; + message = (document.SCORE["shownOnce"+i].value == 0 ? checkEntities(message) : message); + displaySavedMsg(i,message,shwsel); //I do not get it. w/o checkEntities on saved messages, + //any < is already converted to <, etc. However, only once!! } - newmsg = eval("document.SCORE.newmsg"+usrctr+".value"); + newmsg = document.SCORE["newmsg"+usrctr].value; shwsel = ""; re = /newmsg/; if (re.test(msgchk)) { shwsel = "checked" } @@ -709,7 +1218,22 @@ sub sub_page_kw_js { return; } -// var pWin = null; + function checkEntities(strx) { + if (strx.length == 0) return strx; + var orgStr = ["&", "<", ">", '"']; + var newStr = ["&", "<", ">", """]; + var counter = 0; + while (counter < 4) { + strx = strReplace(strx,orgStr[counter],newStr[counter]); + counter++; + } + return strx; + } + + function strReplace(strx, orgStr, newStr) { + return strx.split(orgStr).join(newStr); + } + function savedMsgHeader(Nmsg,usrctr,fullname) { var height = 70*Nmsg+250; var scrollbar = "no"; @@ -717,20 +1241,25 @@ sub sub_page_kw_js { height = 600; scrollbar = "yes"; } -// if (window.pWin) window.pWin.close(); - pWin = window.open('', 'MessageCenter', 'toolbar=no,location=no,scrollbars='+scrollbar+',screenx=70,screeny=75,width=600,height='+height); + var xpos = (screen.width-600)/2; + xpos = (xpos < 0) ? '0' : xpos; + var ypos = (screen.height-height)/2-30; + ypos = (ypos < 0) ? '0' : ypos; + + pWin = window.open('', 'MessageCenter', 'resizable=yes,toolbar=no,location=no,scrollbars='+scrollbar+',screenx='+xpos+',screeny='+ypos+',width=600,height='+height); pWin.focus(); pDoc = pWin.document; + pDoc.$docopen; pDoc.write(""); pDoc.write("Message Central"); pDoc.write(" @@ -915,33 +1439,35 @@ SUBJAVASCRIPT #--- displays the grading box, used in essay type problem and grading by page/sequence sub gradeBox { my ($request,$symb,$uname,$udom,$counter,$partid,$record) = @_; - my $checkIcon = ''; - my $wgt = &Apache::lonnet::EXT('resource.'.$partid.'.weight',$symb,$udom,$uname); my $wgtmsg = ($wgt > 0 ? '(problem weight)' : 'problem weight assigned by computer'); $wgt = ($wgt > 0 ? $wgt : '1'); my $score = ($$record{'resource.'.$partid.'.awarded'} eq '' ? - '' : $$record{'resource.'.$partid.'.awarded'}*$wgt); + '' : &compute_points($$record{'resource.'.$partid.'.awarded'},$wgt)); my $result=''."\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.=''."\n"; $result.='
'. - 'Part '.$partid.' Points: '."\n"; - + 'Part: '.$display_part.' Points: '."\n"; my $ctr = 0; $result.=''."\n"; # display radio buttons in a nice table 10 across while ($ctr<=$wgt) { - $result.= '\n"; + ($score eq $ctr ? 'checked':'').' /> '.$ctr."\n"; $result.=(($ctr+1)%10 == 0 ? '' : ''); $ctr++; } $result.='
'.$ctr."
'; - $result.='		 or '."\n"; - $result.=''."\n"; + ''; } else { $result.=''. - ''."\n"; + ''; } + $result.=''."\n"; $result.="  \n"; $result.=''."\n". ''."\n". ''."\n"; + $$record{'resource.'.$partid.'.solved'}.'" />'."\n". + ''."\n". + ''."\n"; $result.='
'."\n"; + $result.=&handback_box($symb,$uname,$udom,$counter,$partid,$record); return $result; } +sub handback_box { + my ($symb,$uname,$udom,$counter,$partid,$record) = @_; + my ($partlist,$handgrade,$responseType) = &response_type($symb); + my (@respids); + foreach my $part_resp (sort(keys(%$handgrade))) { + my ($part,$resp) = split(/_/,$part_resp); + if ($part eq $partid) { + push @respids,$resp; + } + } + my $result; + foreach my $respid (@respids) { + my $prefix = $counter.'_'.$partid.'_'.$respid.'_'; + my $files=&get_submitted_files($udom,$uname,$partid,$respid,$record); + next if (!@$files); + my $file_counter = 1; + foreach my $file (@$files) { + my ($file_disp) = ($file =~ m|.+/(.+)$|); + $result.=&mt('Return commented version of [_1] to student.', + ''.$file_disp.''); + $result.=''."\n"; + $result.='
'; + $file_counter++; + } + } + return $result; +} + sub show_problem { - my ($request,$symb,$uname,$udom,$removeform,$viewon) = @_; - my $rendered=&Apache::loncommon::get_student_view($symb,$uname,$udom, - $ENV{'request.course.id'}); + my ($request,$symb,$uname,$udom,$removeform,$viewon,$mode) = @_; + my $rendered; + &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'}); + } if ($removeform) { $rendered=~s|||g; $rendered=~s|||g; $rendered=~s|name="submit"|name="would_have_been_submit"|g; } - my $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, - $ENV{'request.course.id'}); + my $companswer; + if ($mode eq 'both' or $mode eq 'answer') { + &Apache::lonxml::restore_problem_counter(); + $companswer=&Apache::loncommon::get_student_answers($symb,$uname,$udom, + $env{'request.course.id'}); + } if ($removeform) { $companswer=~s|||g; $companswer=~s|||g; - $rendered=~s|name="submit"|name="would_have_been_submit"|g; + $companswer=~s|name="submit"|name="would_have_been_submit"|g; } my $result.='
'; $result.=''; - $result.='' if ($viewon); - $result.=''; + } + if ($mode eq 'both') { + $result.='
View of the problem - '.$ENV{'form.fullname'}. - '
'.$rendered.'
'; - $result.='Correct answer:
'.$companswer; + if ($viewon) { + $result.='
'; + if ($mode eq 'both' or $mode eq 'text') { + $result.='View of the problem - '; + } else { + $result.='Correct answer: '; + } + $result.=$env{'form.fullname'}.'
'.$rendered.'
'; + $result.='Correct answer:
'.$companswer; + } elsif ($mode eq 'text') { + $result.='
'.$rendered; + } elsif ($mode eq 'answer') { + $result.='
'.$companswer; + } $result.='
'; $result.='

'; return $result; @@ -1000,119 +1580,175 @@ sub show_problem { sub submission { my ($request,$counter,$total) = @_; - (my $url=$ENV{'form.url'})=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; - my ($uname,$udom) = ($ENV{'form.student'},$ENV{'form.userdom'}); - ($uname,$udom) = &finduser($uname) if $udom eq ''; - $ENV{'form.fullname'} = &get_fullname ($uname,$udom) 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 ''; } - my $last = ($ENV{'form.lastSub'} eq 'last' ? 'last' : ''); + 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 = &get_symb($request); + if ($symb eq '') { $request->print("Unable to handle ambiguous references:."); return ''; } + + 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)); + 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'; } + my $last = ($env{'form.lastSub'} eq 'last' ? 'last' : ''); + my $checkIcon = ''; # header info if ($counter == 0) { &sub_page_js($request); - &sub_page_kw_js($request); - $ENV{'form.probTitle'} = $ENV{'form.probTitle'} eq '' ? - &Apache::lonnet::gettitle($symb) : $ENV{'form.probTitle'}; + &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". - ' Problem: '.$ENV{'form.probTitle'}.''."\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); + } # option to display problem, only once else it cause problems # with the form later since the problem has a form. - if ($ENV{'form.vProb'} eq 'yes' or !$ENV{'form.vProb'}) { - $request->print(&show_problem($request,$symb,$uname,$udom,0,1)); + if ($env{'form.vProb'} eq 'yes' or $env{'form.vAns'} eq 'yes') { + my $mode; + if ($env{'form.vProb'} eq 'yes' && $env{'form.vAns'} eq 'yes') { + $mode='both'; + } elsif ($env{'form.vProb'} eq 'yes') { + $mode='text'; + } 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 '') { + if ($env{'form.kwclr'} eq '' && $env{'form.handgrade'} eq 'yes') { %keyhash = &Apache::lonnet::dump('nohist_handgrade', - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); - - 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'}; - $ENV{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'}); + 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'}; + $env{'form.savemsgN'} = $keyhash{$symb.'_savemsgN'} ne '' ? $keyhash{$symb.'_savemsgN'} : '0'; } + my $overRideScore = $env{'form.overRideScore'} eq '' ? 'no' : $env{'form.overRideScore'}; - $request->print('
'."\n". + $request->print(''."\n". ''."\n". - ''."\n". - ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". ''."\n". + ''."\n". + ''."\n". ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". - ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". ''."\n"); + ' value="'.($env{'form.NTSTU'} ne '' ? $env{'form.NTSTU'} : $total+1).'" />'."\n"); + if ($env{'form.handgrade'} eq 'yes') { + $request->print(''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n"); + foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { + $request->print(''."\n"); + } + } my ($cts,$prnmsg) = (1,''); - while ($cts <= $ENV{'form.savemsgN'}) { + while ($cts <= $env{'form.savemsgN'}) { $prnmsg.=''."\n"; + '" />'."\n". + ''."\n"; $cts++; } $request->print($prnmsg); - if ($ENV{'form.handgrade'} eq 'yes' && $ENV{'form.showgrading'} eq 'yes') { + if ($env{'form.handgrade'} eq 'yes' && $env{'form.showgrading'} eq 'yes') { +# +# Print out the keyword options line +# $request->print(<Keyword Options:  -List    +List    Paste Selection to List    Highlight Attribute

KEYWORDS +# +# Load the other essays for similarity check +# + my (undef,undef,$essayurl) = &Apache::lonnet::decode_symb($symb); + my ($adom,$aname,$apath)=($essayurl=~/^(\w+)\/(\w+)\/(.*)$/); + $apath=&Apache::lonnet::escape($apath); + $apath=~s/\W/\_/gs; + %oldessays=&Apache::lonnet::dump('nohist_essay_'.$apath,$adom,$aname); } } - if ($ENV{'form.vProb'} eq 'all') { + if ($env{'form.vProb'} eq 'all' or $env{'form.vAns'} eq 'all') { $request->print('


') if ($counter > 0); - $request->print(&show_problem($request,$symb,$uname,$udom,1,1)); + my $mode; + if ($env{'form.vProb'} eq 'all' && $env{'form.vAns'} eq 'all') { + $mode='both'; + } elsif ($env{'form.vProb'} eq 'all' ) { + $mode='text'; + } elsif ($env{'form.vAns'} eq 'all') { + $mode='answer'; + } + &Apache::lonxml::clear_problem_counter(); + $request->print(&show_problem($request,$symb,$uname,$udom,1,1,$mode)); } - my %record = &Apache::lonnet::restore($symb,$ENV{'request.course.id'},$udom,$uname); - my ($partlist,$handgrade) = &response_type($url); + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); + my ($partlist,$handgrade,$responseType) = &response_type($symb); # Display student info $request->print(($counter == 0 ? '' : '
')); - my $result='
'."\n". - '
'."\n"; + my $result='
'."\n". + ''."\n"; - } else { - for my $part (sort keys(%$handgrade)) { - foreach (@$string) { - my ($partid,$respid) = /^resource\.(\d+)\.(\d+)\.submission/; - if ($part eq ($partid.'_'.$respid)) { - my ($ressub,$subval) = split(/:/,$_,2); - $lastsubonly.=''."\n" - if ($ENV{'form.lastSub'} eq 'lastonly' || - ($ENV{'form.lastSub'} eq 'hdgrade' && - $$handgrade{$part} =~ /:yes$/)); + if ($env{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { + my ($string,$timestamp)= &get_last_submission(\%record); + my $lastsubonly=''. + ($$timestamp eq '' ? '' : 'Date Submitted: '. + $$timestamp)."\n"; + if ($$timestamp eq '') { + $lastsubonly.=''."\n"; - $request->print($lastsubonly); } - } else { + $lastsubonly.='
'."\n"; - $result.='Fullname: '.$ENV{'form.fullname'}. - '   Username: '.$uname.''. - '   Domain: '.$udom.'
'."\n"; + $result.='Fullname: '.&nameUserString(undef,$env{'form.fullname'},$uname,$udom).'
'."\n"; $result.=''."\n"; + '" value="'.$env{'form.fullname'}.'" />'."\n"; - # If this is handgraded, then check for collaborators + # If any part of the problem is an essay-response (handgraded), then check for collaborators my @col_fullnames; my ($classlist,$fullname); - if ($ENV{'form.handgrade'} eq 'yes') { - my @col_list; + if ($env{'form.handgrade'} eq 'yes') { ($classlist,undef,$fullname) = &getclasslist('all','0'); for (keys (%$handgrade)) { my $ncol = &Apache::lonnet::EXT('resource.'.$_. @@ -1121,56 +1757,48 @@ KEYWORDS next if ($ncol <= 0); s/\_/\./g; next if ($record{'resource.'.$_.'.collaborators'} eq ''); - my (@colList) = split(/,?\s+/, - $record{'resource.'.$_.'.collaborators'}); - my @collaborators = (); - foreach (@colList) { #pre-filter list - throw out submitter + my @goodcollaborators = (); + my @badcollaborators = (); + foreach (split(/,?\s+/,$record{'resource.'.$_.'.collaborators'})) { + $_ =~ s/[\$\^\(\)]//g; + next if ($_ eq ''); my ($co_name,$co_dom) = split /\@|:/,$_; - $co_dom = $udom if (! defined($co_dom)); + $co_dom = $udom if (! defined($co_dom) || $co_dom =~ /^domain$/i); next if ($co_name eq $uname && $co_dom eq $udom); - push @collaborators, $_; + # Doing this grep allows 'fuzzy' specification + my @Matches = grep /^$co_name:$co_dom$/i,keys %$classlist; + if (! scalar(@Matches)) { + push @badcollaborators,$_; + } else { + push @goodcollaborators, @Matches; + } } - my (@badcollaborators); - if (scalar(@collaborators) != 0) { + if (scalar(@goodcollaborators) != 0) { $result.='Collaborators: '; - foreach my $collaborator (@collaborators) { - my ($co_name,$co_dom) = split /\@|:/,$collaborator; - $co_dom = $udom if (! defined($co_dom)); - # Doing this grep allows 'fuzzy' specification - my @Matches = grep /^$co_name:$co_dom$/i, - keys %$classlist; - if (! scalar(@Matches)) { - push @badcollaborators,':'.$collaborator.':'; - next; - } - push @col_list, @Matches; - foreach (@Matches) { - my ($lastname,$givenn) = split(/,/,$$fullname{$_}); - push @col_fullnames, $givenn.' '.$lastname; - $result.=$$fullname{$_}.'     '; - } - } + foreach (@goodcollaborators) { + my ($lastname,$givenn) = split(/,/,$$fullname{$_}); + push @col_fullnames, $givenn.' '.$lastname; + $result.=$$fullname{$_}.'     '; + } $result.='
'."\n"; - if (scalar(@badcollaborators) > 0) { - $result.='
'; - $result.='This student has submitted '; - if (scalar(@badcollaborators) == 1) { - $result .= 'an invalid collaborator'; - } else { - $result .= 'invalid collaborators'; - } - $result .= ': '.join(', ',@badcollaborators); - $result .= '
'; - } - if (scalar(@collaborators > $ncol)) { - $result .= '
'; - $result .= 'This student has submitted too many '. - 'collaborators. Maximum is '.$ncol; - $result .= '
'; - } - $result.=''."\n"; - } + my ($part)=split(/\./,$_); + $result.=''. + "\n"; + } + if (scalar(@badcollaborators) > 0) { + $result.='
'; + $result.='This student has submitted '; + $result.=(scalar(@badcollaborators) == 1) ? 'an invalid collaborator' : 'invalid collaborators'; + $result .= ': '.join(', ',@badcollaborators); + $result .= '
'; + } + if (scalar(@badcollaborators > $ncol)) { + $result .= '
'; + $result .= 'This student has submitted too many '. + 'collaborators. Maximum is '.$ncol.'.'; + $result .= '
'; + } } } $request->print($result."\n"); @@ -1181,98 +1809,163 @@ KEYWORDS # (for multi-response type part) # (3) Last submission plus the parts info # (4) The whole record for this student - if ($ENV{'form.lastSub'} =~ /^(lastonly|hdgrade)$/) { - if ($ENV{'form.'.$uname.':'.$udom.':submitted_by'}) { - my $submitby=''. - 'Collaborative submission by: '. - ''. - $$fullname{$ENV{'form.'.$uname.':'.$udom.':submitted_by'}}.''; - $request->print($submitby); - } else { - my ($string,$timestamp)= - &get_last_submission (%record); - my $lastsubonly=''. - ($$timestamp eq '' ? '' : 'Date Submitted: '. - $$timestamp).''; - if ($$timestamp eq '') { - $lastsubonly.='
'.$$string[0].'
Part '. - $partid.' ( ID '.$respid. - ' )   '. - ($record{"resource.$partid.$respid.uploadedurl"}? - ' File uploaded by student Like all files provided by users, this file may contain virusses
':''). - 'Answer: '. - &keywords_highlight($subval).'
'.$$string[0]; + } else { + my %seenparts; + for my $part (sort keys(%$handgrade)) { + my ($partid,$respid) = split(/_/,$part); + my $display_part=&get_display_part($partid,$symb); + if ($env{"form.$uname:$udom:$partid:submitted_by"}) { + if (exists($seenparts{$partid})) { next; } + $seenparts{$partid}=1; + my $submitby='Part: '.$display_part. + ' Collaborative submission by: '. + ''. + $$fullname{$env{"form.$uname:$udom:$partid:submitted_by"}}.'
'; + $request->print($submitby); + next; + } + my $responsetype = $responseType->{$partid}->{$respid}; + if (!exists($record{"resource.$partid.$respid.submission"})) { + $lastsubonly.='
Part: '. + $display_part.' ( ID '.$respid. + ' )   '. + 'Nothing submitted - no attempts

'; + next; + } + foreach (@$string) { + my ($partid,$respid) = /^resource\.([^\.]*)\.([^\.]*)\.submission/; + if ($part ne ($partid.'_'.$respid)) { next; } + my ($ressub,$subval) = split(/:/,$_,2); + # Similarity check + my $similar=''; + if($env{'form.checkPlag'}){ + my ($oname,$odom,$ocrsid,$oessay,$osim)= + &most_similar($uname,$udom,$subval); + if ($osim) { + $osim=int($osim*100.0); + $similar="

Essay". + " is $osim% similar to an essay by ". + &Apache::loncommon::plainname($oname,$odom). + '

'. + &keywords_highlight($oessay). + '
'; + } + } + my $order=&get_order($partid,$respid,$symb,$uname,$udom); + if ($env{'form.lastSub'} eq 'lastonly' || + ($env{'form.lastSub'} eq 'hdgrade' && + $$handgrade{$part} eq 'yes')) { + my $display_part=&get_display_part($partid,$symb); + $lastsubonly.='
Part: '. + $display_part.' ( ID '.$respid. + ' )   '; + my $files=&get_submitted_files($udom,$uname,$partid,$respid,\%record); + if (@$files) { + $lastsubonly.='
Like all files provided by users, this file may contain virusses
'; + my $file_counter = 0; + foreach my $file (@$files) { + $file_counter ++; + &Apache::lonnet::allowuploaded('/adm/grades',$file); + $lastsubonly.='
'.$file.''; + } + $lastsubonly.='
'; } + $lastsubonly.='Submitted Answer: '. + &cleanRecord($subval,$responsetype,$symb,$partid, + $respid,\%record,$order); + if ($similar) {$lastsubonly.="

$similar\n";} } } } - $lastsubonly.='
'."\n"; + $request->print($lastsubonly); + } elsif ($env{'form.lastSub'} eq 'datesub') { + my (undef,$responseType,undef,$parts) = &showResourceInfo($symb); + $request->print(&displaySubByDates($symb,\%record,$parts,$responseType,$checkIcon,$uname,$udom)); + } elsif ($env{'form.lastSub'} =~ /^(last|all)$/) { $request->print(&Apache::loncommon::get_previous_attempt($symb,$uname,$udom, - $ENV{'request.course.id'}, + $env{'request.course.id'}, $last,'.submission', 'Apache::grades::keywords_highlight')); } + + $request->print(''."\n"); # return if view submission with no grading option - if ($ENV{'form.showgrading'} eq '') { - $request->print('
'."\n"); - $request->print(&show_grading_menu_form($symb,$url)) - if (($ENV{'form.command'} eq 'submission') || - ($ENV{'form.command'} eq 'processGroup' && $counter == $total)); + if ($env{'form.showgrading'} eq '' || (!&canmodify($usec))) { + my $toGrade.='  '."\n" if (&canmodify($usec)); + $toGrade.='
'."\n"; + if (($env{'form.command'} eq 'submission') || + ($env{'form.command'} eq 'processGroup' && $counter == $total)) { + $toGrade.=''.&show_grading_menu_form($symb); + } + $request->print($toGrade); return; + } else { + $request->print(''."\n"); } - # Grading options - $result=''."\n". - ''."\n". - ''."\n"; - my ($lastname,$givenn) = split(/,/,$ENV{'form.fullname'}); - my $msgfor = $givenn.' '.$lastname; - if (scalar(@col_fullnames) > 0) { - my $lastone = pop @col_fullnames; - $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.'; - } - $result.=''."\n". - ' '. - 'Compose Message to student'.(scalar(@col_fullnames) >= 1 ? 's' : '').'  '. - ''."\n". - '
 (Message will be sent when you click on Save & Next below.)'."\n" - if ($ENV{'form.handgrade'} eq 'yes'); - $request->print($result); + # essay grading message center + if ($env{'form.handgrade'} eq 'yes') { + my ($lastname,$givenn) = split(/,/,$env{'form.fullname'}); + my $msgfor = $givenn.' '.$lastname; + if (scalar(@col_fullnames) > 0) { + my $lastone = pop @col_fullnames; + $msgfor .= ', '.(join ', ',@col_fullnames).' and '.$lastone.'.'; + } + $msgfor =~ s/\'/\\'/g; #' stupid emacs - no! javascript + $result=''."\n". + ''."\n"; + $result.=' '. + &mt('Compose message to student').(scalar(@col_fullnames) >= 1 ? 's' : '').' ('. + &mt('incl. grades').' )'. + ''."\n". + '
 ('. + &mt('Message will be sent when you click on Save & Next below.').")\n"; + $request->print($result); + } + if ($perm{'vgr'}) { + $request->print('
'. + &Apache::loncommon::track_student_link(&mt('View recent activity'), + $uname,$udom,'check')); + } + if ($perm{'opa'}) { + $request->print('
'. + &Apache::loncommon::pprmlink(&mt('Set/Change parameters'), + $uname,$udom,$symb,'check')); + } my %seen = (); my @partlist; - for (sort keys(%$handgrade)) { - my ($partid,$respid) = split(/_/); + my @gradePartRespid; + for my $part_resp (sort(keys(%$handgrade))) { + my ($partid,$respid) = split(/_/, $part_resp); next if ($seen{$partid} > 0); $seen{$partid}++; - next if ($$handgrade{$_} =~ /:no$/); + next if ($$handgrade{$part_resp} =~ /:no$/ && $env{'form.lastSub'} =~ /^(hdgrade)$/); push @partlist,$partid; - + push @gradePartRespid,$partid.'.'.$respid; $request->print(&gradeBox($request,$symb,$uname,$udom,$counter,$partid,\%record)); } $result=''."\n"; + $result.=''."\n" if ($counter == 0); my $ctr = 0; while ($ctr < scalar(@partlist)) { $result.=''. - ''."\n"; - if ($ENV{'form.handgrade'} eq 'yes') { - $endform.='  '."\n"; - my $ntstu =''."\n"; - my $nsel = ($ENV{'form.NTSTU'} ne '' ? $ENV{'form.NTSTU'} : '1'); - $ntstu =~ s/