--- loncom/homework/grades.pm 2002/06/25 21:07:56 1.31 +++ loncom/homework/grades.pm 2024/12/09 21:39:48 1.799 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # The LON-CAPA Grading handler # -# $Id: grades.pm,v 1.31 2002/06/25 21:07:56 ng Exp $ +# $Id: grades.pm,v 1.799 2024/12/09 21:39:48 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,13 +25,8 @@ # # 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 2002 H.K. Ng -# + + package Apache::grades; use strict; @@ -39,549 +34,5700 @@ use Apache::style; use Apache::lonxml; use Apache::lonnet; use Apache::loncommon; +use Apache::lonhtmlcommon; +use Apache::lonnavmaps; use Apache::lonhomework; -use Apache::Constants qw(:common); +use Apache::lonpickcode; +use Apache::loncoursedata; +use Apache::lonmsg(); +use Apache::Constants qw(:common :http); +use Apache::lonlocal; +use Apache::lonenc; +use Apache::lonstathelpers; +use Apache::lonquickgrades; +use Apache::bridgetask(); +use Apache::lontexconvert(); +use Apache::loncourserespicker; +use String::Similarity; +use HTML::Parser(); +use File::MMagic; +use LONCAPA; +use LONCAPA::ltiutils(); + +use POSIX qw(floor); -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('
'); - } - return ''; + + +my %perm=(); +my %old_essays=(); + +# These variables are used to recover from ssi errors + +my $ssi_retries = 5; +my $ssi_error; +my $ssi_error_resource; +my $ssi_error_message; +my $registered_cleanup; + +sub ssi_with_retries { + my ($resource, $retries, %form) = @_; + my ($content, $response) = &Apache::loncommon::ssi_with_retries($resource, $retries, %form); + if ($response->is_error) { + $ssi_error = 1; + $ssi_error_resource = $resource; + $ssi_error_message = $response->code . " " . $response->message; + } + + return $content; + +} +# +# Prodcuces an ssi retry failure error message to the user: +# + +sub ssi_print_error { + my ($r) = @_; + my $helpurl = &Apache::loncommon::top_nav_help('Helpdesk'); + $r->print(' +
+

'.&mt('An unrecoverable network error occurred:').'

+

+'.&mt('Unable to retrieve a resource from a server:').'
+'.&mt('Resource:').' '.$ssi_error_resource.'
+'.&mt('Error:').' '.$ssi_error_message.' +

+

'. +&mt('It is recommended that you try again later, as this error may mean the server was just temporarily unavailable, or is down for maintenance.').'
'. +&mt('If the error persists, please contact the [_1] for assistance.',$helpurl). +'

'); + return; +} + +# +# --- Retrieve the parts from the metadata file.--- +# Returns an array of everything that the resources stores away +# + +sub getpartlist { + my ($symb,$errorref) = @_; + + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + if (ref($errorref)) { + $$errorref = 'navmap'; + return; + } + } + my $res = $navmap->getBySymb($symb); + my $partlist = $res->parts(); + my $url = $res->src(); + my $toolsymb; + if ($url =~ /ext\.tool$/) { + $toolsymb = $symb; + } + my @metakeys = split(/,/,&Apache::lonnet::metadata($url,'keys',$toolsymb)); + + my @stores; + foreach my $part (@{ $partlist }) { + foreach my $key (@metakeys) { + if ($key =~ m/^stores_\Q$part\E_/) { push(@stores,$key); } + } + } + return @stores; +} + +#--- 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 ' '.&mt('Fullname').' ('.&mt('Username').')'; + } else { + return ' '.$fullname.' ('.$uname. + ($env{'user.domain'} eq $udom ? '' : ' ('.$udom.')').')'; + } +} + +#--- Get the partlist and the response type for a given problem. --- +#--- Count responseIDs, essayresponse items, and dropbox items --- +#--- Sets response_error pointer to "1" if navmaps object broken --- +sub response_type { + my ($symb,$response_error) = @_; + + my $navmap = Apache::lonnavmaps::navmap->new(); + unless (ref($navmap)) { + if (ref($response_error)) { + $$response_error = 1; + } + return; + } + my $res = $navmap->getBySymb($symb); + unless (ref($res)) { + $$response_error = 1; + return; + } + my $partlist = $res->parts(); + my ($numresp,$numessay,$numdropbox) = (0,0,0); + my %vPart = + map { $_ => 1 } (&Apache::loncommon::get_env_multiple('form.vPart')); + my (%response_types,%handgrade); + foreach my $part (@{ $partlist }) { + next if (%vPart && !exists($vPart{$part})); + + my @types = $res->responseType($part); + my @ids = $res->responseIds($part); + for (my $i=0; $i < scalar(@ids); $i++) { + $numresp ++; + $response_types{$part}{$ids[$i]} = $types[$i]; + if ($types[$i] eq 'essay') { + $numessay ++; + if (&Apache::lonnet::EXT("resource.$part".'_'.$ids[$i].".uploadedfiletypes",$symb)) { + $numdropbox ++; + } + } + $handgrade{$part.'_'.$ids[$i]} = + &Apache::lonnet::EXT('resource.'.$part.'_'.$ids[$i]. + '.handgrade',$symb); + } + } + return ($partlist,\%handgrade,\%response_types,$numresp,$numessay,$numdropbox); } +sub flatten_responseType { + my ($responseType) = @_; + my @part_response_id = + map { + my $part = $_; + map { + [$part,$_] + } sort(keys(%{ $responseType->{$part} })); + } sort(keys(%$responseType)); + return @part_response_id; +} + +sub get_display_part { + my ($partID,$symb)=@_; + my $display=&Apache::lonnet::EXT('resource.'.$partID.'.display',$symb); + if (defined($display) and $display ne '') { + $display.= ' (' + .&mt('Part ID: [_1]',$partID).')'; + } else { + $display=$partID; + } + return $display; +} + +#--- Show parts and response type +sub showResourceInfo { + my ($symb,$partlist,$responseType,$formname,$checkboxes,$uploads) = @_; + unless ((ref($partlist) eq 'ARRAY') && (ref($responseType) eq 'HASH')) { + return '
'; + } + my $coltitle = &mt('Problem Part Shown'); + if ($checkboxes) { + $coltitle = &mt('Problem Part'); + } else { + my $checkedparts = 0; + foreach my $partid (&Apache::loncommon::get_env_multiple('form.vPart')) { + if (grep(/^\Q$partid\E$/,@{$partlist})) { + $checkedparts ++; + } + } + if ($checkedparts == scalar(@{$partlist})) { + return '
'; + } + if ($uploads) { + $coltitle = &mt('Problem Part Selected'); + } + } + my $result = '
'; + if ($checkboxes) { + my $legend = &mt('Parts to display'); + if ($uploads) { + $legend = &mt('Part(s) with dropbox'); + } + $result .= '
'.$legend.''. + ''. + ''.(' 'x2). + ''. + '
'; + } + $result .= '
'; + if (!keys(%partsseen)) { + $result = ''; + if ($uploads) { + return '
'. + '

'. + &mt('No dropbox items or essayresponse items with uploadedfiletypes set.'). + '

