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

1.1       bowersj2    1: # The LearningOnline Network with CAPA
                      2: # Quick Student Grades Display
                      3: #
1.49.6.8.2.5! raeburn     4: # $Id: lonquickgrades.pm,v 1.49.6.8.2.4 2023/10/06 20:36:59 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.8  raeburn    67:     if ($env{'request.course.id'}) {
                     68:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                     69:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                     70:         my $clientip = &Apache::lonnet::get_requestor_ip($r);
                     71:         my ($blocked,$blocktext) =
                     72:             &Apache::loncommon::blocking_status('grades',$clientip,$cnum,$cdom);
                     73:         if ($blocked) {
                     74:             my $checkrole = "cm./$cdom/$cnum";
                     75:             if ($env{'request.course.sec'} ne '') {
                     76:                 $checkrole .= "/$env{'request.course.sec'}";
                     77:             }
                     78:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                     79:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                     80:                 &grades_blocked($r,$blocktext,$showPoints);
                     81:                 return OK;
                     82:             }
                     83:         }
                     84:     }
                     85: 
1.49.6.6  raeburn    86:     unless ($cangrade) {
1.49.6.2  raeburn    87:         # Check for critical messages and redirect if present.
1.49.6.8.2.1  raeburn    88:         my ($redirect,$url) = &Apache::loncommon::critical_redirect(300,'grades');
1.49.6.2  raeburn    89:         if ($redirect) {
                     90:             &Apache::loncommon::content_type($r,'text/html');
                     91:             $r->header_out(Location => $url);
                     92:             return REDIRECT;
                     93:         }
                     94: 
                     95:         # Check if course needs to be re-initialized
                     96:         my $loncaparev = $r->dir_config('lonVersion');
1.49.6.4  raeburn    97:         ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev);
1.49.6.2  raeburn    98: 
1.49.6.4  raeburn    99:         if ($reinitresult eq 'switch') {
1.49.6.2  raeburn   100:             &Apache::loncommon::content_type($r,'text/html');
                    101:             $r->send_http_header;
                    102:             $r->print(&Apache::loncommon::check_release_result(@reinit));
                    103:             return OK;
1.49.6.8.2.2  raeburn   104:         }
                    105:         my ($cid,$cnum,$cdom);
                    106:         if ($reinitresult) {
                    107:             $cid = $env{'request.course.id'};
                    108:             $cnum = $env{'course.'.$cid.'.num'};
                    109:             $cdom = $env{'course.'.$cid.'.domain'};
                    110:         }
                    111:         if (($reinitresult eq 'main') || ($reinitresult eq 'both')) {        
1.49.6.4  raeburn   112:             &Apache::loncommon::content_type($r,'text/html');
                    113:             $r->send_http_header;
                    114:             &startpage($r,$showPoints);
                    115:             my $preamble = '<div id="LC_update_'.$cid.'" class="LC_info">'.
                    116:                            '<br />'.
                    117:                            &mt('Your course session is being updated because of recent changes by course personnel.').
1.49.6.7  raeburn   118:                            ' '.&mt('Please be patient').'.<br /></div>'.
1.49.6.4  raeburn   119:                            '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.49.6.5  raeburn   120:             my %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($r,undef,$preamble);
1.49.6.4  raeburn   121:             &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Updating course'));
                    122:             $r->rflush();
1.49.6.2  raeburn   123:             my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
1.49.6.7  raeburn   124:             &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Finished!'));
1.49.6.4  raeburn   125:             &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
                    126:             my $closure = <<ENDCLOSE;
                    127: <script type="text/javascript">
                    128: // <![CDATA[
                    129: \$("#LC_update_$cid").hide('slow');
                    130: // ]]>
                    131: </script>
                    132: ENDCLOSE
1.49.6.2  raeburn   133:             if ($ferr) {
1.49.6.4  raeburn   134:                 $r->print($closure.&Apache::loncommon::end_page());
1.49.6.2  raeburn   135:                 my $requrl = $r->uri;
                    136:                 $env{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
                    137:                 $env{'user.reinit'} = 1;
                    138:                 return HTTP_NOT_ACCEPTABLE;
1.49.6.4  raeburn   139:             } else {
                    140:                $r->print($closure);
1.49.6.2  raeburn   141:             }
                    142:         }
1.49.6.8.2.2  raeburn   143:         if (($reinitresult eq 'supp') || ($reinitresult eq 'both')) {
                    144:             my $possdel;
                    145:             if ($reinitresult eq 'supp') {
                    146:                 $possdel = 1;
                    147:             }
                    148:             my ($supplemental,$refs_updated) = &Apache::loncommon::get_supplemental($cnum,$cdom,'',$possdel);
                    149:             unless ($refs_updated) {
                    150:                 &Apache::loncommon::set_supp_httprefs($cnum,$cdom,$supplemental);
                    151:             }
                    152:         }
1.49.6.2  raeburn   153:     }
                    154: 
