Annotation of loncom/interface/lonquickgrades.pm, revision 1.49.6.7

1.1       bowersj2    1: # The LearningOnline Network with CAPA
                      2: # Quick Student Grades Display
                      3: #
1.49.6.7! raeburn     4: # $Id: lonquickgrades.pm,v 1.49.6.6 2020/09/01 14:38:07 raeburn Exp $
1.1       bowersj2    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
                     28: 
                     29: package Apache::lonquickgrades;
                     30: 
                     31: use strict;
1.49.6.1  raeburn    32: use Apache::Constants qw(:common :http REDIRECT);
1.5       bowersj2   33: use POSIX;
1.25      www        34: use Apache::loncommon;
                     35: use Apache::lonlocal;
1.36      albertel   36: use Apache::lonnet;
1.38      bowersj2   37: use Apache::grades;
1.49.6.3  raeburn    38: use Apache::lonuserstate;
1.1       bowersj2   39: 
                     40: sub handler {
                     41:     my $r = shift;
1.5       bowersj2   42:     return real_handler($r);
                     43: }
                     44: 
                     45: sub real_handler {
                     46:     my $r = shift;
1.1       bowersj2   47: 
                     48:     &Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});
                     49: 
                     50:     # Handle header-only request
1.40      albertel   51:     if ($env{'browser.mathml'}) {
                     52: 	&Apache::loncommon::content_type($r,'text/xml');
                     53:     } else {
                     54: 	&Apache::loncommon::content_type($r,'text/html');
                     55:     }
1.1       bowersj2   56:     if ($r->header_only) {
1.40      albertel   57: 	$r->send_http_header;
1.1       bowersj2   58:         return OK;
                     59:     }
                     60: 
1.49.6.6  raeburn    61:     my $cangrade=&Apache::lonnet::allowed('mgr');
1.49.6.4  raeburn    62:     my $showPoints =
                     63:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard';
                     64: 
                     65:     my $reinitresult;
                     66: 
1.49.6.6  raeburn    67:     unless ($cangrade) {
1.49.6.2  raeburn    68:         # Check for critical messages and redirect if present.
                     69:         my ($redirect,$url) = &Apache::loncommon::critical_redirect(300);
                     70:         if ($redirect) {
                     71:             &Apache::loncommon::content_type($r,'text/html');
                     72:             $r->header_out(Location => $url);
                     73:             return REDIRECT;
                     74:         }
                     75: 
                     76:         # Check if course needs to be re-initialized
                     77:         my $loncaparev = $r->dir_config('lonVersion');
1.49.6.4  raeburn    78:         ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev);
1.49.6.2  raeburn    79: 
1.49.6.4  raeburn    80:         if ($reinitresult eq 'switch') {
1.49.6.2  raeburn    81:             &Apache::loncommon::content_type($r,'text/html');
                     82:             $r->send_http_header;
                     83:             $r->print(&Apache::loncommon::check_release_result(@reinit));
                     84:             return OK;
1.49.6.4  raeburn    85:         } elsif ($reinitresult eq 'update') {
                     86:             my $cid = $env{'request.course.id'};
                     87:             my $cnum = $env{'course.'.$cid.'.num'};
                     88:             my $cdom = $env{'course.'.$cid.'.domain'};
                     89:             &Apache::loncommon::content_type($r,'text/html');
                     90:             $r->send_http_header;
                     91:             &startpage($r,$showPoints);
                     92:             my $preamble = '<div id="LC_update_'.$cid.'" class="LC_info">'.
                     93:                            '<br />'.
                     94:                            &mt('Your course session is being updated because of recent changes by course personnel.').
1.49.6.7! raeburn    95:                            ' '.&mt('Please be patient').'.<br /></div>'.
1.49.6.4  raeburn    96:                            '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.49.6.5  raeburn    97:             my %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($r,undef,$preamble);
1.49.6.4  raeburn    98:             &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Updating course'));
                     99:             $r->rflush();
1.49.6.2  raeburn   100:             my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
1.49.6.7! raeburn   101:             &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Finished!'));
1.49.6.4  raeburn   102:             &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
                    103:             my $closure = <<ENDCLOSE;
                    104: <script type="text/javascript">
                    105: // <![CDATA[
                    106: \$("#LC_update_$cid").hide('slow');
                    107: // ]]>
                    108: </script>
                    109: ENDCLOSE
1.49.6.2  raeburn   110:             if ($ferr) {
1.49.6.4  raeburn   111:                 $r->print($closure.&Apache::loncommon::end_page());
1.49.6.2  raeburn   112:                 my $requrl = $r->uri;
                    113:                 $env{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
                    114:                 $env{'user.reinit'} = 1;
                    115:                 return HTTP_NOT_ACCEPTABLE;
1.49.6.4  raeburn   116:             } else {
                    117:                $r->print($closure);
1.49.6.2  raeburn   118:             }
                    119:         }
                    120:     }
                    121: 
