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

1.1       bowersj2    1: # The LearningOnline Network with CAPA
                      2: # Quick Student Grades Display
                      3: #
1.49.6.8.2.6! raeburn     4: # $Id: lonquickgrades.pm,v 1.49.6.8.2.5 2024/01/05 19:50:32 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.8.2.6! raeburn   206:     my $usec;
        !           207:     if ($cangrade) {
        !           208:         if (($uname eq $env{'user.name'}) && ($udom eq $env{'user.domain'})) {
        !           209:             $usec = $env{'request.course.sec'};
        !           210:         } else {
        !           211:             $usec = &Apache::lonnet::getsection($udom,$uname,$env{'request.course.id'});
        !           212:         }
        !           213:     } else {
        !           214:         $usec = $env{'request.course.sec'};
        !           215:     }
        !           216: 
1.49.6.6  raeburn   217:     my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,
1.49.6.8.2.6! raeburn   218:         $topLevelRight,$topLevelAttempted) = &getData($showPoints,$uname,$udom,$usec);
1.1       bowersj2  219: 
1.49.6.6  raeburn   220:     if (ref($navmap)) {
1.49.6.8.2.4  raeburn   221:         my $nostdtotals;
                    222:         if ($showPoints) {
                    223:             if ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard') {
                    224:                 my $hidetotals = $env{'course.'.$env{'request.course.id'}.'.hidetotals'};
                    225:                 if ($hidetotals eq 'all') {
                    226:                     $nostdtotals = 1;
                    227:                 } elsif ($hidetotals ne '') {
                    228:                     if ($usec ne '') {
                    229:                         my %secnototals;
                    230:                         map { $secnototals{$_} = 1; } split(/,/,$hidetotals);
                    231:                         if ($secnototals{$usec}) {
                    232:                             $nostdtotals = 1;
                    233:                         }
                    234:                     }
                    235:                 }
                    236:             }
                    237:         }
                    238:         &outputTable($r,$showPoints,$notshowTotals,$nostdtotals,$navmap,
                    239:                      $totalParts,$totalPossible,$totalRight,$totalAttempted,
                    240:                      $topLevelParts,$topLevelRight,$topLevelAttempted);
1.49.6.6  raeburn   241:     } else {
                    242:         if ($cangrade) { $r->print("\n</form>\n"); }
1.7       bowersj2  243:         my $requrl = $r->uri;
1.49.6.6  raeburn   244:         $env{'user.error.msg'} = "$requrl:bre:0:0:Navmap initialization failed.";
1.7       bowersj2  245:         return HTTP_NOT_ACCEPTABLE;
                    246:     }
1.49.6.6  raeburn   247:     if ($cangrade) { $r->print("\n</form>\n"); }
                    248:     &endGradeScreen($r);
                    249:     return OK;
                    250: }
1.7       bowersj2  251: 
1.49.6.8  raeburn   252: sub grades_blocked {
                    253:     my ($r,$blocktext,$caller) = @_;
                    254:     my $title = 'Points Display';
                    255:     if ($caller eq 'spreadsheet') {
                    256:         $title = 'Spreadsheet';
                    257:     } elsif ($env{'course.'.$env{'request.course.id'}.'.grading'} ne 'standard') {
                    258:         $title = 'Completed Problems Display';
                    259:     }
                    260:     my $brcrum = [{href=>"/adm/quickgrades",text => $title}];
                    261:     &Apache::lonhtmlcommon::clear_breadcrumbs();
                    262:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/quickgrades',
                    263:                                             text=> $title});
                    264:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs($title);
                    265:     &Apache::loncommon::content_type($r,'text/html');
                    266:     &Apache::loncommon::no_cache($r);
                    267:     $r->send_http_header;
                    268:     $r->print(&Apache::loncommon::start_page($title).
                    269:               $breadcrumbs.
                    270:               $blocktext.
                    271:               &Apache::loncommon::end_page());
                    272:     return;
                    273: }
                    274: 
1.49.6.6  raeburn   275: #
                    276: # Go through the complete course and collect data
                    277: #
1.17      bowersj2  278: 
1.49.6.6  raeburn   279: sub getData {
1.17      bowersj2  280: 
1.49.6.8.2.6! raeburn   281:     my ($showPoints,$uname,$udom,$usec)=@_;
1.2       bowersj2  282: 
1.49.6.6  raeburn   283:     # Create the nav map
1.49.6.8.2.6! raeburn   284:     my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom,$usec);
1.49.6.6  raeburn   285: 
                    286:     if (!defined($navmap)) {
                    287:         return ();
                    288:     }
                    289: 
                    290:     my $res = $navmap->firstResource(); # temp resource to access constants