1.49.6.8.2.2  raeburn   155:     unless (($reinitresult eq 'main') || ($reinitresult eq 'both')) {
1.49.6.4  raeburn   156:         # Send header, don't cache this page
                    157:         &Apache::loncommon::no_cache($r);
                    158:         $r->send_http_header;
                    159:         &startpage($r,$showPoints);
                    160:     }
                    161:     $r->rflush();
1.1       bowersj2  162: 
1.49.6.6  raeburn   163:     &startGradeScreen($r);
                    164: 
                    165: #
                    166: # Pick student
                    167: #
                    168:     my $uname;
                    169:     my $udom;
                    170:     my $stdid;
                    171:     if ($cangrade) {
                    172:         if ($env{'form.uname'}) { $uname=$env{'form.uname'}; }
                    173:         if ($env{'form.udom'}) { $udom=$env{'form.udom'}; }
                    174:         if ($env{'form.id'}) { $stdid=$env{'form.id'}; }
                    175:         if (($stdid) && ($udom)) {
                    176:             $uname=(&Apache::lonnet::idget($udom,[$stdid],'ids'))[1];
                    177:         }
                    178:         if (($stdid) && (!$uname)) {
                    179:             $r->print('<p><span class="LC_warning">'.&mt("Unknown Student/Employee ID: [_1]",$stdid).'</span></p>');
                    180:             $stdid='';
                    181:         }
                    182:         if (($uname eq '') && ($udom eq '')) {
                    183:             $uname = $env{'user.name'};
                    184:             $udom = $env{'user.domain'};
                    185:         }
                    186:         $r->print('<form method="post" name="quickform" action="/adm/quickgrades">');
                    187:         my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                    188:            &Apache::loncommon::selectstudent_link('quickform','uname','udom');
                    189:         $r->print("<p>\n".&Apache::loncommon::studentbrowser_javascript()."\n");
                    190:         $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
                    191:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                    192:                  ,'<input type="text" value="'.$stdid.'" size="12" name="id" /> '
                    193:                  ,$chooseopt).
                    194:                  '&nbsp;&nbsp;<input type="submit" name="display" value="'.&mt('Display Individual Student').'" /></p>');
                    195:         if (($uname) && ($udom)) {
                    196:             $r->print('<p>'.&mt('Full Name: [_1]',&Apache::loncommon::plainname($uname,$udom)).'</p>');
                    197:         }
                    198:     } else {
                    199:         $r->print('<p class="LC_info">'.&mt('This may take a few moments to display.').'</p>');
                    200:     }
                    201:     $r->rflush();
                    202: 
1.49      www       203:     my $notshowTotals=
                    204:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals';
1.17      bowersj2  205: 
1.49.6.6  raeburn   206:     my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,
                    207:         $topLevelRight,$topLevelAttempted) = &getData($showPoints,$uname,$udom);
1.1       bowersj2  208: 
1.49.6.6  raeburn   209:     if (ref($navmap)) {
1.49.6.8.2.4  raeburn   210:         my $nostdtotals;
                    211:         if ($showPoints) {
                    212:             if ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard') {
                    213:                 my $hidetotals = $env{'course.'.$env{'request.course.id'}.'.hidetotals'};
                    214:                 if ($hidetotals eq 'all') {
                    215:                     $nostdtotals = 1;
                    216:                 } elsif ($hidetotals ne '') {
                    217:                     my $usec;
1.49.6.8.2.5! raeburn   218:                     if ($cangrade) {
        !           219:                         if (($uname eq $env{'user.name'}) && ($udom eq $env{'user.domain'})) {
        !           220:                             $usec = $env{'request.course.sec'};
        !           221:                         } else {
        !           222:                             $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
        !           223:                         }
        !           224:                     } else {
        !           225:                         $usec = $env{'request.course.sec'};
1.49.6.8.2.4  raeburn   226:                     }
                    227:                     if ($usec ne '') {
                    228:                         my %secnototals;
                    229:                         map { $secnototals{$_} = 1; } split(/,/,$hidetotals);
                    230:                         if ($secnototals{$usec}) {
                    231:                             $nostdtotals = 1;
                    232:                         }
                    233:                     }
                    234:                 }
                    235:             }
                    236:         }
                    237:         &outputTable($r,$showPoints,$notshowTotals,$nostdtotals,$navmap,
                    238:                      $totalParts,$totalPossible,$totalRight,$totalAttempted,
                    239:                      $topLevelParts,$topLevelRight,$topLevelAttempted);