1.49.6.4  raeburn   122:     unless ($reinitresult eq 'update') {
                    123:         # Send header, don't cache this page
                    124:         &Apache::loncommon::no_cache($r);
                    125:         $r->send_http_header;
                    126:         &startpage($r,$showPoints);
                    127:     }
                    128:     $r->rflush();
1.1       bowersj2  129: 
1.49.6.6  raeburn   130:     &startGradeScreen($r);
                    131: 
                    132: #
                    133: # Pick student
                    134: #
                    135:     my $uname;
                    136:     my $udom;
                    137:     my $stdid;
                    138:     if ($cangrade) {
                    139:         if ($env{'form.uname'}) { $uname=$env{'form.uname'}; }
                    140:         if ($env{'form.udom'}) { $udom=$env{'form.udom'}; }
                    141:         if ($env{'form.id'}) { $stdid=$env{'form.id'}; }
                    142:         if (($stdid) && ($udom)) {
                    143:             $uname=(&Apache::lonnet::idget($udom,[$stdid],'ids'))[1];
                    144:         }
                    145:         if (($stdid) && (!$uname)) {
                    146:             $r->print('<p><span class="LC_warning">'.&mt("Unknown Student/Employee ID: [_1]",$stdid).'</span></p>');
                    147:             $stdid='';
                    148:         }
                    149:         if (($uname eq '') && ($udom eq '')) {
                    150:             $uname = $env{'user.name'};
                    151:             $udom = $env{'user.domain'};
                    152:         }
                    153:         $r->print('<form method="post" name="quickform" action="/adm/quickgrades">');
                    154:         my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                    155:            &Apache::loncommon::selectstudent_link('quickform','uname','udom');
                    156:         $r->print("<p>\n".&Apache::loncommon::studentbrowser_javascript()."\n");
                    157:         $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
                    158:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                    159:                  ,'<input type="text" value="'.$stdid.'" size="12" name="id" /> '
                    160:                  ,$chooseopt).
                    161:                  '&nbsp;&nbsp;<input type="submit" name="display" value="'.&mt('Display Individual Student').'" /></p>');
                    162:         if (($uname) && ($udom)) {
                    163:             $r->print('<p>'.&mt('Full Name: [_1]',&Apache::loncommon::plainname($uname,$udom)).'</p>');
                    164:         }
                    165:     } else {
                    166:         $r->print('<p class="LC_info">'.&mt('This may take a few moments to display.').'</p>');
                    167:     }
                    168:     $r->rflush();
                    169: 
1.49      www       170:     my $notshowTotals=
                    171:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals';
1.17      bowersj2  172: 
1.49.6.6  raeburn   173:     my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,
                    174:         $topLevelRight,$topLevelAttempted) = &getData($showPoints,$uname,$udom);
1.1       bowersj2  175: 
1.49.6.6  raeburn   176:     if (ref($navmap)) {
                    177:         &outputTable($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible,
                    178:                      $totalRight,$totalAttempted,$topLevelParts,$topLevelRight,
                    179:                      $topLevelAttempted);
                    180:     } else {
                    181:         if ($cangrade) { $r->print("\n</form>\n"); }
1.7       bowersj2  182:         my $requrl = $r->uri;
1.49.6.6  raeburn   183:         $env{'user.error.msg'} = "$requrl:bre:0:0:Navmap initialization failed.";
1.7       bowersj2  184:         return HTTP_NOT_ACCEPTABLE;
                    185:     }
1.49.6.6  raeburn   186:     if ($cangrade) { $r->print("\n</form>\n"); }
                    187:     &endGradeScreen($r);
                    188:     return OK;
                    189: }
1.7       bowersj2  190: 
1.49.6.6  raeburn   191: #
                    192: # Go through the complete course and collect data
                    193: #