1.1       bowersj2  291: 
                    292:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    293:     my $depth = 1;
                    294:     $iterator->next(); # ignore first BEGIN_MAP
                    295:     my $curRes = $iterator->next();
1.49.6.6  raeburn   296: 
1.5       bowersj2  297:     # General overview of the following: Walk along the course resources.
                    298:     # For every problem in the resource, tell its parent maps how many
                    299:     # parts and how many parts correct it has. After that, each map will
                    300:     # have a count of the total parts underneath it, correct and otherwise.
                    301:     # After that, we will walk through the course again and read off
                    302:     # maps in order, with their data. 
                    303:     # (If in the future people decide not to be cumulative, only add
                    304:     #  the counts to the parent map.)
1.17      bowersj2  305:     # For convenience, "totalParts" is also "totalPoints" when we're looking
                    306:     #  at points; I can't come up with a variable name that makes sense
                    307:     #  equally for both cases.
1.5       bowersj2  308: 
                    309:     my $totalParts = 0; my $totalPossible = 0; my $totalRight = 0;
1.28      bowersj2  310:     my $totalAttempted = 0;
1.14      bowersj2  311:     my $now = time();
1.28      bowersj2  312:     my $topLevelParts = 0; my $topLevelRight = 0; my $topLevelAttempted = 0;
1.5       bowersj2  313: 
                    314:     # Pre-run: Count parts correct
1.1       bowersj2  315:     while ( $depth > 0 ) {
                    316:         if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
                    317:         if ($curRes == $iterator->END_MAP()) { $depth--; }
                    318: 
1.49.6.8.2.3  raeburn   319:         if (ref($curRes) && $curRes->is_gradable() && !$curRes->randomout)
1.5       bowersj2  320:         {
                    321:             # Get number of correct, incorrect parts
                    322:             my $parts = $curRes->parts();
                    323:             my $partsRight = 0;
1.17      bowersj2  324: 	    my $partsCount = 0;
1.28      bowersj2  325: 	    my $partsAttempted = 0;
1.5       bowersj2  326:             my $stack = $iterator->getStack();
                    327:             
                    328:             for my $part (@{$parts}) {
1.28      bowersj2  329: 		my $dateStatus = $curRes->getDateStatus($part);
1.49.6.6  raeburn   330:                 my $weight = $curRes->weight($part);
                    331:                 my $problemstatus = $curRes->problemstatus($part);
                    332: 
                    333:                 if ($curRes->solved($part) eq 'excused') {
1.21      matthew   334:                     next;
                    335:                 }
1.17      bowersj2  336: 		if ($showPoints) {
1.28      bowersj2  337: 		    my $score = 0;
                    338: 		    # If we're not telling status and the answer date isn't passed yet, 
                    339: 		    # it's an "attempted" point
1.49.6.6  raeburn   340: 		    if ((($problemstatus eq 'no') ||
                    341:                          ($problemstatus eq 'no_feedback_ever')) &&
1.28      bowersj2  342: 			($dateStatus != $curRes->ANSWER_OPEN)) {
1.31      albertel  343: 			my $status = $curRes->simpleStatus($part);
                    344: 			if ($status == $curRes->ATTEMPTED) {
1.49.6.6  raeburn   345: 			    $partsAttempted += $weight;
1.31      albertel  346: 			    $totalAttempted += $partsAttempted;
                    347: 			}
1.28      bowersj2  348: 		    } else {
1.49.6.6  raeburn   349: 			$score = &Apache::grades::compute_points($weight, $curRes->awarded($part));
1.28      bowersj2  350: 		    }
1.17      bowersj2  351: 		    $partsRight += $score;
                    352: 		    $totalRight += $score;
1.49.6.6  raeburn   353: 		    $partsCount += $weight;
1.18      bowersj2  354: 
1.17      bowersj2  355: 		    if ($curRes->opendate($part) < $now) {
1.49.6.6  raeburn   356: 			$totalPossible += $weight;
1.17      bowersj2  357: 		    }
1.49.6.6  raeburn   358: 		    $totalParts += $weight;
1.17      bowersj2  359: 		} else {
1.27      bowersj2  360: 		    my $status = $curRes->simpleStatus($part);
1.17      bowersj2  361: 		    my $thisright = 0;
                    362: 		    $partsCount++;
1.37      albertel  363: 		    if ($status == $curRes->CORRECT ||
                    364: 			$status == $curRes->PARTIALLY_CORRECT ) {
1.17      bowersj2  365: 			$partsRight++;
                    366: 			$totalRight++;
                    367: 			$thisright = 1;
                    368: 		    }
1.28      bowersj2  369: 
                    370: 		    if ($status == $curRes->ATTEMPTED) {
                    371: 			$partsAttempted++;
                    372: 			$totalAttempted++;
                    373: 		    }
1.17      bowersj2  374: 		    
1.19      bowersj2  375: 		    $totalParts++;
1.17      bowersj2  376: 		    if ($curRes->opendate($part) < $now) {
                    377: 			$totalPossible++;
                    378: 		    }
                    379: 		}
1.5       bowersj2  380:             }
1.15      bowersj2  381: 
                    382:             if ($depth == 1) { # in top-level only
1.19      bowersj2  383: 		$topLevelParts += $partsCount;
1.15      bowersj2  384: 		$topLevelRight += $partsRight;
1.28      bowersj2  385: 		$topLevelAttempted += $partsAttempted;
1.15      bowersj2  386: 	    }
                    387: 
1.5       bowersj2  388:             # Crawl down stack and record parts correct and total
                    389:             for my $res (@{$stack}) {
                    390:                 if (ref($res) && $res->is_map()) {
                    391:                     if (!defined($res->{DATA}->{CHILD_PARTS})) {
                    392:                         $res->{DATA}->{CHILD_PARTS} = 0;
                    393:                         $res->{DATA}->{CHILD_CORRECT} = 0;
1.28      bowersj2  394: 			$res->{DATA}->{CHILD_ATTEMPTED} = 0;
1.5       bowersj2  395:                     }
                    396:                     
1.17      bowersj2  397:                     $res->{DATA}->{CHILD_PARTS} += $partsCount;
1.5       bowersj2  398:                     $res->{DATA}->{CHILD_CORRECT} += $partsRight;
1.28      bowersj2  399: 		    $res->{DATA}->{CHILD_ATTEMPTED} += $partsAttempted;
1.5       bowersj2  400:                 }
                    401:             }
                    402:         }
                    403:         $curRes = $iterator->next();
                    404:     }