'; + } else { + return '
'; + } + } + return $result; +} + +sub part_selector_js { + my $js = <<"END"; +function toggleParts(formname) { + if (document.getElementById('LC_partselector')) { + var index = ''; + if (document.forms.length) { + for (var i=0; i 1)) { + for (var i=0; i 'analyze', + 'grade_domain' => $udom, + 'grade_symb' => $symb, + 'grade_courseid' => $env{'request.course.id'}, + 'grade_username' => $uname, + 'grade_noincrement' => $no_increment); + if ($bubbles_per_row ne '') { + $form{'bubbles_per_row'} = $bubbles_per_row; + } + if ($type eq 'randomizetry') { + $form{'grade_questiontype'} = $type; + if ($rndseed ne '') { + $form{'grade_rndseed'} = $rndseed; + } + } + if (ref($add_to_hash)) { + %form = (%form,%{$add_to_hash}); + } + my $subresult=&ssi_with_retries($url, $ssi_retries,%form); + (undef,$subresult)=split(/_HASH_REF__/,$subresult,2); + my %analyze=&Apache::lonnet::str2hash($subresult); + if (ref($add_to_hash) eq 'HASH') { + $analyze_cache_formkeys{$key} = $add_to_hash; + } else { + $analyze_cache_formkeys{$key} = {}; + } + return $analyze_cache{$key} = \%analyze; + } + + sub get_order { + my ($partid,$respid,$symb,$uname,$udom,$no_increment,$type,$trial,$rndseed)=@_; + my $analyze = &get_analyze($symb,$uname,$udom,$no_increment,undef,$type,$trial,$rndseed); + return $analyze->{"$partid.$respid.shown"}; + } + + sub get_radiobutton_correct_foil { + my ($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed)=@_; + my $analyze = &get_analyze($symb,$uname,$udom,undef,undef,$type,$trial,$rndseed); + my $foils = &get_order($partid,$respid,$symb,$uname,$udom,undef,$type,$trial,$rndseed); + if (ref($foils) eq 'ARRAY') { + foreach my $foil (@{$foils}) { + if ($analyze->{"$partid.$respid.foil.value.$foil"} eq 'true') { + return $foil; + } + } + } + } + + sub scantron_partids_tograde { + my ($resource,$cid,$uname,$udom,$check_for_randomlist,$bubbles_per_row,$scancode) = @_; + my (%analysis,@parts); + if (ref($resource)) { + my $symb = $resource->symb(); + my $add_to_form; + if ($check_for_randomlist) { + $add_to_form = { 'check_parts_withrandomlist' => 1,}; + } + if ($scancode) { + if (ref($add_to_form) eq 'HASH') { + $add_to_form->{'code_for_randomlist'} = $scancode; + } else { + $add_to_form = { 'code_for_randomlist' => $scancode,}; + } + } + my $analyze = + &get_analyze($symb,$uname,$udom,undef,$add_to_form, + undef,undef,undef,$bubbles_per_row); + if (ref($analyze) eq 'HASH') { + %analysis = %{$analyze}; + } + if (ref($analysis{'parts'}) eq 'ARRAY') { + foreach my $part (@{$analysis{'parts'}}) { + my ($id,$respid) = split(/\./,$part); + if (!&Apache::loncommon::check_if_partid_hidden($id,$symb,$udom,$uname)) { + push(@parts,$part); + } + } + } + } + return (\%analysis,\@parts); + } + +} + +#--- 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,$type,$trial,$rndseed) = @_; + my $grayFont = ''; + if ($response =~ /^(option|rank)$/) { + my %answer=&Apache::lonnet::str2hash($answer); + my @answer = %answer; + %answer = map {&HTML::Entities::encode($_, '"<>&')} @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.''. + ''. + $bottomrow.'
'.&mt('Answer').'
'.$grayFont.&mt('Option ID').'
'; + } elsif ($response eq 'match') { + my %answer=&Apache::lonnet::str2hash($answer); + my @answer = %answer; + %answer = map {&HTML::Entities::encode($_, '"<>&')} @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.'
'.&mt('Answer').'
'.$grayFont.&mt('Item ID').'
'.$grayFont.&mt('Option ID').'
'; + } elsif ($response eq 'radiobutton') { + my %answer=&Apache::lonnet::str2hash($answer); + my @answer = %answer; + %answer = map {&HTML::Entities::encode($_, '"<>&')} @answer; + my ($toprow,$bottomrow); + my $correct = + &get_radiobutton_correct_foil($partid,$respid,$symb,$uname,$udom,$type,$trial,$rndseed); + foreach my $foil (@$order) { + if (exists($answer{$foil})) { + if ($foil eq $correct) { + $toprow.=''.&mt('true').''; + } else { + $toprow.=''.&mt('true').''; + } + } else { + $toprow.=''.&mt('false').''; + } + $bottomrow.=''.$grayFont.$foil.' '; + } + return '
'. + ''.$toprow.''. + ''. + $bottomrow.'
'.&mt('Answer').'
'.$grayFont.&mt('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 = &Apache::lontexconvert::msgtexconverted($answer); + return '