1.17      bowersj2  194: 
1.49.6.6  raeburn   195: sub getData {
1.17      bowersj2  196: 
1.49.6.6  raeburn   197:     my ($showPoints,$uname,$udom)=@_;
1.2       bowersj2  198: 
1.49.6.6  raeburn   199:     # Create the nav map
                    200:     my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom);
                    201: 
                    202:     if (!defined($navmap)) {
                    203:         return ();
                    204:     }
                    205: 
                    206:     my $res = $navmap->firstResource(); # temp resource to access constants
1.1       bowersj2  207: 
                    208:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    209:     my $depth = 1;
                    210:     $iterator->next(); # ignore first BEGIN_MAP
                    211:     my $curRes = $iterator->next();
1.49.6.6  raeburn   212: 
1.5       bowersj2  213:     # General overview of the following: Walk along the course resources.
                    214:     # For every problem in the resource, tell its parent maps how many
                    215:     # parts and how many parts correct it has. After that, each map will
                    216:     # have a count of the total parts underneath it, correct and otherwise.
                    217:     # After that, we will walk through the course again and read off
                    218:     # maps in order, with their data. 
                    219:     # (If in the future people decide not to be cumulative, only add
                    220:     #  the counts to the parent map.)
1.17      bowersj2  221:     # For convenience, "totalParts" is also "totalPoints" when we're looking
                    222:     #  at points; I can't come up with a variable name that makes sense
                    223:     #  equally for both cases.
1.5       bowersj2  224: 
                    225:     my $totalParts = 0; my $totalPossible = 0; my $totalRight = 0;
1.28      bowersj2  226:     my $totalAttempted = 0;
1.14      bowersj2  227:     my $now = time();
1.28      bowersj2  228:     my $topLevelParts = 0; my $topLevelRight = 0; my $topLevelAttempted = 0;
1.5       bowersj2  229: 
                    230:     # Pre-run: Count parts correct
1.1       bowersj2  231:     while ( $depth > 0 ) {
                    232:         if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
                    233:         if ($curRes == $iterator->END_MAP()) { $depth--; }
                    234: 
1.7       bowersj2  235:         if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout)
1.5       bowersj2  236:         {
                    237:             # Get number of correct, incorrect parts
                    238:             my $parts = $curRes->parts();
                    239:             my $partsRight = 0;
1.17      bowersj2  240: 	    my $partsCount = 0;
1.28      bowersj2  241: 	    my $partsAttempted = 0;
1.5       bowersj2  242:             my $stack = $iterator->getStack();
                    243:             
                    244:             for my $part (@{$parts}) {
1.28      bowersj2  245: 		my $dateStatus = $curRes->getDateStatus($part);
1.49.6.6  raeburn   246:                 my $weight = $curRes->weight($part);
                    247:                 my $problemstatus = $curRes->problemstatus($part);
                    248: 
                    249:                 if ($curRes->solved($part) eq 'excused') {
1.21      matthew   250:                     next;
                    251:                 }
1.17      bowersj2  252: 		if ($showPoints) {
1.28      bowersj2  253: 		    my $score = 0;
                    254: 		    # If we're not telling status and the answer date isn't passed yet, 
                    255: 		    # it's an "attempted" point
1.49.6.6  raeburn   256: 		    if ((($problemstatus eq 'no') ||
                    257:                          ($problemstatus eq 'no_feedback_ever')) &&
1.28      bowersj2  258: 			($dateStatus != $curRes->ANSWER_OPEN)) {
1.31      albertel  259: 			my $status = $curRes->simpleStatus($part);
                    260: 			if ($status == $curRes->ATTEMPTED) {
1.49.6.6  raeburn   261: 			    $partsAttempted += $weight;
1.31      albertel  262: 			    $totalAttempted += $partsAttempted;
                    263: 			}
1.28      bowersj2  264: 		    } else {
1.49.6.6  raeburn   265: 			$score = &Apache::grades::compute_points($weight, $curRes->awarded($part));
1.28      bowersj2  266: 		    }
1.17      bowersj2  267: 		    $partsRight += $score;
                    268: 		    $totalRight += $score;
1.49.6.6  raeburn   269: 		    $partsCount += $weight;
1.18      bowersj2  270: 
1.17      bowersj2  271: 		    if ($curRes->opendate($part) < $now) {
1.49.6.6  raeburn   272: 			$totalPossible += $weight;
1.17      bowersj2  273: 		    }
1.49.6.6  raeburn   274: 		    $totalParts += $weight;
1.17      bowersj2  275: 		} else {
1.27      bowersj2  276: 		    my $status = $curRes->simpleStatus($part);
1.17      bowersj2  277: 		    my $thisright = 0;
                    278: 		    $partsCount++;
1.37      albertel  279: 		    if ($status == $curRes->CORRECT ||
                    280: 			$status == $curRes->PARTIALLY_CORRECT ) {
1.17      bowersj2  281: 			$partsRight++;
                    282: 			$totalRight++;
                    283: 			$thisright = 1;
                    284: 		    }
1.28      bowersj2  285: 
                    286: 		    if ($status == $curRes->ATTEMPTED) {
                    287: 			$partsAttempted++;
                    288: 			$totalAttempted++;
                    289: 		    }
1.17      bowersj2  290: 		    
1.19      bowersj2  291: 		    $totalParts++;
1.17      bowersj2  292: 		    if ($curRes->opendate($part) < $now) {
                    293: 			$totalPossible++;
                    294: 		    }
                    295: 		}
1.5       bowersj2  296:             }
1.15      bowersj2  297: 
                    298:             if ($depth == 1) { # in top-level only
1.19      bowersj2  299: 		$topLevelParts += $partsCount;
1.15      bowersj2  300: 		$topLevelRight += $partsRight;
1.28      bowersj2  301: 		$topLevelAttempted += $partsAttempted;
1.15      bowersj2  302: 	    }
                    303: 
1.5       bowersj2  304:             # Crawl down stack and record parts correct and total
                    305:             for my $res (@{$stack}) {
                    306:                 if (ref($res) && $res->is_map()) {
                    307:                     if (!defined($res->{DATA}->{CHILD_PARTS})) {
                    308:                         $res->{DATA}->{CHILD_PARTS} = 0;
                    309:                         $res->{DATA}->{CHILD_CORRECT} = 0;
1.28      bowersj2  310: 			$res->{DATA}->{CHILD_ATTEMPTED} = 0;
1.5       bowersj2  311:                     }
                    312:                     
1.17      bowersj2  313:                     $res->{DATA}->{CHILD_PARTS} += $partsCount;
1.5       bowersj2  314:                     $res->{DATA}->{CHILD_CORRECT} += $partsRight;
1.28      bowersj2  315: 		    $res->{DATA}->{CHILD_ATTEMPTED} += $partsAttempted;
1.5       bowersj2  316:                 }
                    317:             }
                    318:         }
                    319:         $curRes = $iterator->next();
                    320:     }