1.49.6.6  raeburn   240:     } else {
                    241:         if ($cangrade) { $r->print("\n</form>\n"); }
1.7       bowersj2  242:         my $requrl = $r->uri;
1.49.6.6  raeburn   243:         $env{'user.error.msg'} = "$requrl:bre:0:0:Navmap initialization failed.";
1.7       bowersj2  244:         return HTTP_NOT_ACCEPTABLE;
                    245:     }
1.49.6.6  raeburn   246:     if ($cangrade) { $r->print("\n</form>\n"); }
                    247:     &endGradeScreen($r);
                    248:     return OK;
                    249: }
1.7       bowersj2  250: 
1.49.6.8  raeburn   251: sub grades_blocked {
                    252:     my ($r,$blocktext,$caller) = @_;
                    253:     my $title = 'Points Display';
                    254:     if ($caller eq 'spreadsheet') {
                    255:         $title = 'Spreadsheet';
                    256:     } elsif ($env{'course.'.$env{'request.course.id'}.'.grading'} ne 'standard') {
                    257:         $title = 'Completed Problems Display';
                    258:     }
                    259:     my $brcrum = [{href=>"/adm/quickgrades",text => $title}];
                    260:     &Apache::lonhtmlcommon::clear_breadcrumbs();
                    261:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/quickgrades',
                    262:                                             text=> $title});
                    263:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs($title);
                    264:     &Apache::loncommon::content_type($r,'text/html');
                    265:     &Apache::loncommon::no_cache($r);
                    266:     $r->send_http_header;
                    267:     $r->print(&Apache::loncommon::start_page($title).
                    268:               $breadcrumbs.
                    269:               $blocktext.
                    270:               &Apache::loncommon::end_page());
                    271:     return;
                    272: }
                    273: 
1.49.6.6  raeburn   274: #
                    275: # Go through the complete course and collect data
                    276: #
1.17      bowersj2  277: 
1.49.6.6  raeburn   278: sub getData {
1.17      bowersj2  279: 
1.49.6.6  raeburn   280:     my ($showPoints,$uname,$udom)=@_;
1.2       bowersj2  281: 
1.49.6.6  raeburn   282:     # Create the nav map
                    283:     my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom);
                    284: 
                    285:     if (!defined($navmap)) {
                    286:         return ();
                    287:     }
                    288: 
                    289:     my $res = $navmap->firstResource(); # temp resource to access constants
1.1       bowersj2  290: 
                    291:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    292:     my $depth = 1;
                    293:     $iterator->next(); # ignore first BEGIN_MAP
                    294:     my $curRes = $iterator->next();
1.49.6.6  raeburn   295: 
1.5       bowersj2  296:     # General overview of the following: Walk along the course resources.
                    297:     # For every problem in the resource, tell its parent maps how many
                    298:     # parts and how many parts correct it has. After that, each map will
                    299:     # have a count of the total parts underneath it, correct and otherwise.
                    300:     # After that, we will walk through the course again and read off
                    301:     # maps in order, with their data. 
                    302:     # (If in the future people decide not to be cumulative, only add
                    303:     #  the counts to the parent map.)
1.17      bowersj2  304:     # For convenience, "totalParts" is also "totalPoints" when we're looking
                    305:     #  at points; I can't come up with a variable name that makes sense
                    306:     #  equally for both cases.
1.5       bowersj2  307: 
                    308:     my $totalParts = 0; my $totalPossible = 0; my $totalRight = 0;