'.&keywords_highlight($answer).'
'; + } elsif ( $response eq 'organic') { + my $result=&mt('Smile representation: [_1]', + '"'.&HTML::Entities::encode($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; + } + } elsif ( $response =~ m/(?:numerical|formula|custom)/) { + # Respect multiple input fields, see Bug #5409 + $answer = + &Apache::loncommon::format_previous_attempt_value('submission', + $answer); + return $answer; + } + return &HTML::Entities::encode($answer, '"<>&'); +} + +#-- A couple of common js functions +sub commonJSfunctions { + my $request = shift; + $request->print(&Apache::lonhtmlcommon::scripttag(< 1) { + for (var i=0; i 1) { + for (var i=0; i{$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()]; + my $group = + $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; + # filter students according to status selected + if ($filterbyaccstatus && (!($stu_status =~ /Any/))) { + if (!($stu_status =~ $status)) { + delete($classlist->{$student}); + next; + } + } + # filter students according to groups selected + my @stu_groups = split(/,/,$group); + if (@getgroup) { + my $exclude = 1; + foreach my $grp (@getgroup) { + foreach my $stu_group (@stu_groups) { + if ($stu_group eq $grp) { + $exclude = 0; + } + } + if (($grp eq 'none') && !$group) { + $exclude = 0; + } + } + if ($exclude) { + delete($classlist->{$student}); + next; + } + } + if (($filterbysubmstatus) && ($submitonly ne 'all') && ($symb ne '')) { + my $udom = + $classlist->{$student}->[&Apache::loncoursedata::CL_SDOM()]; + my $uname = + $classlist->{$student}->[&Apache::loncoursedata::CL_SNAME()]; + if (($symb ne '') && ($udom ne '') && ($uname ne '')) { + if ($submitonly eq 'queued') { + my %queue_status = + &Apache::bridgetask::get_student_status($symb,$cdom,$cnum, + $udom,$uname); + if (!defined($queue_status{'gradingqueue'})) { + delete($classlist->{$student}); + next; + } + } else { + my (%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; + } + } + if (!$submitted && ($submitonly eq 'yes' || + $submitonly eq 'incorrect' || + $submitonly eq 'graded')) { + delete($classlist->{$student}); + next; + } elsif (!$graded && ($submitonly eq 'graded')) { + delete($classlist->{$student}); + next; + } elsif (!$incorrect && $submitonly eq 'incorrect') { + delete($classlist->{$student}); + next; + } + } + } + } + if ($filterbypbid) { + if (ref($possibles) eq 'HASH') { + unless (exists($possibles->{$student})) { + delete($classlist->{$student}); + next; + } + } + my $udom = + $classlist->{$student}->[&Apache::loncoursedata::CL_SDOM()]; + my $uname = + $classlist->{$student}->[&Apache::loncoursedata::CL_SNAME()]; + if (($udom ne '') && ($uname ne '')) { + my %pbinfo = &Apache::lonnet::get('nohist_'.$cdom.'_'.$cnum.'_linkprot_pb',[$filterbypbid],$udom,$uname); + if (ref($pbinfo{$filterbypbid}) eq 'ARRAY') { + $passback{$student} = $pbinfo{$filterbypbid}; + } else { + delete($classlist->{$student}); + next; + } + } + } + $section = ($section ne '' ? $section : 'none'); + if (&canview($section)) { + if (!@getsec || grep(/^\Q$section\E$/,@getsec)) { + $sections{$section}++; + if ($classlist->{$student}) { + $fullnames{$student}=$fullname; + } + } else { + delete($classlist->{$student}); + } + } else { + delete($classlist->{$student}); + } + } + my @sections = sort(keys(%sections)); + return ($classlist,\@sections,\%fullnames,\%passback); +} + +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 requested section + return 0; + } + } + } + #can't modify + return 0; +} + +sub canview { + my ($sec)=@_; + if ($perm{'vgr'}) { + if (!defined($perm{'vgr_section'})) { + # can view whole class + return 1; + } else { + if ($sec eq $perm{'vgr_section'}) { + #can view the requested section + return 1; + } else { + # can't view the requested section + return 0; + } + } + } + #can't view + return 0; +} + +#--- Retrieve the grade status of a student for all the parts +sub student_gradeStatus { + my ($symb,$udom,$uname,$partlist) = @_; + my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname); + my %partstatus = (); + foreach (@$partlist) { + my ($status,undef) = split(/_/,$record{"resource.$_.solved"},2); + $status = 'nothing' if ($status eq ''); + $partstatus{$_} = $status; + my $subkey = "resource.$_.submitted_by"; + $partstatus{$subkey} = $record{$subkey} if ($record{$subkey} ne ''); + } + return %partstatus; +} + +# hidden form and javascript that calls the form +# Use by verifyscript and viewgrades +# Shows a student's view of problem and submission +sub jscriptNform { + my ($symb) = @_; + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + my $jscript= &Apache::lonhtmlcommon::scripttag( + ' function viewOneStudent(user,domain) {'."\n". + ' document.onestudent.student.value = user;'."\n". + ' document.onestudent.userdom.value = domain;'."\n". + ' document.onestudent.submit();'."\n". + ' }'."\n". + "\n"); + $jscript.= '
'."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + ''."\n". + '
'."\n"; + 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,$symb,$uessay)=@_; + + unless ($symb) { return ''; } + + unless (ref($old_essays{$symb}) eq 'HASH') { return ''; } + +# ignore spaces and punctuation + + $uessay=~s/\W+/ /gs; + +# ignore empty submissions (occuring when only files are sent) + + unless ($uessay=~/\w+/s) { 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(%{$old_essays{$symb}})) { + my ($tname,$tdom,$tcrsid)=map {&unescape($_)} (split(/\./,$tkey)); +# ... except the same student + next if (($tname eq $uname) && ($tdom eq $udom)); + my $tessay=$old_essays{$symb}{$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=$old_essays{$symb}{$tkey}; + } + } + if ($limit>0.6) { + return ($sname,$sdom,$scrsid,$sessay,$limit); + } else { + return ('','','','',0); + } +} + +#------------------------------------------------------------------- + +#------------------------------------ Receipt Verification Routines +# + +sub initialverifyreceipt { + my ($request,$symb) = @_; + &commonJSfunctions($request); + return '
'. + &Apache::lonnet::recprefix($env{'request.course.id'}). + '-'. + ''."\n". + ''. + "
\n"; +} + +#--- Check whether a receipt number is valid.--- sub verifyreceipt { - my $request=shift; - my $courseid=$ENV{'request.course.id'}; - my $cdom=$ENV{"course.$courseid.domain"}; - my $cnum=$ENV{"course.$courseid.num"}; - my $receipt=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}).'-'. - $ENV{'form.receipt'}; - $receipt=~s/[^\-\d]//g; - my $symb=$ENV{'form.symb'}; - unless ($symb) { - $symb=&Apache::lonnet::symbread($ENV{'form.url'}); + my ($request,$symb) = @_; + + my $courseid = $env{'request.course.id'}; + my $receipt = &Apache::lonnet::recprefix($courseid).'-'. + $env{'form.receipt'}; + $receipt =~ s/[^\-\d]//g; + + 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' || + $env{"course.$courseid.receiptalg"} eq 'receipt3') { $receiptparts=1; } + my $parts=['0']; + if ($receiptparts) { + my $res_error; + ($parts)=&response_type($symb,\$res_error); + if ($res_error) { + return &navmap_errormsg(); + } } - if ((&Apache::lonnet::allowed('mgr',$courseid)) && ($symb)) { - $request->print('

Verifying Submission Receipt '.$receipt.'

'); - my $matches=0; - my (%classlist) = &getclasslist($cdom,$cnum,'0'); - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { - my ($uname,$udom)=split(/\:/,$student); - if ($receipt eq - &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb)) { - $request->print('Matching '.$student.'
'); - $matches++; - } + + my $header = + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + ' '.&mt('Fullname').' '."\n". + ' '.&mt('Username').' '."\n". + ' '.&mt('Domain').' '; + if ($receiptparts) { + $header.=' '.&mt('Problem Part').' '; + } + $header.= + &Apache::loncommon::end_data_table_header_row(); + + 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(/\:/); + foreach my $part (@$parts) { + if ($receipt eq &Apache::lonnet::ireceipt($uname,$udom,$courseid,$symb,$part)) { + $contents.= + &Apache::loncommon::start_data_table_row(). + ' '."\n". + ''.$$fullname{$_}.' '."\n". + ' '.$uname.' '. + ' '.$udom.' '; + if ($receiptparts) { + $contents.=' '.$part.' '; + } + $contents.= + &Apache::loncommon::end_data_table_row()."\n"; + + $matches++; + } + } + } + if ($matches == 0) { + $string = $title + .'

' + .&mt('No match found for the above receipt number.') + .'

'; + } else { + $string = &jscriptNform($symb).$title. + '

'. + &mt('The above receipt number matches the following [quant,_1,student].',$matches). + '

'. + $header. + $contents. + &Apache::loncommon::end_data_table()."\n"; + } + return $string; +} + +#------------------------------------------------------------------- + +#------------------------------------------- Grade Passback Routines +# + +sub initialpassback { + my ($request,$symb) = @_; + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $crstype = &Apache::loncommon::course_type(); + my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum); + my $readonly; + unless ($perm{'mgr'}) { + $readonly = 1; + } + my $formname = 'initialpassback'; + my $navmap = Apache::lonnavmaps::navmap->new(); + my $output; + if (!defined($navmap)) { + if ($crstype eq 'Community') { + $output = &mt('Unable to retrieve information about community contents'); + } else { + $output = &mt('Unable to retrieve information about course contents'); + } + return '

'.$output.'

'; + } + return &Apache::loncourserespicker::create_picker($navmap,'passback',$formname,$crstype,undef, + undef,undef,undef,undef,undef,undef, + \%passback,$readonly); +} + +sub passback_filters { + my ($request,$symb) = @_; + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $crstype = &Apache::loncommon::course_type(); + my ($launcher,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen); + if ($env{'form.passback'} ne '') { + $chosen = &unescape($env{'form.passback'}); + ($linkuri,$linkprotector,$scope) = split("\0",$chosen); + ($launcher,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen); + } + my $result; + if ($launcher ne '') { + $result = &launcher_info_box($launcher,$appname,$setter,$linkuri,$scope). + '


'.&mt('Set criteria to use to list students for possible passback of scores, then push Next [_1]', + '→'). + '

'; + } + $result .= '
'."\n". + ''."\n". + ''."\n"; + my ($submittext,$newcommand); + if ($launcher ne '') { + $submittext = &mt('Next').' →'; + $newcommand = 'passbacknames'; + $result .= &selectfield(0)."\n"; + } else { + $submittext = '← '.&mt('Previous'); + $newcommand = 'initialpassback'; + if ($env{'form.passback'}) { + $result .= ''.&mt('Invalid launcher').''."\n"; + } else { + $result .= ''.&mt('No launcher selected').''."\n"; + } + } + $result .= ''."\n". + '
'."\n". + ''."\n". + '
'."\n". + '
'."\n"; + return $result; +} + +sub names_for_passback { + my ($request,$symb) = @_; + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $crstype = &Apache::loncommon::course_type(); + my ($launcher,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen); + if ($env{'form.passback'} ne '') { + $chosen = &unescape($env{'form.passback'}); + ($linkuri,$linkprotector,$scope) = split("\0",$chosen); + ($launcher,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen); + } + my ($result,$ctr,$newcommand,$submittext); + if ($launcher ne '') { + $result = &launcher_info_box($launcher,$appname,$setter,$linkuri,$scope); + } + $ctr = 0; + my @statuses = &Apache::loncommon::get_env_multiple('form.Status'); + my $stu_status = join(':',@statuses); + $result .= '
'."\n". + ''."\n"; + if ($launcher ne '') { + $result .= ''."\n". + ''."\n"; + my ($sections,$groups,$group_display,$disabled) = §ions_and_groups(); + my $section_display = join(' ',@{$sections}); + my $status_display; + if ((grep(/^Any$/,@statuses)) || + (@statuses == 3)) { + $status_display = &mt('Any'); + } else { + $status_display = join(' '.&mt('or').' ',map { &mt($_); } @statuses); + } + $result .= '

'.&mt('Student(s) with stored passback credentials for [_1], and also satisfy:', + ''.$linkuri.''). + '

    '. + '
  • '.&mt('Section(s)').": $section_display
    • \n". + '
  • '.&mt('Group(s)').": $group_display
    • \n". + '
  • '.&mt('Status').": $status_display
    • \n". + '
'; + my ($classlist,undef,$fullname) = &getclasslist($sections,'1',$groups,'','','',$chosen); + if (keys(%$fullname)) { + $newcommand = 'passbackscores'; + $result .= &build_section_inputs(). + &checkselect_js('passbackusers'). + '


'. + &mt("To send scores, check box(es) next to the student's name(s), then push 'Send Scores'."). + '

'. + &check_script('passbackusers', 'stuinfo')."\n". + '
'."\n". + &check_buttons()."\n". + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(); + my $loop = 0; + while ($loop < 2) { + $result .= ''.&mt('No.').''.&mt('Select').''. + ''.&nameUserString('header').' '.&mt('Section/Group').''; + $loop++; + } + $result .= &Apache::loncommon::end_data_table_header_row()."\n"; + 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))) { + $ctr++; + my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; + my $udom = $classlist->{$student}->[&Apache::loncoursedata::CL_SDOM()]; + my $uname = $classlist->{$student}->[&Apache::loncoursedata::CL_SNAME()]; + if ( $perm{'vgr'} eq 'F' ) { + if ($ctr%2 ==1) { + $result.= &Apache::loncommon::start_data_table_row(); + } + $result .= ''.$ctr.' '. + ''."\n".''. + &nameUserString(undef,$$fullname{$student},$uname,$udom). + ' '.$section.($group ne '' ?'/'.$group:'').''."\n"; + + if ($ctr%2 ==0) { + $result .= &Apache::loncommon::end_data_table_row()."\n"; + } + } + } + if ($ctr%2 ==1) { + $result .= &Apache::loncommon::end_data_table_row(); + } + $result .= &Apache::loncommon::end_data_table()."\n"; + if ($ctr) { + $result .= ''."\n"; + } + } else { + $submittext = '← '.&mt('Previous'); + $newcommand = 'passback'; + $result .= ''.&mt('No students match the selection criteria').'

'; + } + } else { + $newcommand = 'initialpassback'; + $submittext = &mt('Start over'); + if ($env{'form.passback'}) { + $result .= ''.&mt('Invalid launcher').''."\n"; + } else { + $result .= ''.&mt('No launcher selected').''."\n"; + } + } + $result .= ''."\n"; + if (!$ctr) { + $result .= '
'."\n". + ''."\n". + '
'."\n"; + } + $result .= ''."\n"; + return $result; +} + +sub do_passback { + my ($request,$symb) = @_; + my $cdom = $env{"course.$env{'request.course.id'}.domain"}; + my $cnum = $env{"course.$env{'request.course.id'}.num"}; + my $crstype = &Apache::loncommon::course_type(); + my ($launcher,$appname,$setter,$linkuri,$linkprotector,$scope,$chosen); + if ($env{'form.passback'} ne '') { + $chosen = &unescape($env{'form.passback'}); + ($linkuri,$linkprotector,$scope) = split("\0",$chosen); + ($launcher,$appname,$setter) = &get_passback_launcher($cdom,$cnum,$chosen); + } + if ($launcher ne '') { + $request->print(&launcher_info_box($launcher,$appname,$setter,$linkuri,$scope)); + } + my $error; + if ($perm{'mgr'}) { + if ($launcher ne '') { + my @poss_students = &Apache::loncommon::get_env_multiple('form.stuinfo'); + if (@poss_students) { + my %possibles; + foreach my $item (@poss_students) { + my ($stuname,$studom) = split(/:/,$item,3); + $possibles{$stuname.':'.$studom} = 1; + } + my ($sections,$groups,$group_display,$disabled) = §ions_and_groups(); + my ($classlist,undef,$fullname,$pbinfo) = + &getclasslist($sections,'1',$groups,'','','',$chosen,\%possibles); + if ((ref($classlist) eq 'HASH') && (ref($pbinfo) eq 'HASH')) { + my %passback = %{$pbinfo}; + my (%tosend,%remotenotok,%scorenotok,%zeroposs,%nopbinfo); + foreach my $possible (keys(%possibles)) { + if ((exists($classlist->{$possible})) && + (exists($passback{$possible})) && (ref($passback{$possible}) eq 'ARRAY')) { + $tosend{$possible} = 1; + } + } + if (keys(%tosend)) { + my ($lti_in_use,$crsdef); + my ($ltinum,$ltitype) = ($linkprotector =~ /^(\d+)(c|d)$/); + if ($ltitype eq 'c') { + my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider'); + $lti_in_use = $crslti{$ltinum}; + $crsdef = 1; + } else { + my %domlti = &Apache::lonnet::get_domain_lti($cdom,'linkprot'); + $lti_in_use = $domlti{$ltinum}; + } + if (ref($lti_in_use) eq 'HASH') { + my $msgformat = $lti_in_use->{'passbackformat'}; + my $keynum = $lti_in_use->{'cipher'}; + my $scoretype = 'decimal'; + if ($lti_in_use->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) { + $scoretype = $1; + } + my $pbsymb = &Apache::loncommon::symb_from_tinyurl($linkuri,$cnum,$cdom); + my $pbmap; + if ($pbsymb =~ /\.(page|sequence)$/) { + $pbmap = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pbsymb))[2]); + } else { + $pbmap = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pbsymb))[0]); + } + $pbmap = &Apache::lonnet::clutter($pbmap); + my $pbscope; + if ($scope eq 'res') { + $pbscope = 'resource'; + } elsif ($scope eq 'map') { + $pbscope = 'nonrec'; + } elsif ($scope eq 'rec') { + $pbscope = 'map'; + } + my %pb = &common_passback_info(); + my $numstudents = scalar(keys(%tosend)); + my %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($request,$numstudents); + my $outcome = &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(); + my $loop = 0; + while ($loop < 2) { + $outcome .= ''.&mt('No.').''. + ''.&nameUserString('header').' '.&mt('Section/Group').''. + ''.&mt('Score').''; + $loop++; + } + $outcome .= &Apache::loncommon::end_data_table_header_row()."\n"; + my $ctr=0; + 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))) { + next unless ($tosend{$student}); + my ($uname,$udom) = split(/:/,$student); + &Apache::lonhtmlcommon::Increment_PrgWin($request,\%prog_state,'last student'); + my ($uname,$udom) = split(/:/,$student); + my $uhome = &Apache::lonnet::homeserver($uname,$udom), + my $id = $passback{$student}[0], + my $url = $passback{$student}[1], + my ($total,$possible,$usec); + if (ref($classlist->{$student}) eq 'ARRAY') { + $usec = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION]; + } + if ($pbscope eq 'resource') { + $total = 0; + $possible = 0; + my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom); + if (ref($navmap)) { + my $res = $navmap->getBySymb($pbsymb); + if (ref($res)) { + my $partlist = $res->parts(); + if (ref($partlist) eq 'ARRAY') { + my %record = &Apache::lonnet::restore($pbsymb,$env{'request.course.id'},$udom,$uname); + foreach my $part (@{$partlist}) { + next if ($record{"resource.$part.solved"} =~/^excused/); + my $weight = &Apache::lonnet::EXT("resource.$part.weight",$pbsymb,$udom,$uname,$usec); + $possible += $weight; + if (($record{'version'}) && (exists($record{"resource.$part.awarded"}))) { + my $awarded = $record{"resource.$part.awarded"}; + if ($awarded) { + $total += $weight * $awarded; + } + } + } + } + } + } + } elsif (($pbscope eq 'map') || ($pbscope eq 'nonrec')) { + ($total,$possible) = + &Apache::lonhomework::get_lti_score($uname,$udom,$pbmap,$pbscope); + } + if (($id ne '') && ($url ne '') && ($possible)) { + my ($sent,$score,$code,$result) = + &LONCAPA::ltiutils::send_grade($cdom,$cnum,$crsdef,$pb{'type'},$ltinum,$keynum,$id, + $url,$scoretype,$pb{'sigmethod'},$msgformat,$total,$possible); + my $no_passback; + if ($sent) { + if ($code == 200) { + delete($tosend{$student}); + my $namespace = $cdom.'_'.$cnum.'_lp_passback'; + my $store = { + 'score' => $score, + 'ip' => $pb{'ip'}, + 'host' => $pb{'lonhost'}, + 'protector' => $linkprotector, + 'deeplink' => $linkuri, + 'scope' => $scope, + 'url' => $url, + 'id' => $id, + 'clientip' => $pb{'clientip'}, + 'whodoneit' => $env{'user.name'}.':'.$env{'user.domain'}, + }; + my $value=''; + foreach my $key (keys(%{$store})) { + $value.=&escape($key).'='.&Apache::lonnet::freeze_escape($store->{$key}).'&'; + } + $value=~s/\&$//; + &Apache::lonnet::courselog(&escape($linkuri).':'.$uname.':'.$udom.':EXPORT:'.$value); + &Apache::lonnet::cstore({'score' => $score},$chosen,$namespace,$udom,$uname,'',$pb{'ip'},1); + $ctr++; + if ($ctr%2 ==1) { + $outcome .= &Apache::loncommon::start_data_table_row(); + } + my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; + $outcome .= ''.$ctr.' '. + ''.&nameUserString(undef,$$fullname{$student},$uname,$udom). + ' '.$section.($group ne '' ?'/'.$group:'').''. + ''.$score.''."\n"; + if ($ctr%2 ==0) { + $outcome .= &Apache::loncommon::end_data_table_row()."\n"; + } + } else { + $remotenotok{$student} = 1; + $no_passback = "Passback response for ".$linkprotector." was $code ($result)"; + &Apache::lonnet::logthis($no_passback." for $uname:$udom in ${cdom}_${cnum}"); + } + } else { + $scorenotok{$student} = 1; + $no_passback = "Passback of grades not sent for ".$linkprotector; + &Apache::lonnet::logthis($no_passback." for $uname:$udom in ${cdom}_${cnum}"); + } + if ($no_passback) { + &Apache::lonnet::log($udom,$uname,$uhome,$no_passback." score: $score; total: $total; possible: $possible"); + my $ltigrade = { + 'ltinum' => $ltinum, + 'lti' => $lti_in_use, + 'crsdef' => $crsdef, + 'cid' => $cdom.'_'.$cnum, + 'uname' => $uname, + 'udom' => $udom, + 'uhome' => $uhome, + 'pbid' => $id, + 'pburl' => $url, + 'pbtype' => $pb{'type'}, + 'pbscope' => $pbscope, + 'pbmap' => $pbmap, + 'pbsymb' => $pbsymb, + 'format' => $scoretype, + 'scope' => $scope, + 'clientip' => $pb{'clientip'}, + 'linkprot' => $linkprotector.':'.$linkuri, + 'total' => $total, + 'possible' => $possible, + 'score' => $score, + }; + &Apache::lonnet::put('linkprot_passback_pending',$ltigrade,$cdom,$cnum); + } + } else { + if (($id ne '') && ($url ne '')) { + $zeroposs{$student} = 1; + } else { + $nopbinfo{$student} = 1; + } + } + } + &Apache::lonhtmlcommon::Close_PrgWin($request,\%prog_state); + if ($ctr%2 ==1) { + $outcome .= &Apache::loncommon::end_data_table_row(); + } + $outcome .= &Apache::loncommon::end_data_table(); + if ($ctr) { + $request->print('


'.&mt('Scores sent to launcher CMS').'

'. + '

'.$outcome.'

'); + } else { + $request->print('

'.&mt('No scores sent to launcher CMS').'

'); + } + if (keys(%tosend)) { + $request->print('

'.&mt('No scores sent for following')); + my ($zeros,$nopbcreds,$noconfirm,$noscore); + 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))) { + next unless ($tosend{$student}); + my ($uname,$udom) = split(/:/,$student); + my $line = '

  • '.&nameUserString(undef,$$fullname{$student},$uname,$udom).'
    • '."\n"; + if ($zeroposs{$student}) { + $zeros .= $line; + } elsif ($nopbinfo{$student}) { + $nopbcreds .= $line; + } elsif ($remotenotok{$student}) { + $noconfirm .= $line; + } elsif ($scorenotok{$student}) { + $noscore .= $line; + } + } + if ($zeros) { + $request->print('
    '.&mt('Total points possible was 0').':'. + '
      '.$zeros.'

    '); + } + if ($nopbcreds) { + $request->print('
    '.&mt('Missing unique identifier and/or passback location').':'. + '
      '.$nopbcreds.'

    '); + } + if ($noconfirm) { + $request->print('
    '.&mt('Score receipt not confirmed by receiving CMS').':'. + '
      '.$noconfirm.'

    '); + } + if ($noscore) { + $request->print('
    '.&mt('Score computation or transmission failed').':'. + '
      '.$noscore.'

    '); + } + $request->print('

    '); + } + } else { + $error = &mt('Settings for deep-link launch target unavailable, so no scores were sent'); + } + } else { + $error = &mt('No available students for whom scores can be sent.'); + } + } else { + $error = &mt('Classlist could not be retrieved so no scores were sent.'); + } + } else { + $error = &mt('No students selected to receive scores so none were sent.'); + } + } else { + if ($env{'form.passback'}) { + $error = &mt('Deep-link launch target was invalid so no scores were sent.'); + } else { + $error = &mt('Deep-link launch target was missing so no scores were sent.'); + } + } + } else { + $error = &mt('You do not have permission to manage grades, so no scores were sent'); + } + if ($error) { + $request->print('

    '.$error.'

    '); + } + return; +} + +sub get_passback_launcher { + my ($cdom,$cnum,$chosen) = @_; + my ($linkuri,$linkprotector,$scope) = split("\0",$chosen); + my ($ltinum,$ltitype) = ($linkprotector =~ /^(\d+)(c|d)$/); + my ($appname,$setter); + if ($ltitype eq 'c') { + my %lti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider'); + if (ref($lti{$ltinum}) eq 'HASH') { + $appname = $lti{$ltinum}{'name'}; + if ($appname) { + $setter = ' (defined in course)'; + } + } + } elsif ($ltitype eq 'd') { + my %lti = &Apache::lonnet::get_domain_lti($cdom,'linkprot'); + if (ref($lti{$ltinum}) eq 'HASH') { + $appname = $lti{$ltinum}{'name'}; + if ($appname) { + $setter = ' (defined in domain)'; + } + } + } + if ($linkuri =~ m{^\Q/tiny/$cdom/\E(\w+)$}) { + my $key = $1; + my $tinyurl; + my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key); + if (defined($cached)) { + $tinyurl = $result; + } else { + my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); + my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname); + if ($currtiny{$key} ne '') { + $tinyurl = $currtiny{$key}; + &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600); + } + } + if ($tinyurl) { + my ($crsnum,$launchsymb) = split(/\&/,$tinyurl); + if ($crsnum eq $cnum) { + my %passback = &Apache::lonnet::get('nohist_linkprot_passback',[$launchsymb],$cdom,$cnum); + if (ref($passback{$launchsymb}) eq 'HASH') { + if (exists($passback{$launchsymb}{$chosen})) { + return ($launchsymb,$appname,$setter); + } + } + } + } + } + return (); +} + +sub sections_and_groups { + my (@sections,@groups,$group_display); + @groups = &Apache::loncommon::get_env_multiple('form.group'); + if (grep(/^all$/,@groups)) { + @groups = ('all'); + $group_display = 'all'; + } elsif (grep(/^none$/,@groups)) { + @groups = ('none'); + $group_display = 'none'; + } elsif (@groups > 0) { + $group_display = join(', ',@groups); + } + if ($env{'request.course.sec'} ne '') { + @sections = ($env{'request.course.sec'}); + } else { + @sections = &Apache::loncommon::get_env_multiple('form.section'); + } + my $disabled = ' disabled="disabled"'; + if ($perm{'mgr'}) { + if (grep(/^all$/,@sections)) { + undef($disabled); + } else { + foreach my $sec (@sections) { + if (&canmodify($sec)) { + undef($disabled); + last; + } + } + } + } + if (grep(/^all$/,@sections)) { + @sections = ('all'); + } + return(\@sections,\@groups,$group_display,$disabled); +} + +sub launcher_info_box { + my ($launcher,$appname,$setter,$linkuri,$scope) = @_; + my $shownscope; + if ($scope eq 'res') { + $shownscope = &mt('Resource'); + } elsif ($scope eq 'map') { + $shownscope = &mt('Folder'); + } elsif ($scope eq 'rec') { + $shownscope = &mt('Folder + sub-folders'); + } + return '

    '. + &Apache::lonhtmlcommon::start_pick_box(). + &Apache::lonhtmlcommon::row_title(&mt('Launch Item Title')). + &Apache::lonnet::gettitle($launcher). + &Apache::lonhtmlcommon::row_closure(). + &Apache::lonhtmlcommon::row_title(&mt('Deep-link')). + $linkuri. + &Apache::lonhtmlcommon::row_closure(). + &Apache::lonhtmlcommon::row_title(&mt('Launcher')). + $appname.' '.$setter. + &Apache::lonhtmlcommon::row_closure(). + &Apache::lonhtmlcommon::row_title(&mt('Score Type')). + $shownscope. + &Apache::lonhtmlcommon::row_closure(1). + &Apache::lonhtmlcommon::end_pick_box().'

    '."\n"; +} + +sub passbacks_for_symb { + my ($cdom,$cnum,$symb) = @_; + my %passback = &Apache::lonnet::dump('nohist_linkprot_passback',$cdom,$cnum); + my %needpb; + if (keys(%passback)) { + my $checkpb = 1; + if (exists($passback{$symb})) { + if (keys(%passback) == 1) { + undef($checkpb); + } + if (ref($passback{$symb}) eq 'HASH') { + foreach my $launcher (keys(%{$passback{$symb}})) { + $needpb{$launcher} = 1; + } + } + } + if ($checkpb) { + my ($map,$id,$url) = &Apache::lonnet::decode_symb($symb); + my $navmap = Apache::lonnavmaps::navmap->new(); + if (ref($navmap)) { + my $mapres = $navmap->getResourceByUrl($map); + if (ref($mapres)) { + my $mapsymb = $mapres->symb(); + if (exists($passback{$mapsymb})) { + if (keys(%passback) == 1) { + undef($checkpb); + } + if (ref($passback{$mapsymb}) eq 'HASH') { + foreach my $launcher (keys(%{$passback{$mapsymb}})) { + $needpb{$launcher} = 1; + } + } + } + my %posspb; + if ($checkpb) { + my @recurseup = $navmap->recurseup_maps($map,1); + if (@recurseup) { + map { $posspb{$_} = 1; } @recurseup; + } + } + foreach my $key (keys(%passback)) { + if (exists($posspb{$key})) { + if (ref($passback{$key}) eq 'HASH') { + foreach my $launcher (keys(%{$passback{$key}})) { + my ($linkuri,$linkprotector,$scope) = split("\0",$launcher); + next unless ($scope eq 'rec'); + $needpb{$launcher} = 1; + } + } + } + } + } + } + } + } + return %needpb; +} + +sub process_passbacks { + my ($context,$symbs,$cdom,$cnum,$udom,$uname,$weights,$awardeds,$excuseds,$needpb, + $skip_passback,$pbsave,$pbids) = @_; + if ((ref($needpb) eq 'HASH') && (ref($skip_passback) eq 'HASH') && (ref($pbsave) eq 'HASH')) { + my (%weight,%awarded,%excused); + if ((ref($symbs) eq 'ARRAY') && (ref($weights) eq 'HASH') && (ref($awardeds) eq 'HASH') && + (ref($excuseds) eq 'HASH')) { + %weight = %{$weights}; + %awarded = %{$awardeds}; + %excused = %{$excuseds}; + } + my $uhome = &Apache::lonnet::homeserver($uname,$udom); + my @launchers = keys(%{$needpb}); + my %pbinfo; + if (ref($pbids) eq 'HASH') { + %pbinfo = %{$pbids}; + } else { + %pbinfo = &Apache::lonnet::get('nohist_'.$cdom.'_'.$cnum.'_linkprot_pb',\@launchers,$udom,$uname); + } + my %pbc = &common_passback_info(); + foreach my $launcher (@launchers) { + if (ref($pbinfo{$launcher}) eq 'ARRAY') { + my $pbid = $pbinfo{$launcher}[0]; + my $pburl = $pbinfo{$launcher}[1]; + my (%total_by_symb,%possible_by_symb); + if (($pbid ne '') && ($pburl ne '')) { + next if ($skip_passback->{$launcher}); + my %pb = %pbc; + if ((exists($pbsave->{$launcher})) && + (ref($pbsave->{$launcher}) eq 'HASH')) { + foreach my $item ('lti_in_use','crsdef','ltinum','keynum','scoretype','msgformat', + 'symb','map','pbscope','linkuri','linkprotector','scope') { + $pb{$item} = $pbsave->{$launcher}{$item}; + } + } else { + my $ltitype; + ($pb{'linkuri'},$pb{'linkprotector'},$pb{'scope'}) = split("\0",$launcher); + ($pb{'ltinum'},$ltitype) = ($pb{'linkprotector'} =~ /^(\d+)(c|d)$/); + if ($ltitype eq 'c') { + my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider'); + $pb{'lti_in_use'} = $crslti{$pb{'ltinum'}}; + $pb{'crsdef'} = 1; + } else { + my %domlti = &Apache::lonnet::get_domain_lti($cdom,'linkprot'); + $pb{'lti_in_use'} = $domlti{$pb{'ltinum'}}; + } + if (ref($pb{'lti_in_use'}) eq 'HASH') { + $pb{'msgformat'} = $pb{'lti_in_use'}->{'passbackformat'}; + $pb{'keynum'} = $pb{'lti_in_use'}->{'cipher'}; + $pb{'scoretype'} = 'decimal'; + if ($pb{'lti_in_use'}->{'scoreformat'} =~ /^(decimal|ratio|percentage)$/) { + $pb{'scoretype'} = $1; + } + $pb{'symb'} = &Apache::loncommon::symb_from_tinyurl($pb{'linkuri'},$cnum,$cdom); + if ($pb{'symb'} =~ /\.(page|sequence)$/) { + $pb{'map'} = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pb{'symb'}))[2]); + } else { + $pb{'map'} = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($pb{'symb'}))[0]); + } + $pb{'map'} = &Apache::lonnet::clutter($pb{'map'}); + if ($pb{'scope'} eq 'res') { + $pb{'pbscope'} = 'resource'; + } elsif ($pb{'scope'} eq 'map') { + $pb{'pbscope'} = 'nonrec'; + } elsif ($pb{'scope'} eq 'rec') { + $pb{'pbscope'} = 'map'; + } + foreach my $item ('lti_in_use','crsdef','ltinum','keynum','scoretype','msgformat', + 'symb','map','pbscope','linkuri','linkprotector','scope') { + $pbsave->{$launcher}{$item} = $pb{$item}; + } + } else { + $skip_passback->{$launcher} = 1; + } + } + if (ref($symbs) eq 'ARRAY') { + foreach my $symb (@{$symbs}) { + if ((ref($weight{$symb}) eq 'HASH') && (ref($awarded{$symb}) eq 'HASH') && + (ref($excused{$symb}) eq 'HASH')) { + foreach my $part (keys(%{$weight{$symb}})) { + if ($excused{$symb}{$part}) { + next; + } + my $partweight = $weight{$symb}{$part} eq '' ? 1 : + $weight{$symb}{$part}; + if ($awarded{$symb}{$part}) { + $total_by_symb{$symb} += $partweight * $awarded{$symb}{$part}; + } + $possible_by_symb{$symb} += $partweight; + } + } + } + } + if ($context eq 'updatebypage') { + my $ltigrade = { + 'ltinum' => $pb{'ltinum'}, + 'lti' => $pb{'lti_in_use'}, + 'crsdef' => $pb{'crsdef'}, + 'cid' => $cdom.'_'.$cnum, + 'uname' => $uname, + 'udom' => $udom, + 'uhome' => $uhome, + 'pbid' => $pbid, + 'pburl' => $pburl, + 'pbtype' => $pb{'type'}, + 'pbscope' => $pb{'pbscope'}, + 'pbmap' => $pb{'map'}, + 'pbsymb' => $pb{'symb'}, + 'format' => $pb{'scoretype'}, + 'scope' => $pb{'scope'}, + 'clientip' => $pb{'clientip'}, + 'linkprot' => $pb{'linkprotector'}.':'.$pb{'linkuri'}, + 'total_s' => \%total_by_symb, + 'possible_s' => \%possible_by_symb, + }; + push(@Apache::lonhomework::ltipassback,$ltigrade); + next; + } + my ($total,$possible); + if ($pb{'pbscope'} eq 'resource') { + $total = $total_by_symb{$pb{'symb'}}; + $possible = $possible_by_symb{$pb{'symb'}}; + } elsif (($pb{'pbscope'} eq 'map') || ($pb{'pbscope'} eq 'nonrec')) { + ($total,$possible) = + &Apache::lonhomework::get_lti_score($uname,$udom,$pb{'map'},$pb{'pbscope'}, + \%total_by_symb,\%possible_by_symb); + } + if (!$possible) { + $total = 0; + $possible = 1; + } + my ($sent,$score,$code,$result) = + &LONCAPA::ltiutils::send_grade($cdom,$cnum,$pb{'crsdef'},$pb{'type'},$pb{'ltinum'}, + $pb{'keynum'},$pbid,$pburl,$pb{'scoretype'},$pb{'sigmethod'}, + $pb{'msgformat'},$total,$possible); + my $no_passback; + if ($sent) { + if ($code == 200) { + my $namespace = $cdom.'_'.$cnum.'_lp_passback'; + my $store = { + 'score' => $score, + 'ip' => $pb{'ip'}, + 'host' => $pb{'lonhost'}, + 'protector' => $pb{'linkprotector'}, + 'deeplink' => $pb{'linkuri'}, + 'scope' => $pb{'scope'}, + 'url' => $pburl, + 'id' => $pbid, + 'clientip' => $pb{'clientip'}, + 'whodoneit' => $env{'user.name'}.':'.$env{'user.domain'}, + }; + my $value=''; + foreach my $key (keys(%{$store})) { + $value.=&escape($key).'='.&Apache::lonnet::freeze_escape($store->{$key}).'&'; + } + $value=~s/\&$//; + &Apache::lonnet::courselog(&escape($pb{'linkuri'}).':'.$uname.':'.$udom.':EXPORT:'.$value); + &Apache::lonnet::cstore({'score' => $score},$launcher,$namespace,$udom,$uname,'',$pb{'ip'},1); + } else { + $no_passback = 1; + } + } else { + $no_passback = 1; + } + if ($no_passback) { + &Apache::lonnet::log($udom,$uname,$uhome,$no_passback." score: $score; total: $total; possible: $possible"); + my $ltigrade = { + 'ltinum' => $pb{'ltinum'}, + 'lti' => $pb{'lti_in_use'}, + 'crsdef' => $pb{'crsdef'}, + 'cid' => $cdom.'_'.$cnum, + 'uname' => $uname, + 'udom' => $udom, + 'uhome' => $uhome, + 'pbid' => $pbid, + 'pburl' => $pburl, + 'pbtype' => $pb{'type'}, + 'pbscope' => $pb{'pbscope'}, + 'pbmap' => $pb{'map'}, + 'pbsymb' => $pb{'symb'}, + 'format' => $pb{'scoretype'}, + 'scope' => $pb{'scope'}, + 'clientip' => $pb{'clientip'}, + 'linkprot' => $pb{'linkprotector'}.':'.$pb{'linkuri'}, + 'total' => $total, + 'possible' => $possible, + 'score' => $score, + }; + &Apache::lonnet::put('linkprot_passback_pending',$ltigrade,$cdom,$cnum); + } + } + } + } + } + return; +} + +sub common_passback_info { + my %pbc = ( + sigmethod => 'HMAC-SHA1', + type => 'linkprot', + clientip => &Apache::lonnet::get_requestor_ip(), + lonhost => $Apache::lonnet::perlvar{'lonHostID'}, + ip => &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}), + ); + return %pbc; +} + +#--- This is called by a number of programs. +#--- Called from the Grading Menu - View/Grade an individual student +#--- Also called directly when one clicks on the subm button +# on the problem page. +sub listStudents { + my ($request,$symb,$submitonly,$divforres) = @_; + + 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 $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(&checkselect_js()); + $request->print(&Apache::lonhtmlcommon::scripttag(<print($result); + + my $gradeTable='
    '. + "\n".$table; + + $gradeTable .= &Apache::lonhtmlcommon::start_pick_box(); + unless ($is_tool) { + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Problem Text')) + .''."\n" + .''."\n" + .'
    '."\n" + .&Apache::lonhtmlcommon::row_closure(); + $gradeTable .= &Apache::lonhtmlcommon::row_title(&mt('View Answer')) + .''."\n" + .''."\n" + .'
    '."\n" + .&Apache::lonhtmlcommon::row_closure(); + } + + my $stu_status = join(':',&Apache::loncommon::get_env_multiple('form.Status')); + my $saveStatus = $stu_status eq '' ? 'Active' : $stu_status; + $env{'form.Status'} = $saveStatus; + my %optiontext; + if ($is_tool) { + %optiontext = &Apache::lonlocal::texthash ( + lastonly => 'last transaction', + last => 'last transaction with details', + datesub => 'all transactions', + all => 'all transactions with details', + ); + } else { + %optiontext = &Apache::lonlocal::texthash ( + lastonly => 'last submission', + last => 'last submission with details', + datesub => 'all submissions', + all => 'all submissions with details', + ); + } + my $submission_options = + ''. + ''."\n". + ''. + ''."\n". + ''. + ''."\n". + ''. + ''; + my $viewtitle; + if ($is_tool) { + $viewtitle = &mt('View Transactions'); + } else { + $viewtitle = &mt('View Submissions'); + } + my ($compmsg,$nocompmsg); + $nocompmsg = ' checked="checked"'; + if ($numessay) { + $compmsg = $nocompmsg; + $nocompmsg = ''; + } + $gradeTable .= &Apache::lonhtmlcommon::row_title($viewtitle) + .$submission_options; +# Check if any gradable + my $showmore; + if ($perm{'mgr'}) { + my @sections; + if ($env{'request.course.sec'} ne '') { + @sections = ($env{'request.course.sec'}); + } elsif ($env{'form.section'} eq '') { + @sections = ('all'); + } else { + @sections = &Apache::loncommon::get_env_multiple('form.section'); } - $request->printf('

    '.$matches." match%s

    ",$matches <= 1 ? '' : 'es'); + if (grep(/^all$/,@sections)) { + $showmore = 1; + } else { + foreach my $sec (@sections) { + if (&canmodify($sec)) { + $showmore = 1; + last; + } + } + } + } + + if ($showmore) { + $gradeTable .= + &Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Send Messages')) + .'' + .'' + .'' + .&Apache::lonhtmlcommon::row_closure(); + + $gradeTable .= + &Apache::lonhtmlcommon::row_title(&mt('Grading Increments')) + .''; } + $gradeTable .= + &build_section_inputs(). + ''."\n". + ''."\n". + ''."\n"; + if (exists($env{'form.Status'})) { + $gradeTable .= ''."\n"; + } else { + $gradeTable .= &Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Student Status')) + .&Apache::lonhtmlcommon::StatusOptions( + $saveStatus,undef,1,'javascript:reLoadList(this.form);'); + } + if ($numessay) { + $gradeTable .= &Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title(&mt('Check For Plagiarism')) + .''; + } + $gradeTable .= &Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box(); + my $regrademsg; + if ($is_tool) { + $regrademsg =&mt("To view/grade/regrade, click on the check box(es) next to the student's name(s). Then click on the Next button."); + } else { + $regrademsg = &mt("To view/grade/regrade 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."); + } + $gradeTable .= '

    ' + .$regrademsg."\n" + .'' + .'

    '; + +# checkall buttons + $gradeTable.=&check_script('gradesub', 'stuinfo'); + $gradeTable.='
    '."\n"; + $gradeTable.=&check_buttons(); + my ($classlist, undef, $fullname) = &getclasslist($getsec,'1',$getgroup); + $gradeTable.= &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(); + my $loop = 0; + while ($loop < 2) { + $gradeTable.=''.&mt('No.').''.&mt('Select').''. + ''.&nameUserString('header').' '.&mt('Section/Group').''; + if (($submitonly ne 'queued') && ($submitonly ne 'all')) { + foreach my $part (sort(@$partlist)) { + my $display_part= + &get_display_part((split(/_/,$part))[0],$symb); + $gradeTable.= + ''.&mt('Part: [_1] Status',$display_part).''; + } + } elsif ($submitonly eq 'queued') { + $gradeTable.=''.&mt('Queue Status').' '; + } + $loop++; +# $gradeTable.='' if ($loop%2 ==1); + } + $gradeTable.=&Apache::loncommon::end_data_table_header_row()."\n"; + + my $ctr = 0; + 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 = (); + + 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 (($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'); + } + + $ctr++; + my $section = $classlist->{$student}->[&Apache::loncoursedata::CL_SECTION()]; + my $group = $classlist->{$student}->[&Apache::loncoursedata::CL_GROUP()]; + if ( $perm{'vgr'} eq 'F' ) { + if ($ctr%2 ==1) { + $gradeTable.= &Apache::loncommon::start_data_table_row(); + } + $gradeTable.=''.$ctr.' '. + ''."\n".''. + &nameUserString(undef,$$fullname{$student},$uname,$udom). + ' '.$section.($group ne '' ?'/'.$group:'').''."\n"; + + if ($submitonly ne 'all') { + foreach (sort(keys(%status))) { + next if ($_ =~ /^resource.*?submitted_by$/); + $gradeTable.=' '.&mt($status{$_}).' '."\n"; + } + } +# $gradeTable.='' if ($ctr%2 ==1); + if ($ctr%2 ==0) { + $gradeTable.=&Apache::loncommon::end_data_table_row()."\n"; + } + } + } + if ($ctr%2 ==1) { + $gradeTable.='   '; + if (($submitonly ne 'queued') && ($submitonly ne 'all')) { + foreach (@$partlist) { + $gradeTable.=' '; + } + } elsif ($submitonly eq 'queued') { + $gradeTable.=' '; + } + $gradeTable.=&Apache::loncommon::end_data_table_row(); + } + + $gradeTable.=&Apache::loncommon::end_data_table()."\n". + ''."\n"; + if ($ctr == 0) { + my $num_students=(scalar(keys(%$fullname))); + if ($num_students eq 0) { + $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'; } + 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="checked"/; + } + $request->print($gradeTable); return ''; } -sub receiptInput { - my ($request) = shift; - my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"}; - my $hostver=unpack("%32C*",$Apache::lonnet::perlvar{'lonHostID'}); - $request->print(<Verify a Submission Receipt Issued by this Server -
    -$hostver- - - -ENDHEADER - if ($ENV{'form.url'}) { - $request->print( - ''); - } - if ($ENV{'form.symb'}) { - $request->print( - ''); - } -# $request->print(<print(''); +#---- Called from the listStudents and the names_for_passback routines. + +sub checkselect_js { + my ($formname) = @_; + if ($formname eq '') { + $formname = 'gradesub'; + } + my %js_lt; + if ($formname eq 'passbackusers') { + %js_lt = &Apache::lonlocal::texthash ( + 'multiple' => 'Please select a student or group of students before pushing the Save Scores button.', + 'single' => 'Please select the student before pushing the Save Scores button.', + ); + } else { + %js_lt = &Apache::lonlocal::texthash ( + 'multiple' => 'Please select a student or group of students before clicking on the Next button.', + 'single' => 'Please select the student before clicking on the Next button.', + ); + } + &js_escape(\%js_lt); + return &Apache::lonhtmlcommon::scripttag(< 1) { + for (var i=0; i0) { + document.forms.'.$form.'.elements[i].checked=true; + } + } + } + + + function uncheckall() { + for (i=0; i'; + $buttons.=' '; + $buttons.=''; + $buttons.=' '; + return $buttons; +} + +# Displays the submissions for one student or a group of students +sub processGroup { + my ($request,$symb) = @_; + my $ctr = 0; + my @stuchecked = &Apache::loncommon::get_env_multiple('form.stuinfo'); + my $total = scalar(@stuchecked)-1; + + 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,$symb); + $ctr++; + } return ''; } -sub listStudents { - my ($request) = shift; - my $cdom=$ENV{"course.$ENV{'request.course.id'}.domain"}; - my $cnum=$ENV{"course.$ENV{'request.course.id'}.num"}; - - $request->print(<Show Student Submissions on Assessment - -
    - - - - -ENDTABLEST - my (%classlist) = &getclasslist($cdom,$cnum,'0'); - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { - my ($sname,$sdom) = split(/:/,$student); - - my %name=&Apache::lonnet::get('environment', ['lastname','generation', - 'firstname','middlename'], - $sdom,$sname); - my $fullname; - my ($tmp) = keys(%name); - if ($tmp !~ /^(con_lost|error|no_such_host)/i) { - $fullname=$name{'lastname'}.$name{'generation'}; - if ($fullname =~ /[^\s]+/) { $fullname.=', '; } - $fullname.=$name{'firstname'}.' '.$name{'middlename'}; +#------------------------------------------------------------------------------------ +# +#-------------------------- Next few routines handles grading by student, essentially +# handles essay response type problem/part +# +#--- Javascript to handle the submission page functionality --- +sub sub_page_js { + my $request = shift; + my $alertmsg = &mt('A number equal or greater than 0 is expected. Entered value = '); + &js_escape(\$alertmsg); + $request->print(&Apache::lonhtmlcommon::scripttag(< weight) { + var resp = confirm("You entered a value ("+pts+ + ") greater than the weight for the part. Accept?"); + if (resp == false) { + gradeBox.value = oldpts; + return; + } + } + + for (var i=0; idir_config('lonIconsURL'); + &commonJSfunctions($request); + + my $inner_js_msg_central= (< + function checkInput() { + opener.document.SCORE.msgsub.value = opener.checkEntities(document.msgcenter.msgsub.value); + var nmsg = opener.document.SCORE.savemsgN.value; + var usrctr = document.msgcenter.usrctr.value; + var newval = opener.document.SCORE["newmsg"+usrctr]; + newval.value = opener.checkEntities(document.msgcenter.newmsg.value); + + var msgchk = ""; + if (document.msgcenter.subchk.checked) { + msgchk = "msgsub,"; } - if ( $Apache::grades::viewgrades eq 'F' ) { - $request->print("\n".''."". - ''); - if ($ENV{'form.url'}) { - $request->print( - ''); - } - if ($ENV{'form.symb'}) { - $request->print( - ''); - } - $request->print( - ''); - $request->print( - ''); - $request->print( - ''); - $request->print( - ''); - $request->print(''); - $request->print(''); - $request->print( - ''); -# $request->print(''); + var includemsg = 0; + for (var i=1; i<=nmsg; i++) { + var opnmsg = opener.document.SCORE["savemsg"+i]; + var frmmsg = document.msgcenter["msg"+i]; + opnmsg.value = opener.checkEntities(frmmsg.value); + var showflg = opener.document.SCORE["shownOnce"+i]; + showflg.value = "1"; + var chkbox = document.msgcenter["msgn"+i]; + if (chkbox.checked) { + msgchk += "savemsg"+i+","; + includemsg = 1; + } } - } - $request->print('
    Resource: $ENV{'form.url'}
    UsernameNameDomainView ProblemSubmissionsAction
    $sname$fullname$sdom
    '. - ' no '. - ' yes '. - ' last '. - ' all '); - $request->print('
    '); -} + if (document.msgcenter.newmsgchk.checked) { + msgchk += "newmsg"+usrctr; + includemsg = 1; + } + imgformname = opener.document.SCORE["mailicon"+usrctr]; + imgformname.src = "$iconpath/"+((includemsg) ? "mailto.gif" : "mailbkgrd.gif"); + var includemsg = opener.document.SCORE["includemsg"+usrctr]; + includemsg.value = msgchk; + self.close() -#FIXME - needs to handle multiple matches -sub finduser { - my ($name) = @_; - my $domain = ''; - - if ( $Apache::grades::viewgrades eq 'F' ) { - #get classlist - my ($cdom,$cnum) = split(/_/,$ENV{'request.course.id'}); - #print "Found $cdom:$cnum
    "; - my (%classlist) = &getclasslist($cdom,$cnum,'0'); - foreach my $student ( sort(@{ $classlist{'allids'} }) ) { - my ($posname,$posdomain) = split(/:/,$student); - if ($posname =~ $name) { $name=$posname; $domain=$posdomain; last; } - } - return ($name,$domain); - } else { - return ($ENV{'user.name'},$ENV{'user.domain'}); + } + +INNERJS + + my $start_page_msg_central = + &Apache::loncommon::start_page('Message Central',$inner_js_msg_central, + {'js_ready' => 1, + 'only_body' => 1, + 'bgcolor' =>'#FFFFFF',}); + my $end_page_msg_central = + &Apache::loncommon::end_page({'js_ready' => 1}); + + my $docopen=&Apache::lonhtmlcommon::javascript_docopen(); + $docopen=~s/^document\.//; + + my %html_js_lt = &Apache::lonlocal::texthash( + comp => 'Compose Message for: ', + incl => 'Include', + type => 'Type', + subj => 'Subject', + mesa => 'Message', + new => 'New', + save => 'Save', + canc => 'Cancel', + ); + &html_escape(\%html_js_lt); + &js_escape(\%html_js_lt); + $request->print(&Apache::lonhtmlcommon::scripttag(<\n"; - next; +//====================== Script for composing message ============== + // preload images + img1 = new Image(); + img1.src = "$iconpath/mailbkgrd.gif"; + img2 = new Image(); + img2.src = "$iconpath/mailto.gif"; + + function msgCenter(msgform,usrctr,fullname) { + var Nmsg = msgform.savemsgN.value; + savedMsgHeader(Nmsg,usrctr,fullname); + var subject = msgform.msgsub.value; + var msgchk = document.SCORE["includemsg"+usrctr].value; + re = /msgsub/; + var shwsel = ""; + if (re.test(msgchk)) { shwsel = "checked" } + subject = (document.SCORE.shownSub.value == 0 ? checkEntities(subject) : subject); + displaySubject(checkEntities(subject),shwsel); + for (var i=1; i<=Nmsg; i++) { + var testmsg = "savemsg"+i+","; + re = new RegExp(testmsg,"g"); + shwsel = ""; + if (re.test(msgchk)) { shwsel = "checked" } + 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!! } - #print "record=$record
    "; - push( @{ $classlist{'allids'} }, $student); + newmsg = document.SCORE["newmsg"+usrctr].value; + shwsel = ""; + re = /newmsg/; + if (re.test(msgchk)) { shwsel = "checked" } + newMsg(newmsg,shwsel); + msgTail(); + return; } - return (%classlist); -} -sub getpartlist { - my ($url) = @_; - my @parts =(); - my (@metakeys) = split(/,/,&Apache::lonnet::metadata($url,'keys')); - foreach my $key (@metakeys) { - if ( $key =~ m/stores_([0-9]+)_.*/) { - push(@parts,$key); + 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); } - return @parts; + + function savedMsgHeader(Nmsg,usrctr,fullname) { + var height = 70*Nmsg+250; + if (height > 600) { + height = 600; + } + 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=yes,screenx='+xpos+',screeny='+ypos+',width=700,height='+height); + pWin.focus(); + pDoc = pWin.document; + pDoc.$docopen; + pDoc.write('$start_page_msg_central'); + + pDoc.write("
    "); + pDoc.write(""); + pDoc.write("

     $html_js_lt{'comp'}\"+fullname+\"<\\/h1>"); + + pDoc.write(''); + pDoc.write(""); + pDoc.write("\n"; - foreach my $part (@parts) { - my ($temp,$part,$type)=split(/_/,$part); - my $score=$record{"resource.$part.$type"}; - if ($type eq 'awarded' || $type eq 'tries') { - $result.=''."\n"; - } elsif ($type eq 'solved') { - my ($status,$foo)=split(/_/,$score,2); - $result.="\n"; - } - } - $result.=''; - return $result; -} - -#FIXME need to look at the metadata spec on what type of data to accept and provide an -#interface based on that, also do that to above function. -sub setstudentgrade { - my ($url,$symb,$courseid,$student,@parts) = @_; - - my $result =''; - my ($stuname,$domain) = split(/:/,$student); - my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$stuname); - my %newrecord; - - foreach my $part (@parts) { - my ($temp,$part,$type)=split(/_/,$part); - my $oldscore=$record{"resource.$part.$type"}; - my $newscore=$ENV{"form.GRADE.$student.$part.$type"}; - if ($type eq 'solved') { - my $update=0; - if ($newscore eq 'nothing' ) { - if ($oldscore ne '') { - $update=1; - $newscore = ''; - } - } elsif ($oldscore !~ m/^$newscore/) { - $update=1; - $result.="Updating $stuname to $newscore
    \n"; - if ($newscore eq 'correct') { $newscore = 'correct_by_override'; } - if ($newscore eq 'incorrect') { $newscore = 'incorrect_by_override'; } - if ($newscore eq 'excused') { $newscore = 'excused'; } - if ($newscore eq 'ungraded') { $newscore = 'ungraded_attempted'; } - } else { - #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:
    \n"; - } - if ($update) { $newrecord{"resource.$part.$type"}=$newscore; } - } else { - if ($oldscore ne $newscore) { - $newrecord{"resource.$part.$type"}=$newscore; - $result.="Updating $student"."'s status for $part.$type to $newscore
    \n"; - } else { - #$result.="$stuname:$part:$type:unchanged $oldscore to $newscore:
    \n"; + function displaySavedMsg(ctr,msg,shwsel) { + pDoc = pWin.document; + pDoc.write("    "); + pDoc.write("
    $html_js_lt{'incl'}<\\/b><\\/td>$html_js_lt{'type'}<\\/b><\\/td>$html_js_lt{'mesa'}<\\/td><\\/tr>"); +} + function displaySubject(msg,shwsel) { + pDoc = pWin.document; + pDoc.write("
    <\\/td>"); + pDoc.write("$html_js_lt{'subj'}<\\/td>"); + pDoc.write("<\\/td><\\/tr>"); } -sub viewstudentgrade { - my ($url,$symb,$courseid,$student,@parts) = @_; - my $result =''; - my $cellclr = '"#ffffdd"'; - my ($username,$domain) = split(/:/,$student); - - my (@requests) = ('lastname','firstname','middlename','generation'); - my (%name) = &Apache::lonnet::get('environment',\@requests,$domain,$username); - my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$username); - my $fullname=$name{'lastname'}.$name{'generation'}; - if ($fullname =~ /[^\s]+/) { $fullname.=', '; } - $fullname.=$name{'firstname'}.' '.$name{'middlename'}; - - $result.="
    $username$fullname$domain
    <\\/td>"); + pDoc.write(""+ctr+"<\\/td>"); + pDoc.write("