1.49.6.6  raeburn   321:     return ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,
                    322:             $topLevelParts,$topLevelRight,$topLevelAttempted);
                    323: }
1.5       bowersj2  324: 
1.49.6.6  raeburn   325: #
                    326: # Outputting everything.
                    327: #
                    328: 
                    329: sub outputTable {
                    330: 
                    331:     my ($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible,$totalRight,
                    332:         $totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_;
1.5       bowersj2  333: 
1.7       bowersj2  334:     my @start = (255, 255, 192);
1.5       bowersj2  335:     my @end   = (0, 192, 0);
                    336: 
                    337:     my $indentString = '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;';
                    338: 
                    339:     # Second pass: Print the maps.
1.43      bisitz    340:     $r->print(&Apache::loncommon::start_data_table()
                    341:              .&Apache::loncommon::start_data_table_header_row()
                    342:              .'<th>'.&mt('Folder').'</th>');
1.49.6.5  raeburn   343:     my $title = &mt($showPoints ? "Points Scored" : "Done");
1.28      bowersj2  344:     if ($totalAttempted) {
1.49.6.6  raeburn   345:         $title .= " / " . &mt("Attempted");
1.28      bowersj2  346:     }
1.49      www       347:     $r->print("<th>$title".($notshowTotals?'':" / ".&mt('Total')).'</th>'
1.43      bisitz    348:              .&Apache::loncommon::end_data_table_header_row());
1.49.6.6  raeburn   349: #
                    350: # Output of folder scores
                    351: #
                    352: 
                    353:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    354:     my $depth = 1;
                    355:     $iterator->next(); # ignore first BEGIN_MAP
                    356:     my $curRes = $iterator->next();
                    357: 
1.5       bowersj2  358:     while ($depth > 0) {
                    359:         if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
                    360:         if ($curRes == $iterator->END_MAP()) { $depth--; }
                    361: 
                    362:         if (ref($curRes) && $curRes->is_map()) {
                    363:             my $title = $curRes->compTitle();
                    364:             
                    365:             my $correct = $curRes->{DATA}->{CHILD_CORRECT};
                    366:             my $total = $curRes->{DATA}->{CHILD_PARTS};
1.28      bowersj2  367: 	    my $attempted = $curRes->{DATA}->{CHILD_ATTEMPTED};
1.5       bowersj2  368: 
1.6       bowersj2  369:             if ($total > 0) {
                    370:                 my $ratio;
                    371:                 $ratio = $correct / $total;
1.49.6.4  raeburn   372:                 my $color = &mixColors(\@start, \@end, $ratio);
1.43      bisitz    373:                 $r->print(&Apache::loncommon::start_data_table_row()
                    374:                          .'<td style="background-color:'.$color.';">');
1.6       bowersj2  375:                 
1.15      bowersj2  376: 		my $thisIndent = '';
                    377:                 for (my $i = 1; $i < $depth; $i++) { $thisIndent .= $indentString; }
1.6       bowersj2  378:                 
1.15      bowersj2  379:                 $r->print("$thisIndent$title</td>");
1.28      bowersj2  380: 		if ($totalAttempted) {
1.45      bisitz    381: 		    $r->print('<td valign="top">'
                    382:                              .$thisIndent
                    383:                              .'<span class="LC_nobreak">'
1.49      www       384:                              .$correct.' / '.$attempted.($notshowTotals?'':' / '.$total)
1.45      bisitz    385:                              .'</span></td>'
                    386:                              .&Apache::loncommon::end_data_table_row()
                    387:                     );
1.28      bowersj2  388: 		} else {
1.45      bisitz    389: 		    $r->print('<td valign="top">'
                    390:                              .$thisIndent
                    391:                              .'<span class="LC_nobreak">'
1.49      www       392:                              .$correct.($notshowTotals?'':' / '.$total)
1.45      bisitz    393:                              .'</span></td>'
1.43      bisitz    394:                              .&Apache::loncommon::end_data_table_row());
1.28      bowersj2  395: 		}
1.6       bowersj2  396:             }
1.5       bowersj2  397:         }
1.4       bowersj2  398: 
1.5       bowersj2  399:         $curRes = $iterator->next();
                    400:     }
1.4       bowersj2  401: 
1.6       bowersj2  402:     # If there were any problems at the top level, print an extra "catchall"
1.15      bowersj2  403:     if ($topLevelParts > 0) {
                    404:         my $ratio = $topLevelRight / $topLevelParts;
1.49.6.4  raeburn   405:         my $color = &mixColors(\@start, \@end, $ratio);
1.43      bisitz    406:         $r->print(&Apache::loncommon::start_data_table_row()
                    407:                  .'<td style="background-color:'.$color.';">');
1.25      www       408:         $r->print(&mt("Problems Not Contained In A Folder")."</td><td>");
1.43      bisitz    409:         $r->print("$topLevelRight / $topLevelParts</td>"
                    410:                  .&Apache::loncommon::end_data_table_row());
1.6       bowersj2  411:     }
1.4       bowersj2  412: 
1.49.6.6  raeburn   413: #
                    414: # show totals (if applicable), close table
                    415: #
1.35      albertel  416:     if ($showPoints) {
1.49.6.4  raeburn   417: 	my $maxHelpLink = &Apache::loncommon::help_open_topic("Quick_Grades_Possibly_Correct");
1.2       bowersj2  418: 
1.34      www       419: 	$title = $showPoints ? "Points" : "Parts Done";
1.41      bisitz    420: 	my $totaltitle = $showPoints ? &mt("Awarded Total Points") : &mt("Total Parts Done");
1.43      bisitz    421: 	$r->print(&Apache::loncommon::start_data_table_row()
1.48      bisitz    422:                  .'<td colspan="2" align="right">'.$totaltitle.': <b>'.$totalRight.'</b><br />');
                    423: 	$r->print(&mt('Max Possible To Date')." $maxHelpLink: <b>$totalPossible</b><br />");
1.34      www       424: 	$title = $showPoints ? "Points" : "Parts";
1.43      bisitz    425: 	$r->print(&mt("Total $title In Course").': <b>'.$totalParts.'</b></td>'
                    426:                  .&Apache::loncommon::end_data_table_row());
1.34      www       427:     }
1.1       bowersj2  428: 
1.49.6.6  raeburn   429:     $r->print(&Apache::loncommon::end_data_table());
                    430:     return;
1.5       bowersj2  431: }
                    432: 
1.49.6.4  raeburn   433: sub startpage {
                    434:     my ($r,$showPoints) = @_;
                    435:     my $title = "Grading and Statistics";#$showPoints ? "Points Display" : "Completed Problems Display";
                    436:     my $brcrum = [{href=>"/adm/quickgrades",text => "Points Display"}];
                    437:     $r->print(&Apache::loncommon::start_page($title,undef,
                    438:                                             {'bread_crumbs' => $brcrum})
                    439:              );
                    440: }
                    441: 
1.49.6.6  raeburn   442: sub startGradeScreen {
                    443:     my ($r)=@_;
                    444: 
                    445:     my $showPoints =
                    446:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard';
                    447:     my $notshowSPRSlink =
                    448:         (($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'external')
                    449:       || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'));
                    450:     my $notshowTotals =
                    451:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals';
                    452:     my $showSPRSlink =
                    453:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'spreadsheet';
                    454: 
                    455:     my $allowed_to_view = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
                    456:     if ((!$allowed_to_view) && ($env{'request.course.sec'} ne '')) {
                    457:         $allowed_to_view = &Apache::lonnet::allowed('vgr',
                    458:                                "$env{'request.course.id'}/$env{'request.course.sec'}");
                    459:     }
                    460: 
                    461:     my $allowed_to_edit = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
                    462:     if ((!$allowed_to_edit) && ($env{'request.course.sec'} ne '')) {
                    463:         $allowed_to_edit = &Apache::lonnet::allowed('mgr',
                    464:                                "$env{'request.course.id'}/$env{'request.course.sec'}");
                    465:     }
                    466: 
                    467:     if ($allowed_to_view) {
                    468:         my @notes;
                    469:         push(@notes,&mt('Students do not see total points.')) if ($notshowTotals);
                    470:         push(@notes,&mt('Students do not see link to spreadsheet.')) if ($notshowSPRSlink);
                    471:         push(@notes,&mt('Students will see points based on problem weights.')) if ($showPoints);
                    472:         push(@notes,&mt('Students will see link to spreadsheet.')) if ($showSPRSlink);
                    473:         push(@notes,&Apache::lonhtmlcommon::coursepreflink(&mt('Grade display settings'),'grading'));
                    474:         $r->print(&Apache::loncommon::head_subbox(join('&nbsp;&nbsp;',@notes)));
                    475:     } elsif (!$allowed_to_edit) {
                    476:         if (!$showPoints && !$notshowSPRSlink ) {
                    477:             $r->print(&Apache::loncommon::head_subbox(
                    478:                       &mt('This screen shows how many problems (or problem parts) you have completed'
                    479:                      .', and how many you have not yet done.'
                    480:                      .' You can also look at [_1]a detailed score sheet[_2].'
                    481:                      ,'<a href="/adm/studentcalc">','</a>')));
                    482:         }
                    483:     }
                    484:     return;
                    485: }
                    486: 
                    487: sub endGradeScreen {
                    488:     my ($r)=@_;
                    489:     $r->print(&Apache::loncommon::end_page());
                    490:     return;
                    491: }
                    492: 
1.5       bowersj2  493: # Pass this two refs to arrays for the start and end color, and a number
                    494: # from 0 to 1 for how much of the latter you want to mix in. It will
                    495: # return a string ready to show ("#FFC309");
                    496: sub mixColors {
                    497:     my $start = shift;
                    498:     my $end = shift;
                    499:     my $ratio = shift;
                    500:     
1.9       matthew   501:     my ($a,$b);
1.5       bowersj2  502:     my $final = "";
1.9       matthew   503:     $a = $start->[0]; $b = $end->[0];
1.5       bowersj2  504:     my $mix1 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
1.9       matthew   505:     $a = $start->[1]; $b = $end->[1];
1.5       bowersj2  506:     my $mix2 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
1.9       matthew   507:     $a = $start->[2]; $b = $end->[2];
1.5       bowersj2  508:     my $mix3 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
                    509: 
1.16      bowersj2  510:     $final = sprintf "%02x%02x%02x", $mix1, $mix2, $mix3;
1.5       bowersj2  511:     return "#" . $final;
1.1       bowersj2  512: }
                    513: 
                    514: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>