1.28      bowersj2  309:     my $totalAttempted = 0;
1.14      bowersj2  310:     my $now = time();
1.28      bowersj2  311:     my $topLevelParts = 0; my $topLevelRight = 0; my $topLevelAttempted = 0;
1.5       bowersj2  312: 
                    313:     # Pre-run: Count parts correct
1.1       bowersj2  314:     while ( $depth > 0 ) {
                    315:         if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
                    316:         if ($curRes == $iterator->END_MAP()) { $depth--; }
                    317: 
1.49.6.8.2.3  raeburn   318:         if (ref($curRes) && $curRes->is_gradable() && !$curRes->randomout)
1.5       bowersj2  319:         {
                    320:             # Get number of correct, incorrect parts
                    321:             my $parts = $curRes->parts();
                    322:             my $partsRight = 0;
1.17      bowersj2  323: 	    my $partsCount = 0;
1.28      bowersj2  324: 	    my $partsAttempted = 0;
1.5       bowersj2  325:             my $stack = $iterator->getStack();
                    326:             
                    327:             for my $part (@{$parts}) {
1.28      bowersj2  328: 		my $dateStatus = $curRes->getDateStatus($part);
1.49.6.6  raeburn   329:                 my $weight = $curRes->weight($part);
                    330:                 my $problemstatus = $curRes->problemstatus($part);
                    331: 
                    332:                 if ($curRes->solved($part) eq 'excused') {
1.21      matthew   333:                     next;
                    334:                 }
1.17      bowersj2  335: 		if ($showPoints) {
1.28      bowersj2  336: 		    my $score = 0;
                    337: 		    # If we're not telling status and the answer date isn't passed yet, 
                    338: 		    # it's an "attempted" point
1.49.6.6  raeburn   339: 		    if ((($problemstatus eq 'no') ||
                    340:                          ($problemstatus eq 'no_feedback_ever')) &&
1.28      bowersj2  341: 			($dateStatus != $curRes->ANSWER_OPEN)) {
1.31      albertel  342: 			my $status = $curRes->simpleStatus($part);
                    343: 			if ($status == $curRes->ATTEMPTED) {
1.49.6.6  raeburn   344: 			    $partsAttempted += $weight;
1.31      albertel  345: 			    $totalAttempted += $partsAttempted;
                    346: 			}
1.28      bowersj2  347: 		    } else {
1.49.6.6  raeburn   348: 			$score = &Apache::grades::compute_points($weight, $curRes->awarded($part));
1.28      bowersj2  349: 		    }
1.17      bowersj2  350: 		    $partsRight += $score;
                    351: 		    $totalRight += $score;
1.49.6.6  raeburn   352: 		    $partsCount += $weight;
1.18      bowersj2  353: 
1.17      bowersj2  354: 		    if ($curRes->opendate($part) < $now) {
1.49.6.6  raeburn   355: 			$totalPossible += $weight;
1.17      bowersj2  356: 		    }
1.49.6.6  raeburn   357: 		    $totalParts += $weight;
1.17      bowersj2  358: 		} else {
1.27      bowersj2  359: 		    my $status = $curRes->simpleStatus($part);
1.17      bowersj2  360: 		    my $thisright = 0;
                    361: 		    $partsCount++;
1.37      albertel  362: 		    if ($status == $curRes->CORRECT ||
                    363: 			$status == $curRes->PARTIALLY_CORRECT ) {
1.17      bowersj2  364: 			$partsRight++;
                    365: 			$totalRight++;
                    366: 			$thisright = 1;
                    367: 		    }
1.28      bowersj2  368: 
                    369: 		    if ($status == $curRes->ATTEMPTED) {
                    370: 			$partsAttempted++;
                    371: 			$totalAttempted++;
                    372: 		    }
1.17      bowersj2  373: 		    
1.19      bowersj2  374: 		    $totalParts++;
1.17      bowersj2  375: 		    if ($curRes->opendate($part) < $now) {
                    376: 			$totalPossible++;
                    377: 		    }
                    378: 		}
1.5       bowersj2  379:             }
1.15      bowersj2  380: 
                    381:             if ($depth == 1) { # in top-level only
1.19      bowersj2  382: 		$topLevelParts += $partsCount;
1.15      bowersj2  383: 		$topLevelRight += $partsRight;
1.28      bowersj2  384: 		$topLevelAttempted += $partsAttempted;
1.15      bowersj2  385: 	    }
                    386: 
1.5       bowersj2  387:             # Crawl down stack and record parts correct and total
                    388:             for my $res (@{$stack}) {
                    389:                 if (ref($res) && $res->is_map()) {
                    390:                     if (!defined($res->{DATA}->{CHILD_PARTS})) {
                    391:                         $res->{DATA}->{CHILD_PARTS} = 0;
                    392:                         $res->{DATA}->{CHILD_CORRECT} = 0;
1.28      bowersj2  393: 			$res->{DATA}->{CHILD_ATTEMPTED} = 0;
1.5       bowersj2  394:                     }
                    395:                     
1.17      bowersj2  396:                     $res->{DATA}->{CHILD_PARTS} += $partsCount;
1.5       bowersj2  397:                     $res->{DATA}->{CHILD_CORRECT} += $partsRight;
1.28      bowersj2  398: 		    $res->{DATA}->{CHILD_ATTEMPTED} += $partsAttempted;
1.5       bowersj2  399:                 }
                    400:             }
                    401:         }
                    402:         $curRes = $iterator->next();
                    403:     }
