loncom/interface/lonquickgrades.pm - view

File: [LON-CAPA] / loncom / interface / lonquickgrades.pm
Revision 1.49.6.8.2.6: download - view: text, annotated - select for diffs
Thu Jan 16 21:11:56 2025 UTC (3 weeks ago) by raeburn
Branches: version_2_11_4_msu
CVS tags: version_2_11_6_msu
Diff to branchpoint 1.49.6.8: preferred, unified

- For 2.11.4 (modified)
  Include changes in 1.128 (part).

# The LearningOnline Network with CAPA # Quick Student Grades Display # # $Id: lonquickgrades.pm,v 1.49.6.8.2.6 2025/01/16 21:11:56 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # package Apache::lonquickgrades; use strict; use Apache::Constants qw(:common :http REDIRECT); use POSIX; use Apache::loncommon; use Apache::lonlocal; use Apache::lonnet; use Apache::grades; use Apache::lonuserstate; sub handler { my $r = shift; return real_handler($r); } sub real_handler { my $r = shift; &Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING}); # Handle header-only request if ($env{'browser.mathml'}) { &Apache::loncommon::content_type($r,'text/xml'); } else { &Apache::loncommon::content_type($r,'text/html'); } if ($r->header_only) { $r->send_http_header; return OK; } my $cangrade=&Apache::lonnet::allowed('mgr'); my $showPoints = $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard'; my $reinitresult; if ($env{'request.course.id'}) { my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; my $clientip = &Apache::lonnet::get_requestor_ip($r); my ($blocked,$blocktext) = &Apache::loncommon::blocking_status('grades',$clientip,$cnum,$cdom); if ($blocked) { my $checkrole = "cm./$cdom/$cnum"; if ($env{'request.course.sec'} ne '') { $checkrole .= "/$env{'request.course.sec'}"; } unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) && ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) { &grades_blocked($r,$blocktext,$showPoints); return OK; } } } unless ($cangrade) { # Check for critical messages and redirect if present. my ($redirect,$url) = &Apache::loncommon::critical_redirect(300,'grades'); if ($redirect) { &Apache::loncommon::content_type($r,'text/html'); $r->header_out(Location => $url); return REDIRECT; } # Check if course needs to be re-initialized my $loncaparev = $r->dir_config('lonVersion'); ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev); if ($reinitresult eq 'switch') { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; $r->print(&Apache::loncommon::check_release_result(@reinit)); return OK; } my ($cid,$cnum,$cdom); if ($reinitresult) { $cid = $env{'request.course.id'}; $cnum = $env{'course.'.$cid.'.num'}; $cdom = $env{'course.'.$cid.'.domain'}; } if (($reinitresult eq 'main') || ($reinitresult eq 'both')) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; &startpage($r,$showPoints); my $preamble = '<div id="LC_update_'.$cid.'" class="LC_info">'. '<br />'. &mt('Your course session is being updated because of recent changes by course personnel.'). ' '.&mt('Please be patient').'.<br /></div>'. '<div style="padding:0;clear:both;margin:0;border:0"></div>'; my %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($r,undef,$preamble); &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Updating course')); $r->rflush(); my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum"); &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Finished!')); &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); my $closure = <<ENDCLOSE; <script type="text/javascript"> // <![CDATA[ \$("#LC_update_$cid").hide('slow'); // ]]> </script> ENDCLOSE if ($ferr) { $r->print($closure.&Apache::loncommon::end_page()); my $requrl = $r->uri; $env{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; $env{'user.reinit'} = 1; return HTTP_NOT_ACCEPTABLE; } else { $r->print($closure); } } if (($reinitresult eq 'supp') || ($reinitresult eq 'both')) { my $possdel; if ($reinitresult eq 'supp') { $possdel = 1; } my ($supplemental,$refs_updated) = &Apache::loncommon::get_supplemental($cnum,$cdom,'',$possdel); unless ($refs_updated) { &Apache::loncommon::set_supp_httprefs($cnum,$cdom,$supplemental); } } } unless (($reinitresult eq 'main') || ($reinitresult eq 'both')) { # Send header, don't cache this page &Apache::loncommon::no_cache($r); $r->send_http_header; &startpage($r,$showPoints); } $r->rflush(); &startGradeScreen($r); # # Pick student # my $uname; my $udom; my $stdid; if ($cangrade) { if ($env{'form.uname'}) { $uname=$env{'form.uname'}; } if ($env{'form.udom'}) { $udom=$env{'form.udom'}; } if ($env{'form.id'}) { $stdid=$env{'form.id'}; } if (($stdid) && ($udom)) { $uname=(&Apache::lonnet::idget($udom,[$stdid],'ids'))[1]; } if (($stdid) && (!$uname)) { $r->print('<p><span class="LC_warning">'.&mt("Unknown Student/Employee ID: [_1]",$stdid).'</span></p>'); $stdid=''; } if (($uname eq '') && ($udom eq '')) { $uname = $env{'user.name'}; $udom = $env{'user.domain'}; } $r->print('<form method="post" name="quickform" action="/adm/quickgrades">'); my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '. &Apache::loncommon::selectstudent_link('quickform','uname','udom'); $r->print("<p>\n".&Apache::loncommon::studentbrowser_javascript()."\n"); $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]' ,'<input type="text" value="'.$uname.'" size="12" name="uname" />' ,'<input type="text" value="'.$stdid.'" size="12" name="id" /> ' ,$chooseopt). '  <input type="submit" name="display" value="'.&mt('Display Individual Student').'" /></p>'); if (($uname) && ($udom)) { $r->print('<p>'.&mt('Full Name: [_1]',&Apache::loncommon::plainname($uname,$udom)).'</p>'); } } else { $r->print('<p class="LC_info">'.&mt('This may take a few moments to display.').'</p>'); } $r->rflush(); my $notshowTotals= $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'; my $usec; if ($cangrade) { if (($uname eq $env{'user.name'}) && ($udom eq $env{'user.domain'})) { $usec = $env{'request.course.sec'}; } else { $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'}); } } else { $usec = $env{'request.course.sec'}; } my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts, $topLevelRight,$topLevelAttempted) = &getData($showPoints,$uname,$udom,$usec); if (ref($navmap)) { my $nostdtotals; if ($showPoints) { if ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard') { my $hidetotals = $env{'course.'.$env{'request.course.id'}.'.hidetotals'}; if ($hidetotals eq 'all') { $nostdtotals = 1; } elsif ($hidetotals ne '') { if ($usec ne '') { my %secnototals; map { $secnototals{$_} = 1; } split(/,/,$hidetotals); if ($secnototals{$usec}) { $nostdtotals = 1; } } } } } &outputTable($r,$showPoints,$notshowTotals,$nostdtotals,$navmap, $totalParts,$totalPossible,$totalRight,$totalAttempted, $topLevelParts,$topLevelRight,$topLevelAttempted); } else { if ($cangrade) { $r->print("\n</form>\n"); } my $requrl = $r->uri; $env{'user.error.msg'} = "$requrl:bre:0:0:Navmap initialization failed."; return HTTP_NOT_ACCEPTABLE; } if ($cangrade) { $r->print("\n</form>\n"); } &endGradeScreen($r); return OK; } sub grades_blocked { my ($r,$blocktext,$caller) = @_; my $title = 'Points Display'; if ($caller eq 'spreadsheet') { $title = 'Spreadsheet'; } elsif ($env{'course.'.$env{'request.course.id'}.'.grading'} ne 'standard') { $title = 'Completed Problems Display'; } my $brcrum = [{href=>"/adm/quickgrades",text => $title}]; &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/quickgrades', text=> $title}); my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs($title); &Apache::loncommon::content_type($r,'text/html'); &Apache::loncommon::no_cache($r); $r->send_http_header; $r->print(&Apache::loncommon::start_page($title). $breadcrumbs. $blocktext. &Apache::loncommon::end_page()); return; } # # Go through the complete course and collect data # sub getData { my ($showPoints,$uname,$udom,$usec)=@_; # Create the nav map my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom,$usec); if (!defined($navmap)) { return (); } my $res = $navmap->firstResource(); # temp resource to access constants my $iterator = $navmap->getIterator(undef, undef, undef, 1); my $depth = 1; $iterator->next(); # ignore first BEGIN_MAP my $curRes = $iterator->next(); # General overview of the following: Walk along the course resources. # For every problem in the resource, tell its parent maps how many # parts and how many parts correct it has. After that, each map will # have a count of the total parts underneath it, correct and otherwise. # After that, we will walk through the course again and read off # maps in order, with their data. # (If in the future people decide not to be cumulative, only add # the counts to the parent map.) # For convenience, "totalParts" is also "totalPoints" when we're looking # at points; I can't come up with a variable name that makes sense # equally for both cases. my $totalParts = 0; my $totalPossible = 0; my $totalRight = 0; my $totalAttempted = 0; my $now = time(); my $topLevelParts = 0; my $topLevelRight = 0; my $topLevelAttempted = 0; # Pre-run: Count parts correct while ( $depth > 0 ) { if ($curRes == $iterator->BEGIN_MAP()) {$depth++;} if ($curRes == $iterator->END_MAP()) { $depth--; } if (ref($curRes) && $curRes->is_gradable() && !$curRes->randomout) { # Get number of correct, incorrect parts my $parts = $curRes->parts(); my $partsRight = 0; my $partsCount = 0; my $partsAttempted = 0; my $stack = $iterator->getStack(); for my $part (@{$parts}) { my $dateStatus = $curRes->getDateStatus($part); my $weight = $curRes->weight($part); my $problemstatus = $curRes->problemstatus($part); if ($curRes->solved($part) eq 'excused') { next; } if ($showPoints) { my $score = 0; # If we're not telling status and the answer date isn't passed yet, # it's an "attempted" point if ((($problemstatus eq 'no') || ($problemstatus eq 'no_feedback_ever')) && ($dateStatus != $curRes->ANSWER_OPEN)) { my $status = $curRes->simpleStatus($part); if ($status == $curRes->ATTEMPTED) { $partsAttempted += $weight; $totalAttempted += $partsAttempted; } } else { $score = &Apache::grades::compute_points($weight, $curRes->awarded($part)); } $partsRight += $score; $totalRight += $score; $partsCount += $weight; if ($curRes->opendate($part) < $now) { $totalPossible += $weight; } $totalParts += $weight; } else { my $status = $curRes->simpleStatus($part); my $thisright = 0; $partsCount++; if ($status == $curRes->CORRECT || $status == $curRes->PARTIALLY_CORRECT ) { $partsRight++; $totalRight++; $thisright = 1; } if ($status == $curRes->ATTEMPTED) { $partsAttempted++; $totalAttempted++; } $totalParts++; if ($curRes->opendate($part) < $now) { $totalPossible++; } } } if ($depth == 1) { # in top-level only $topLevelParts += $partsCount; $topLevelRight += $partsRight; $topLevelAttempted += $partsAttempted; } # Crawl down stack and record parts correct and total for my $res (@{$stack}) { if (ref($res) && $res->is_map()) { if (!defined($res->{DATA}->{CHILD_PARTS})) { $res->{DATA}->{CHILD_PARTS} = 0; $res->{DATA}->{CHILD_CORRECT} = 0; $res->{DATA}->{CHILD_ATTEMPTED} = 0; } $res->{DATA}->{CHILD_PARTS} += $partsCount; $res->{DATA}->{CHILD_CORRECT} += $partsRight; $res->{DATA}->{CHILD_ATTEMPTED} += $partsAttempted; } } } $curRes = $iterator->next(); } return ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted, $topLevelParts,$topLevelRight,$topLevelAttempted); } # # Outputting everything. # sub outputTable { my ($r,$showPoints,$notshowTotals,$nostdtotals,$navmap,$totalParts,$totalPossible, $totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_; my @start = (255, 255, 192); my @end = (0, 192, 0); my $indentString = '     '; # Second pass: Print the maps. $r->print(&Apache::loncommon::start_data_table() .&Apache::loncommon::start_data_table_header_row() .'<th>'.&mt('Folder').'</th>'); my $title = &mt($showPoints ? "Points Scored" : "Done"); if ($totalAttempted) { $title .= " / " . &mt("Attempted"); } $r->print("<th>$title".($notshowTotals?'':" / ".&mt('Total')).'</th>' .&Apache::loncommon::end_data_table_header_row()); # # Output of folder scores # my $iterator = $navmap->getIterator(undef, undef, undef, 1); my $depth = 1; $iterator->next(); # ignore first BEGIN_MAP my $curRes = $iterator->next(); while ($depth > 0) { if ($curRes == $iterator->BEGIN_MAP()) {$depth++;} if ($curRes == $iterator->END_MAP()) { $depth--; } if (ref($curRes) && $curRes->is_map()) { my $title = $curRes->compTitle(); my $correct = $curRes->{DATA}->{CHILD_CORRECT}; my $total = $curRes->{DATA}->{CHILD_PARTS}; my $attempted = $curRes->{DATA}->{CHILD_ATTEMPTED}; if ($total > 0) { my $ratio; $ratio = $correct / $total; my $color = &mixColors(\@start, \@end, $ratio); $r->print(&Apache::loncommon::start_data_table_row() .'<td style="background-color:'.$color.';">'); my $thisIndent = ''; for (my $i = 1; $i < $depth; $i++) { $thisIndent .= $indentString; } $r->print("$thisIndent$title</td>"); if ($totalAttempted) { $r->print('<td valign="top">' .$thisIndent .'<span class="LC_nobreak">' .$correct.' / '.$attempted.($notshowTotals?'':' / '.$total) .'</span></td>' .&Apache::loncommon::end_data_table_row() ); } else { $r->print('<td valign="top">' .$thisIndent .'<span class="LC_nobreak">' .$correct.($notshowTotals?'':' / '.$total) .'</span></td>' .&Apache::loncommon::end_data_table_row()); } } } $curRes = $iterator->next(); } # If there were any problems at the top level, print an extra "catchall" if ($topLevelParts > 0) { my $ratio = $topLevelRight / $topLevelParts; my $color = &mixColors(\@start, \@end, $ratio); $r->print(&Apache::loncommon::start_data_table_row() .'<td style="background-color:'.$color.';">'); $r->print(&mt("Problems Not Contained In A Folder")."</td><td>"); $r->print("$topLevelRight / $topLevelParts</td>" .&Apache::loncommon::end_data_table_row()); } # # show totals (if applicable), close table # if ($showPoints) { unless ($nostdtotals) { my $maxHelpLink = &Apache::loncommon::help_open_topic("Quick_Grades_Possibly_Correct"); $title = $showPoints ? "Points" : "Parts Done"; my $totaltitle = $showPoints ? &mt("Awarded Total Points") : &mt("Total Parts Done"); $r->print(&Apache::loncommon::start_data_table_row() .'<td colspan="2" align="right">'.$totaltitle.': <b>'.$totalRight.'</b><br />'); $r->print(&mt('Max Possible To Date')." $maxHelpLink: <b>$totalPossible</b><br />"); $title = $showPoints ? "Points" : "Parts"; $r->print(&mt("Total $title In Course").': <b>'.$totalParts.'</b></td>' .&Apache::loncommon::end_data_table_row()); } } $r->print(&Apache::loncommon::end_data_table()); return; } sub startpage { my ($r,$showPoints) = @_; my $title = "Grading and Statistics";#$showPoints ? "Points Display" : "Completed Problems Display"; my $brcrum = [{href=>"/adm/quickgrades",text => "Points Display"}]; $r->print(&Apache::loncommon::start_page($title,undef, {'bread_crumbs' => $brcrum}) ); } sub startGradeScreen { my ($r)=@_; my $showPoints = $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard'; my $hidetotals = $env{'course.'.$env{'request.course.id'}.'.hidetotals'}; my $notshowSPRSlink = (($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'external') || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals')); my $notshowTotals = $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'; my $showSPRSlink = $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'spreadsheet'; my $allowed_to_view = &Apache::lonnet::allowed('vgr',$env{'request.course.id'}); if ((!$allowed_to_view) && ($env{'request.course.sec'} ne '')) { $allowed_to_view = &Apache::lonnet::allowed('vgr', "$env{'request.course.id'}/$env{'request.course.sec'}"); } my $allowed_to_edit = &Apache::lonnet::allowed('mgr',$env{'request.course.id'}); if ((!$allowed_to_edit) && ($env{'request.course.sec'} ne '')) { $allowed_to_edit = &Apache::lonnet::allowed('mgr', "$env{'request.course.id'}/$env{'request.course.sec'}"); } if ($allowed_to_view) { my @notes; push(@notes,&mt('Students do not see total points.')) if ($notshowTotals); push(@notes,&mt('Students do not see link to spreadsheet.')) if ($notshowSPRSlink); push(@notes,&mt('Students will see points based on problem weights.')) if ($showPoints); if (($showPoints) && ($hidetotals ne '')) { if ($hidetotals eq 'all') { push(@notes,&mt('Students do not see course totals.')); } else { my @secs = split(/,/,$hidetotals); if (@secs == 1) { push(@notes,&mt('Students in section [_1] do not see course totals.', $hidetotals)); } elsif (@secs > 1) { push(@notes,&mt('Students in sections [_1] do not see course totals.', join(', ',@secs))); } } } push(@notes,&mt('Students will see link to spreadsheet.')) if ($showSPRSlink); push(@notes,&Apache::lonhtmlcommon::coursepreflink(&mt('Grade display settings'),'grading')); $r->print(&Apache::loncommon::head_subbox(join('  ',@notes))); } elsif (!$allowed_to_edit) { if (!$showPoints && !$notshowSPRSlink ) { $r->print(&Apache::loncommon::head_subbox( &mt('This screen shows how many problems (or problem parts) you have completed' .', and how many you have not yet done.' .' You can also look at [_1]a detailed score sheet[_2].' ,'<a href="/adm/studentcalc">','</a>'))); } } return; } sub endGradeScreen { my ($r)=@_; $r->print(&Apache::loncommon::end_page()); return; } # Pass this two refs to arrays for the start and end color, and a number # from 0 to 1 for how much of the latter you want to mix in. It will # return a string ready to show ("#FFC309"); sub mixColors { my $start = shift; my $end = shift; my $ratio = shift; my ($a,$b); my $final = ""; $a = $start->[0]; $b = $end->[0]; my $mix1 = POSIX::floor((1-$ratio)*$a + $ratio*$b); $a = $start->[1]; $b = $end->[1]; my $mix2 = POSIX::floor((1-$ratio)*$a + $ratio*$b); $a = $start->[2]; $b = $end->[2]; my $mix3 = POSIX::floor((1-$ratio)*$a + $ratio*$b); $final = sprintf "%02x%02x%02x", $mix1, $mix2, $mix3; return "#" . $final; } 1;