1.49.6.6  raeburn   405:     return ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,
                    406:             $topLevelParts,$topLevelRight,$topLevelAttempted);
                    407: }
1.5       bowersj2  408: 
1.49.6.6  raeburn   409: #
                    410: # Outputting everything.
                    411: #
                    412: 
                    413: sub outputTable {
                    414: 
1.49.6.8.2.4  raeburn   415:     my ($r,$showPoints,$notshowTotals,$nostdtotals,$navmap,$totalParts,$totalPossible,
                    416:         $totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_;
1.5       bowersj2  417: 
1.7       bowersj2  418:     my @start = (255, 255, 192);
1.5       bowersj2  419:     my @end   = (0, 192, 0);
                    420: 
                    421:     my $indentString = '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;';
                    422: 
                    423:     # Second pass: Print the maps.
1.43      bisitz    424:     $r->print(&Apache::loncommon::start_data_table()
                    425:              .&Apache::loncommon::start_data_table_header_row()
                    426:              .'<th>'.&mt('Folder').'</th>');
1.49.6.5  raeburn   427:     my $title = &mt($showPoints ? "Points Scored" : "Done");
1.28      bowersj2  428:     if ($totalAttempted) {
1.49.6.6  raeburn   429:         $title .= " / " . &mt("Attempted");
1.28      bowersj2  430:     }
1.49      www       431:     $r->print("<th>$title".($notshowTotals?'':" / ".&mt('Total')).'</th>'
1.43      bisitz    432:              .&Apache::loncommon::end_data_table_header_row());
1.49.6.6  raeburn   433: #
                    434: # Output of folder scores
                    435: #
                    436: 
                    437:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    438:     my $depth = 1;
                    439:     $iterator->next(); # ignore first BEGIN_MAP
                    440:     my $curRes = $iterator->next();
                    441: 
1.5       bowersj2  442:     while ($depth > 0) {
                    443:         if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
                    444:         if ($curRes == $iterator->END_MAP()) { $depth--; }
                    445: 
                    446:         if (ref($curRes) && $curRes->is_map()) {
                    447:             my $title = $curRes->compTitle();
                    448:             
                    449:             my $correct = $curRes->{DATA}->{CHILD_CORRECT};
                    450:             my $total = $curRes->{DATA}->{CHILD_PARTS};
1.28      bowersj2  451: 	    my $attempted = $curRes->{DATA}->{CHILD_ATTEMPTED};
1.5       bowersj2  452: 
1.6       bowersj2  453:             if ($total > 0) {
                    454:                 my $ratio;
                    455:                 $ratio = $correct / $total;
1.49.6.4  raeburn   456:                 my $color = &mixColors(\@start, \@end, $ratio);
1.43      bisitz    457:                 $r->print(&Apache::loncommon::start_data_table_row()
                    458:                          .'<td style="background-color:'.$color.';">');
1.6       bowersj2  459:                 
1.15      bowersj2  460: 		my $thisIndent = '';
                    461:                 for (my $i = 1; $i < $depth; $i++) { $thisIndent .= $indentString; }
1.6       bowersj2  462:                 
1.15      bowersj2  463:                 $r->print("$thisIndent$title</td>");
1.28      bowersj2  464: 		if ($totalAttempted) {
1.45      bisitz    465: 		    $r->print('<td valign="top">'
                    466:                              .$thisIndent
                    467:                              .'<span class="LC_nobreak">'
1.49      www       468:                              .$correct.' / '.$attempted.($notshowTotals?'':' / '.$total)
1.45      bisitz    469:                              .'</span></td>'
                    470:                              .&Apache::loncommon::end_data_table_row()
                    471:                     );
1.28      bowersj2  472: 		} else {
1.45      bisitz    473: 		    $r->print('<td valign="top">'
                    474:                              .$thisIndent
                    475:                              .'<span class="LC_nobreak">'
1.49      www       476:                              .$correct.($notshowTotals?'':' / '.$total)
1.45      bisitz    477:                              .'</span></td>'
1.43      bisitz    478:                              .&Apache::loncommon::end_data_table_row());
1.28      bowersj2  479: 		}
1.6       bowersj2  480:             }
1.5       bowersj2  481:         }
1.4       bowersj2  482: 
1.5       bowersj2  483:         $curRes = $iterator->next();
                    484:     }
1.4       bowersj2  485: 
1.6       bowersj2  486:     # If there were any problems at the top level, print an extra "catchall"
1.15      bowersj2  487:     if ($topLevelParts > 0) {
                    488:         my $ratio = $topLevelRight / $topLevelParts;
1.49.6.4  raeburn   489:         my $color = &mixColors(\@start, \@end, $ratio);
1.43      bisitz    490:         $r->print(&Apache::loncommon::start_data_table_row()
                    491:                  .'<td style="background-color:'.$color.';">');
1.25      www       492:         $r->print(&mt("Problems Not Contained In A Folder")."</td><td>");
1.43      bisitz    493:         $r->print("$topLevelRight / $topLevelParts</td>"
                    494:                  .&Apache::loncommon::end_data_table_row());
1.6       bowersj2  495:     }
1.4       bowersj2  496: 
1.49.6.6  raeburn   497: #
                    498: # show totals (if applicable), close table
                    499: #
1.35      albertel  500:     if ($showPoints) {
1.49.6.8.2.4  raeburn   501:         unless ($nostdtotals) {
                    502: 	    my $maxHelpLink = &Apache::loncommon::help_open_topic("Quick_Grades_Possibly_Correct");
1.2       bowersj2  503: 
1.49.6.8.2.4  raeburn   504: 	    $title = $showPoints ? "Points" : "Parts Done";
                    505: 	    my $totaltitle = $showPoints ? &mt("Awarded Total Points") : &mt("Total Parts Done");
                    506: 	    $r->print(&Apache::loncommon::start_data_table_row()
                    507:                      .'<td colspan="2" align="right">'.$totaltitle.': <b>'.$totalRight.'</b><br />');
                    508: 	    $r->print(&mt('Max Possible To Date')." $maxHelpLink: <b>$totalPossible</b><br />");
                    509: 	    $title = $showPoints ? "Points" : "Parts";
                    510: 	    $r->print(&mt("Total $title In Course").': <b>'.$totalParts.'</b></td>'
                    511:                      .&Apache::loncommon::end_data_table_row());
                    512:         }
1.34      www       513:     }
1.1       bowersj2  514: 
1.49.6.6  raeburn   515:     $r->print(&Apache::loncommon::end_data_table());
                    516:     return;
1.5       bowersj2  517: }
                    518: 
1.49.6.4  raeburn   519: sub startpage {
                    520:     my ($r,$showPoints) = @_;
                    521:     my $title = "Grading and Statistics";#$showPoints ? "Points Display" : "Completed Problems Display";
                    522:     my $brcrum = [{href=>"/adm/quickgrades",text => "Points Display"}];
                    523:     $r->print(&Apache::loncommon::start_page($title,undef,
                    524:                                             {'bread_crumbs' => $brcrum})
                    525:              );
                    526: }
                    527: 
1.49.6.6  raeburn   528: sub startGradeScreen {
                    529:     my ($r)=@_;
                    530: 
                    531:     my $showPoints =
                    532:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard';
1.49.6.8.2.4  raeburn   533:     my $hidetotals =
                    534:         $env{'course.'.$env{'request.course.id'}.'.hidetotals'};
1.49.6.6  raeburn   535:     my $notshowSPRSlink =
                    536:         (($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'external')
                    537:       || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'));
                    538:     my $notshowTotals =
                    539:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals';
                    540:     my $showSPRSlink =
                    541:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'spreadsheet';
                    542: 
                    543:     my $allowed_to_view = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
                    544:     if ((!$allowed_to_view) && ($env{'request.course.sec'} ne '')) {
                    545:         $allowed_to_view = &Apache::lonnet::allowed('vgr',
                    546:                                "$env{'request.course.id'}/$env{'request.course.sec'}");
                    547:     }
                    548: 
                    549:     my $allowed_to_edit = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
                    550:     if ((!$allowed_to_edit) && ($env{'request.course.sec'} ne '')) {
                    551:         $allowed_to_edit = &Apache::lonnet::allowed('mgr',
                    552:                                "$env{'request.course.id'}/$env{'request.course.sec'}");
                    553:     }
                    554: 
                    555:     if ($allowed_to_view) {
                    556:         my @notes;
                    557:         push(@notes,&mt('Students do not see total points.')) if ($notshowTotals);
                    558:         push(@notes,&mt('Students do not see link to spreadsheet.')) if ($notshowSPRSlink);
                    559:         push(@notes,&mt('Students will see points based on problem weights.')) if ($showPoints);
1.49.6.8.2.4  raeburn   560:         if (($showPoints) && ($hidetotals ne '')) {
                    561:             if ($hidetotals eq 'all') {
                    562:                 push(@notes,&mt('Students do not see course totals.'));
                    563:             } else {
                    564:                 my @secs = split(/,/,$hidetotals);
                    565:                 if (@secs == 1) {
                    566:                     push(@notes,&mt('Students in section [_1] do not see course totals.',
                    567:                                     $hidetotals));
                    568:                 } elsif (@secs > 1) {
                    569:                     push(@notes,&mt('Students in sections [_1] do not see course totals.',
                    570:                                     join(', ',@secs)));
                    571:                 }
                    572:             }
                    573:         }
1.49.6.6  raeburn   574:         push(@notes,&mt('Students will see link to spreadsheet.')) if ($showSPRSlink);
                    575:         push(@notes,&Apache::lonhtmlcommon::coursepreflink(&mt('Grade display settings'),'grading'));
                    576:         $r->print(&Apache::loncommon::head_subbox(join('&nbsp;&nbsp;',@notes)));
                    577:     } elsif (!$allowed_to_edit) {
                    578:         if (!$showPoints && !$notshowSPRSlink ) {
                    579:             $r->print(&Apache::loncommon::head_subbox(
                    580:                       &mt('This screen shows how many problems (or problem parts) you have completed'
                    581:                      .', and how many you have not yet done.'
                    582:                      .' You can also look at [_1]a detailed score sheet[_2].'
                    583:                      ,'<a href="/adm/studentcalc">','</a>')));
                    584:         }
                    585:     }
                    586:     return;
                    587: }
                    588: 
                    589: sub endGradeScreen {
                    590:     my ($r)=@_;
                    591:     $r->print(&Apache::loncommon::end_page());
                    592:     return;
                    593: }
                    594: 
1.5       bowersj2  595: # Pass this two refs to arrays for the start and end color, and a number
                    596: # from 0 to 1 for how much of the latter you want to mix in. It will
                    597: # return a string ready to show ("#FFC309");
                    598: sub mixColors {
                    599:     my $start = shift;
                    600:     my $end = shift;
                    601:     my $ratio = shift;
                    602:     
1.9       matthew   603:     my ($a,$b);
1.5       bowersj2  604:     my $final = "";
1.9       matthew   605:     $a = $start->[0]; $b = $end->[0];
1.5       bowersj2  606:     my $mix1 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
1.9       matthew   607:     $a = $start->[1]; $b = $end->[1];
1.5       bowersj2  608:     my $mix2 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
1.9       matthew   609:     $a = $start->[2]; $b = $end->[2];
1.5       bowersj2  610:     my $mix3 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
                    611: 
1.16      bowersj2  612:     $final = sprintf "%02x%02x%02x", $mix1, $mix2, $mix3;
1.5       bowersj2  613:     return "#" . $final;
1.1       bowersj2  614: }
                    615: 
                    616: 1;

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