1.49.6.6  raeburn   404:     return ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,
                    405:             $topLevelParts,$topLevelRight,$topLevelAttempted);
                    406: }
1.5       bowersj2  407: 
1.49.6.6  raeburn   408: #
                    409: # Outputting everything.
                    410: #
                    411: 
                    412: sub outputTable {
                    413: 
1.49.6.8.2.4  raeburn   414:     my ($r,$showPoints,$notshowTotals,$nostdtotals,$navmap,$totalParts,$totalPossible,
                    415:         $totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_;
1.5       bowersj2  416: 
1.7       bowersj2  417:     my @start = (255, 255, 192);
1.5       bowersj2  418:     my @end   = (0, 192, 0);
                    419: 
                    420:     my $indentString = '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;';
                    421: 
                    422:     # Second pass: Print the maps.
1.43      bisitz    423:     $r->print(&Apache::loncommon::start_data_table()
                    424:              .&Apache::loncommon::start_data_table_header_row()
                    425:              .'<th>'.&mt('Folder').'</th>');
1.49.6.5  raeburn   426:     my $title = &mt($showPoints ? "Points Scored" : "Done");
1.28      bowersj2  427:     if ($totalAttempted) {
1.49.6.6  raeburn   428:         $title .= " / " . &mt("Attempted");
1.28      bowersj2  429:     }
1.49      www       430:     $r->print("<th>$title".($notshowTotals?'':" / ".&mt('Total')).'</th>'
1.43      bisitz    431:              .&Apache::loncommon::end_data_table_header_row());
1.49.6.6  raeburn   432: #
                    433: # Output of folder scores
                    434: #
                    435: 
                    436:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    437:     my $depth = 1;
                    438:     $iterator->next(); # ignore first BEGIN_MAP
                    439:     my $curRes = $iterator->next();
                    440: 
1.5       bowersj2  441:     while ($depth > 0) {
                    442:         if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
                    443:         if ($curRes == $iterator->END_MAP()) { $depth--; }
                    444: 
                    445:         if (ref($curRes) && $curRes->is_map()) {
                    446:             my $title = $curRes->compTitle();
                    447:             
                    448:             my $correct = $curRes->{DATA}->{CHILD_CORRECT};
                    449:             my $total = $curRes->{DATA}->{CHILD_PARTS};
1.28      bowersj2  450: 	    my $attempted = $curRes->{DATA}->{CHILD_ATTEMPTED};
1.5       bowersj2  451: 
1.6       bowersj2  452:             if ($total > 0) {
                    453:                 my $ratio;
                    454:                 $ratio = $correct / $total;
1.49.6.4  raeburn   455:                 my $color = &mixColors(\@start, \@end, $ratio);
1.43      bisitz    456:                 $r->print(&Apache::loncommon::start_data_table_row()
                    457:                          .'<td style="background-color:'.$color.';">');
1.6       bowersj2  458:                 
1.15      bowersj2  459: 		my $thisIndent = '';
                    460:                 for (my $i = 1; $i < $depth; $i++) { $thisIndent .= $indentString; }
1.6       bowersj2  461:                 
1.15      bowersj2  462:                 $r->print("$thisIndent$title</td>");
1.28      bowersj2  463: 		if ($totalAttempted) {
1.45      bisitz    464: 		    $r->print('<td valign="top">'
                    465:                              .$thisIndent
                    466:                              .'<span class="LC_nobreak">'
1.49      www       467:                              .$correct.' / '.$attempted.($notshowTotals?'':' / '.$total)
1.45      bisitz    468:                              .'</span></td>'
                    469:                              .&Apache::loncommon::end_data_table_row()
                    470:                     );
1.28      bowersj2  471: 		} else {
1.45      bisitz    472: 		    $r->print('<td valign="top">'
                    473:                              .$thisIndent
                    474:                              .'<span class="LC_nobreak">'
1.49      www       475:                              .$correct.($notshowTotals?'':' / '.$total)
1.45      bisitz    476:                              .'</span></td>'
1.43      bisitz    477:                              .&Apache::loncommon::end_data_table_row());
1.28      bowersj2  478: 		}
1.6       bowersj2  479:             }
1.5       bowersj2  480:         }
1.4       bowersj2  481: 
1.5       bowersj2  482:         $curRes = $iterator->next();
                    483:     }
1.4       bowersj2  484: 
1.6       bowersj2  485:     # If there were any problems at the top level, print an extra "catchall"
1.15      bowersj2  486:     if ($topLevelParts > 0) {
                    487:         my $ratio = $topLevelRight / $topLevelParts;
1.49.6.4  raeburn   488:         my $color = &mixColors(\@start, \@end, $ratio);
1.43      bisitz    489:         $r->print(&Apache::loncommon::start_data_table_row()
                    490:                  .'<td style="background-color:'.$color.';">');
1.25      www       491:         $r->print(&mt("Problems Not Contained In A Folder")."</td><td>");
1.43      bisitz    492:         $r->print("$topLevelRight / $topLevelParts</td>"
                    493:                  .&Apache::loncommon::end_data_table_row());
1.6       bowersj2  494:     }
1.4       bowersj2  495: 
1.49.6.6  raeburn   496: #
                    497: # show totals (if applicable), close table
                    498: #
1.35      albertel  499:     if ($showPoints) {
1.49.6.8.2.4  raeburn   500:         unless ($nostdtotals) {
                    501: 	    my $maxHelpLink = &Apache::loncommon::help_open_topic("Quick_Grades_Possibly_Correct");
1.2       bowersj2  502: 
1.49.6.8.2.4  raeburn   503: 	    $title = $showPoints ? "Points" : "Parts Done";
                    504: 	    my $totaltitle = $showPoints ? &mt("Awarded Total Points") : &mt("Total Parts Done");
                    505: 	    $r->print(&Apache::loncommon::start_data_table_row()
                    506:                      .'<td colspan="2" align="right">'.$totaltitle.': <b>'.$totalRight.'</b><br />');
                    507: 	    $r->print(&mt('Max Possible To Date')." $maxHelpLink: <b>$totalPossible</b><br />");
                    508: 	    $title = $showPoints ? "Points" : "Parts";
                    509: 	    $r->print(&mt("Total $title In Course").': <b>'.$totalParts.'</b></td>'
                    510:                      .&Apache::loncommon::end_data_table_row());
                    511:         }
1.34      www       512:     }
1.1       bowersj2  513: 
1.49.6.6  raeburn   514:     $r->print(&Apache::loncommon::end_data_table());
                    515:     return;
1.5       bowersj2  516: }
                    517: 
1.49.6.4  raeburn   518: sub startpage {
                    519:     my ($r,$showPoints) = @_;
                    520:     my $title = "Grading and Statistics";#$showPoints ? "Points Display" : "Completed Problems Display";
                    521:     my $brcrum = [{href=>"/adm/quickgrades",text => "Points Display"}];
                    522:     $r->print(&Apache::loncommon::start_page($title,undef,
                    523:                                             {'bread_crumbs' => $brcrum})
                    524:              );
                    525: }
                    526: 
1.49.6.6  raeburn   527: sub startGradeScreen {
                    528:     my ($r)=@_;
                    529: 
                    530:     my $showPoints =
                    531:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard';
1.49.6.8.2.4  raeburn   532:     my $hidetotals =
                    533:         $env{'course.'.$env{'request.course.id'}.'.hidetotals'};
1.49.6.6  raeburn   534:     my $notshowSPRSlink =
                    535:         (($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'external')
                    536:       || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'));
                    537:     my $notshowTotals =
                    538:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals';
                    539:     my $showSPRSlink =
                    540:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'spreadsheet';
                    541: 
                    542:     my $allowed_to_view = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
                    543:     if ((!$allowed_to_view) && ($env{'request.course.sec'} ne '')) {
                    544:         $allowed_to_view = &Apache::lonnet::allowed('vgr',
                    545:                                "$env{'request.course.id'}/$env{'request.course.sec'}");
                    546:     }
                    547: 
                    548:     my $allowed_to_edit = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
                    549:     if ((!$allowed_to_edit) && ($env{'request.course.sec'} ne '')) {
                    550:         $allowed_to_edit = &Apache::lonnet::allowed('mgr',
                    551:                                "$env{'request.course.id'}/$env{'request.course.sec'}");
                    552:     }
                    553: 
                    554:     if ($allowed_to_view) {
                    555:         my @notes;
                    556:         push(@notes,&mt('Students do not see total points.')) if ($notshowTotals);
                    557:         push(@notes,&mt('Students do not see link to spreadsheet.')) if ($notshowSPRSlink);
                    558:         push(@notes,&mt('Students will see points based on problem weights.')) if ($showPoints);
1.49.6.8.2.4  raeburn   559:         if (($showPoints) && ($hidetotals ne '')) {
                    560:             if ($hidetotals eq 'all') {
                    561:                 push(@notes,&mt('Students do not see course totals.'));
                    562:             } else {
                    563:                 my @secs = split(/,/,$hidetotals);
                    564:                 if (@secs == 1) {
                    565:                     push(@notes,&mt('Students in section [_1] do not see course totals.',
                    566:                                     $hidetotals));
                    567:                 } elsif (@secs > 1) {
                    568:                     push(@notes,&mt('Students in sections [_1] do not see course totals.',
                    569:                                     join(', ',@secs)));
                    570:                 }
                    571:             }
                    572:         }
1.49.6.6  raeburn   573:         push(@notes,&mt('Students will see link to spreadsheet.')) if ($showSPRSlink);
                    574:         push(@notes,&Apache::lonhtmlcommon::coursepreflink(&mt('Grade display settings'),'grading'));
                    575:         $r->print(&Apache::loncommon::head_subbox(join('&nbsp;&nbsp;',@notes)));
                    576:     } elsif (!$allowed_to_edit) {
                    577:         if (!$showPoints && !$notshowSPRSlink ) {
                    578:             $r->print(&Apache::loncommon::head_subbox(
                    579:                       &mt('This screen shows how many problems (or problem parts) you have completed'
                    580:                      .', and how many you have not yet done.'
                    581:                      .' You can also look at [_1]a detailed score sheet[_2].'
                    582:                      ,'<a href="/adm/studentcalc">','</a>')));
                    583:         }
                    584:     }
                    585:     return;
                    586: }
                    587: 
                    588: sub endGradeScreen {
                    589:     my ($r)=@_;
                    590:     $r->print(&Apache::loncommon::end_page());
                    591:     return;
                    592: }
                    593: 
1.5       bowersj2  594: # Pass this two refs to arrays for the start and end color, and a number
                    595: # from 0 to 1 for how much of the latter you want to mix in. It will
                    596: # return a string ready to show ("#FFC309");
                    597: sub mixColors {
                    598:     my $start = shift;
                    599:     my $end = shift;
                    600:     my $ratio = shift;
                    601:     
1.9       matthew   602:     my ($a,$b);
1.5       bowersj2  603:     my $final = "";
1.9       matthew   604:     $a = $start->[0]; $b = $end->[0];
1.5       bowersj2  605:     my $mix1 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
1.9       matthew   606:     $a = $start->[1]; $b = $end->[1];
1.5       bowersj2  607:     my $mix2 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
1.9       matthew   608:     $a = $start->[2]; $b = $end->[2];
1.5       bowersj2  609:     my $mix3 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
                    610: 
1.16      bowersj2  611:     $final = sprintf "%02x%02x%02x", $mix1, $mix2, $mix3;
1.5       bowersj2  612:     return "#" . $final;
1.1       bowersj2  613: }
                    614: 
                    615: 1;

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