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

1.1       bowersj2    1: # The LearningOnline Network with CAPA
                      2: # Quick Student Grades Display
                      3: #
1.120   ! raeburn     4: # $Id: lonquickgrades.pm,v 1.119 2020/09/01 03:39:38 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.104     musolffc   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.100     www        38: use Apache::loncoursedata;
1.101     www        39: use Apache::lonstudentassessment;
1.107     raeburn    40: use Apache::lonuserstate;
1.1       bowersj2   41: 
1.102     www        42: use Time::HiRes;
                     43: use Spreadsheet::WriteExcel;
                     44: use Spreadsheet::WriteExcel::Utility();
                     45: #
                     46: # Excel data
                     47: #
                     48: my $excel_sheet;
                     49: my $excel_workbook;
                     50: my $filename;
                     51: my $format;
                     52: my $request_aborted;
                     53: my $header_row;
                     54: my $cols_output;
                     55: my %prog_state;
                     56: 
                     57: 
1.1       bowersj2   58: sub handler {
                     59:     my $r = shift;
1.5       bowersj2   60:     return real_handler($r);
                     61: }
                     62: 
                     63: sub real_handler {
                     64:     my $r = shift;
1.1       bowersj2   65: 
                     66:     &Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING});
                     67: 
                     68:     # Handle header-only request
1.40      albertel   69:     if ($env{'browser.mathml'}) {
                     70: 	&Apache::loncommon::content_type($r,'text/xml');
                     71:     } else {
                     72: 	&Apache::loncommon::content_type($r,'text/html');
                     73:     }
1.1       bowersj2   74:     if ($r->header_only) {
1.40      albertel   75: 	$r->send_http_header;
1.1       bowersj2   76:         return OK;
                     77:     }
                     78: 
1.106     raeburn    79:     my $cangrade=&Apache::lonnet::allowed('mgr');
1.111     raeburn    80:     my $showPoints =
                     81:         (($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard')
                     82:       || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories'));
                     83: 
                     84:     my $reinitresult;
1.106     raeburn    85: 
1.117     raeburn    86:     if ($env{'request.course.id'}) {
                     87:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                     88:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                     89:         my ($blocked,$blocktext) =
                     90:             &Apache::loncommon::blocking_status('grades',$cnum,$cdom);
                     91:         if ($blocked) {
                     92:             my $checkrole = "cm./$cdom/$cnum";
                     93:             if ($env{'request.course.sec'} ne '') {
                     94:                 $checkrole .= "/$env{'request.course.sec'}";
                     95:             }
                     96:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                     97:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                     98:                 &grades_blocked($r,$blocktext,$showPoints);
                     99:                 return OK;
                    100:             }
                    101:         }
                    102:     }
                    103: 
1.106     raeburn   104:     unless ($cangrade) {
                    105:         # Check for critical messages and redirect if present.
1.110     raeburn   106:         my ($redirect,$url) = &Apache::loncommon::critical_redirect(300,'grades');
1.106     raeburn   107:         if ($redirect) {
                    108:             &Apache::loncommon::content_type($r,'text/html');
                    109:             $r->header_out(Location => $url);
                    110:             return REDIRECT;
                    111:         }
                    112: 
                    113:         # Check if course needs to be re-initialized
                    114:         my $loncaparev = $r->dir_config('lonVersion');
1.111     raeburn   115:         ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev);
1.106     raeburn   116: 
1.111     raeburn   117:         if ($reinitresult eq 'switch') {
1.106     raeburn   118:             &Apache::loncommon::content_type($r,'text/html');
                    119:             $r->send_http_header;
                    120:             $r->print(&Apache::loncommon::check_release_result(@reinit));
                    121:             return OK;
1.111     raeburn   122:         } elsif ($reinitresult eq 'update') {
                    123:             my $cid = $env{'request.course.id'};
                    124:             my $cnum = $env{'course.'.$cid.'.num'};
                    125:             my $cdom = $env{'course.'.$cid.'.domain'};
                    126:             &Apache::loncommon::content_type($r,'text/html');
                    127:             $r->send_http_header;
                    128:             &startpage($r,$showPoints);
                    129:             my $preamble = '<div id="LC_update_'.$cid.'" class="LC_info">'.
                    130:                            '<br />'.
                    131:                            &mt('Your course session is being updated because of recent changes by course personnel.').
1.120   ! raeburn   132:                            ' '.&mt('Please be patient').'.<br /></div>'.
1.111     raeburn   133:                            '<div style="padding:0;clear:both;margin:0;border:0"></div>';
                    134:             %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($r,undef,$preamble);
                    135:             &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Updating course'));
                    136:             $r->rflush();
1.106     raeburn   137:             my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
1.120   ! raeburn   138:             &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Finished!')); 
1.111     raeburn   139:             &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
                    140:             my $closure = <<ENDCLOSE;
                    141: <script type="text/javascript">
                    142: // <![CDATA[
                    143: \$("#LC_update_$cid").hide('slow');
                    144: // ]]>
                    145: </script>
                    146: ENDCLOSE
1.106     raeburn   147:             if ($ferr) {
1.111     raeburn   148:                 $r->print($closure.&Apache::loncommon::end_page());
1.106     raeburn   149:                 my $requrl = $r->uri;
                    150:                 $env{'user.error.msg'}="$requrl:bre:0:0:Course not initialized";
                    151:                 $env{'user.reinit'} = 1;
                    152:                 return HTTP_NOT_ACCEPTABLE;
1.111     raeburn   153:             } else {
                    154:                $r->print($closure);
1.106     raeburn   155:             }
1.109     raeburn   156:         } elsif ((&Apache::loncommon::course_type() eq 'Placement') &&
                    157:                  (!$env{'request.role.adv'})) {
                    158:             my $furl = &Apache::lonpageflip::first_accessible_resource();
                    159:             &Apache::loncommon::content_type($r,'text/html');
                    160:             $r->header_out(Location => $furl);
                    161:             return REDIRECT;
1.106     raeburn   162:         }
1.105     raeburn   163:     }
                    164: 
1.111     raeburn   165:     unless ($reinitresult eq 'update') {
                    166:         # Send header, don't cache this page
                    167:         &Apache::loncommon::no_cache($r);
                    168:         $r->send_http_header;
                    169:         &startpage($r,$showPoints);
                    170:     }
                    171:     $r->rflush();
1.1       bowersj2  172: 
1.55      www       173:     &startGradeScreen($r,'quick');
1.17      bowersj2  174: 
1.74      www       175: #
                    176: # Pick student
                    177: #
1.54      www       178:     my $uname;
                    179:     my $udom;
1.74      www       180:     my $stdid;
                    181:     if ($cangrade) {
1.101     www       182:         $r->print("<h2>".&mt("Download Multiple")."</h2>".
                    183:                   '<table cellspacing="5">'."\n".
                    184:                   '<tr>'.
                    185:                   '<td align="center"><b>'.&mt('Sections').'</b>'.
                    186:                   &Apache::loncommon::help_open_topic("Chart_Sections").
                    187:                   '</td>'.
                    188:                   '<td align="center"><b>'.&mt('Groups').'</b>'.
                    189:                   '</td>'.
                    190:                   '<td align="center"><b>'.&mt('Student Data').'</b>'.
                    191:                   &Apache::loncommon::help_open_topic("Chart_Student_Data").
                    192:                   '</td>'.
                    193:                   '<td align="center"><b>'.&mt('Access Status').'</b>'.
                    194:                   &Apache::loncommon::help_open_topic("Chart_Enrollment_Status").
                    195:                   '</td>'.
                    196:                   '<td align="center"><b>'.&mt('Output Format').'</b>'.
                    197:                   &Apache::loncommon::help_open_topic("Chart_Output_Formats").
                    198:                   '</td><td>&nbsp;</td></tr>'."\n".
                    199:                   '<tr><td align="center">'."\n".
                    200:                   &Apache::lonstatistics::SectionSelect('Section','multiple',5).
                    201:                   '</td><td align="center">'.
                    202:                   &Apache::lonstatistics::GroupSelect('Group','multiple',5).
                    203:                   '</td><td align="center">'.
                    204:                   &Apache::lonstatistics::StudentDataSelect('StudentData','multiple',5,undef).
                    205:                   '</td><td>'."\n".
                    206:                   &Apache::lonhtmlcommon::StatusOptions(undef,undef,5).
                    207:                   '</td><td>'."\n".
                    208:                   &Apache::lonstudentassessment::CreateAndParseOutputSelector().
                    209:                   '</td><td>'.
                    210:                   '<input type="submit" name="download" value="'.&mt('Display/Download Multiple Students').'" />'.
                    211:                   '</td></tr>'."\n".
                    212:                   '</table>'."\n"
                    213:                  );
                    214:         $r->print("<hr /><h2>".&mt("Display Individual")."</h2>");
1.74      www       215:         if ($env{'form.uname'}) { $uname=$env{'form.uname'}; }
                    216:         if ($env{'form.udom'}) { $udom=$env{'form.udom'}; }
                    217:         if ($env{'form.id'}) { $stdid=$env{'form.id'}; }
                    218:         if (($stdid) && ($udom)) {
1.108     raeburn   219:             $uname=(&Apache::lonnet::idget($udom,[$stdid],'ids'))[1];
1.74      www       220:         }
1.75      www       221:         if (($stdid) && (!$uname)) {
                    222:             $r->print('<p><span class="LC_warning">'.&mt("Unknown Student/Employee ID: [_1]",$stdid).'</span></p>');
                    223:             $stdid='';
                    224:         }
1.118     raeburn   225:         if (($uname eq '') && ($udom eq '')) {
                    226:             $uname = $env{'user.name'};
                    227:             $udom = $env{'user.domain'};
                    228:         }
1.74      www       229:         $r->print('<form method="post" name="quickform" action="/adm/quickgrades">');
                    230:         my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                    231:            &Apache::loncommon::selectstudent_link('quickform','uname','udom');
                    232:         $r->print("<p>\n".&Apache::loncommon::studentbrowser_javascript()."\n");
                    233:         $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
                    234:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                    235:                  ,'<input type="text" value="'.$stdid.'" size="12" name="id" /> '
1.101     www       236:                  ,$chooseopt).
                    237:                  '&nbsp;&nbsp;<input type="submit" name="display" value="'.&mt('Display Individual Student').'" /></p>');
1.75      www       238:         if (($uname) && ($udom)) {
                    239:             $r->print('<p>'.&mt('Full Name: [_1]',&Apache::loncommon::plainname($uname,$udom)).'</p>');
                    240:         }
1.74      www       241:     }
                    242:     $r->rflush();
1.53      www       243: 
1.111     raeburn   244:     my $notshowTotals=
                    245:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals';
                    246:     my $showCategories=
                    247:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories';
                    248: 
1.119     raeburn   249:     my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,
                    250:         $topLevelRight,$topLevelAttempted) = &getData($showPoints,$uname,$udom);
1.53      www       251: 
1.118     raeburn   252:     if (ref($navmap)) {
                    253:         if ($showCategories) {
1.119     raeburn   254:             &outputCategories($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible,
                    255:                               $totalRight,$totalAttempted,$topLevelParts,$topLevelRight,
                    256:                               $topLevelAttempted);
1.118     raeburn   257:         } else {
1.119     raeburn   258:             &outputTable($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible,
                    259:                          $totalRight,$totalAttempted,$topLevelParts,$topLevelRight,
                    260:                          $topLevelAttempted);
1.118     raeburn   261:         }
1.53      www       262:     } else {
1.118     raeburn   263:         if ($cangrade) { $r->print("\n</form>\n"); }
                    264:         my $requrl = $r->uri;
                    265:         $env{'user.error.msg'} = "$requrl:bre:0:0:Navmap initialization failed.";
                    266:         return HTTP_NOT_ACCEPTABLE;
1.53      www       267:     }
1.74      www       268:     if ($cangrade) { $r->print("\n</form>\n"); }
1.55      www       269:     &endGradeScreen($r);
1.51      www       270:     return OK;
                    271: }
1.2       bowersj2  272: 
1.117     raeburn   273: sub grades_blocked {
                    274:     my ($r,$blocktext,$caller) = @_;
                    275:     my $title = 'Points Display';
                    276:     if ($caller eq 'spreadsheet') {
                    277:         $title = 'Spreadsheet';
                    278:     } elsif ($env{'course.'.$env{'request.course.id'}.'.grading'} ne 'standard') {
                    279:         $title = 'Completed Problems Display';
                    280:     }
                    281:     my $brcrum = [{href=>"/adm/quickgrades",text => $title}];
                    282:     &Apache::lonhtmlcommon::clear_breadcrumbs();
                    283:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/quickgrades',
                    284:                                             text=> $title});
                    285:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs($title);
                    286:     &Apache::loncommon::content_type($r,'text/html');
                    287:     &Apache::loncommon::no_cache($r);
                    288:     $r->send_http_header;
                    289:     $r->print(&Apache::loncommon::start_page($title).
                    290:               $breadcrumbs.
                    291:               $blocktext.
                    292:               &Apache::loncommon::end_page());
                    293:     return;
                    294: }
                    295: 
1.99      www       296: sub getStudentCatGrade {
                    297:     my ($uname,$udom,%categories)=@_;
                    298:     my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=
                    299:        &getData(1,$uname,$udom);
                    300:     return &output_category_table(undef,0,$navmap,0,%categories);
                    301: }
                    302: 
                    303: sub getAllStudentData {
                    304:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    305:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.100     www       306: 
1.99      www       307:     my %categories=&Apache::lonnet::dump('grading_categories',$cdom,$cnum);
1.100     www       308: 
                    309:     my $classlist = &Apache::loncoursedata::get_classlist();
                    310: 
                    311:     my $statusidx   = &Apache::loncoursedata::CL_STATUS();
                    312:     my $usernameidx = &Apache::loncoursedata::CL_SNAME();
                    313:     my $domainidx   = &Apache::loncoursedata::CL_SDOM();
                    314:     my $fullnameidx = &Apache::loncoursedata::CL_FULLNAME();
                    315: 
                    316:     foreach my $key (keys(%{$classlist})) {
                    317:         my $student = $classlist->{$key};
                    318:         my $perc=&getStudentCatGrade($classlist->{$student}->[$usernameidx],
                    319:                                      $classlist->{$student}->[$domainidx],
                    320:                                      %categories);
                    321:     }
1.99      www       322: }
                    323: 
1.111     raeburn   324: sub startpage {
                    325:     my ($r,$showPoints) = @_;
                    326:     my $title = "Grading and Statistics";#$showPoints ? "Points Display" : "Completed Problems Display";
                    327:     my $brcrum = [{href=>"/adm/quickgrades",text => "Points Display"}];
                    328:     $r->print(&Apache::loncommon::start_page($title,undef,
                    329:                                             {'bread_crumbs' => $brcrum})
                    330:              );
                    331: }
1.99      www       332: 
1.55      www       333: sub startGradeScreen {
                    334:     my ($r,$mode)=@_;
                    335: 
                    336:     my $showPoints =
                    337:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard';
                    338:     my $notshowSPRSlink =
                    339:         (($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'external')
                    340:       || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals')
                    341:       || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories'));
1.119     raeburn   342:     my $notshowTotals =
1.55      www       343:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals';
1.118     raeburn   344:     my $showSPRSlink =
                    345:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'spreadsheet';
1.119     raeburn   346:     my $showCategories =
1.55      www       347:         $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories';
1.115     raeburn   348:  
                    349:     my $allowed_to_view = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
                    350:     if ((!$allowed_to_view) && ($env{'request.course.sec'} ne '')) {
                    351:         $allowed_to_view = &Apache::lonnet::allowed('vgr',
                    352:                                "$env{'request.course.id'}/$env{'request.course.sec'}");
                    353:     }
1.55      www       354: 
1.115     raeburn   355:     my $allowed_to_edit = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.116     raeburn   356:     if ((!$allowed_to_edit) && ($env{'request.course.sec'} ne '')) {
1.115     raeburn   357:         $allowed_to_edit = &Apache::lonnet::allowed('mgr',
                    358:                                "$env{'request.course.id'}/$env{'request.course.sec'}");
                    359:     }
1.55      www       360: 
                    361:     if ($allowed_to_view) {
1.61      raeburn   362:        my @notes;
                    363:        push(@notes,&mt('Students do not see total points.')) if ($notshowTotals);
                    364:        push(@notes,&mt('Students do not see link to spreadsheet.')) if ($notshowSPRSlink);
                    365:        push(@notes,&mt('Students will see points based on problem weights.')) if ($showPoints);
                    366:        push(@notes,&mt('Students will see points based on categories.')) if ($showCategories);
1.118     raeburn   367:        push(@notes,&mt('Students will see link to spreadsheet.')) if ($showSPRSlink);
1.61      raeburn   368:        push(@notes, &Apache::lonhtmlcommon::coursepreflink(&mt('Grade display settings'),'grading'));
                    369:        $r->print(&Apache::loncommon::head_subbox(join('&nbsp;&nbsp;',@notes)));
1.55      www       370:     }
                    371: 
                    372: 
1.56      www       373:     $r->print("\n".'<ul class="LC_TabContentBigger" id="main">');
1.57      www       374:     $r->print("\n".'<li'.($mode eq 'quick'?' class="active"':'').'><a href="/adm/quickgrades"><b>&nbsp;&nbsp;&nbsp;&nbsp;'.
1.62      www       375:                                           ($showPoints?&mt('Individual Points Overview'):($showCategories?&mt('Grades Overview'):&mt('Completion Overview'))).
1.57      www       376:                                           '&nbsp;&nbsp;&nbsp;&nbsp;</b></a></li>');
1.55      www       377: 
                    378:     if (!($showPoints || $notshowSPRSlink) || ($allowed_to_view)) {
1.56      www       379:        $r->print("\n".'<li'.($mode eq 'spreadsheet'?' class="active"':'').'><a href="/adm/'.($allowed_to_view?'classcalc':'studentcalc').'"><b>'.
1.57      www       380:                                                                  &mt('Spreadsheet (Detailed)').'</b></a></li>');
1.55      www       381:     }
1.58      www       382:     if ($allowed_to_view) {
1.63      www       383:        $r->print("\n".'<li'.($mode eq 'statistics'?' class="active"':'').'><a href="/adm/statistics"><b>'.
                    384:                                                                  &mt('Statistics and Reports').'</b></a></li>');
                    385: 
1.58      www       386:        $r->print("\n".'<li'.($mode eq 'chart'?' class="active"':'').'><a href="/adm/statistics?reportSelected=student_assessment"><b>'.
1.113     raeburn   387:                                                                  &mt('Assessment Chart').'</b></a></li>');
1.58      www       388: 
                    389:     }
1.59      www       390:     if ($allowed_to_edit) {
                    391:        $r->print("\n".'<li'.($mode eq 'grading'?' class="active"':'').'><a href="/adm/grades"><b>&nbsp;&nbsp;&nbsp;&nbsp;'.
1.66      www       392:                                                                  &mt('Content Grading').'&nbsp;&nbsp;&nbsp;&nbsp;</b></a></li>');
                    393:        if ($env{'form.symb'}) {
                    394:           $r->print("\n".'<li'.($mode eq 'probgrading'?' class="active"':'').'><a href="/adm/grades?symb='.
                    395:                                               &Apache::lonhtmlcommon::entity_encode($env{'form.symb'}).
1.103     raeburn   396:                                               '&amp;command=gradingmenu"><b>&nbsp;&nbsp;&nbsp;&nbsp;'.
1.66      www       397:                                               &mt('Problem Grading').'&nbsp;&nbsp;&nbsp;&nbsp;</b></a></li>');
                    398: 
                    399:        }
1.59      www       400:     }
1.56      www       401:     $r->print("\n".'</ul>'."\n");
1.55      www       402:     $r->print('<div class="LC_Box" style="clear:both;margin:0;"><div id="maincoursedoc" style="margin:0 0;padding:0 0;"><div class="LC_ContentBox" id="mainCourseDocuments" style="display: block;">');
                    403: }
                    404: 
                    405: sub endGradeScreen {
1.119     raeburn   406:     my ($r)=@_;
                    407:     $r->print('</div></div></div>'.&Apache::loncommon::end_page());
                    408:     return;
1.55      www       409: }
                    410: 
1.102     www       411: # -----------
                    412: 
                    413: 
                    414: sub excel_cleanup {
                    415:     undef ($excel_sheet);
                    416:     undef ($excel_workbook);
                    417:     undef ($filename);
                    418:     undef ($format);
                    419: }
                    420: 
                    421: 
                    422: sub excel_initialize {
                    423:     my ($r) = @_;
                    424: 
                    425:     &excel_cleanup();
                    426: 
                    427:     # Create sheet
                    428:     ($excel_workbook,$filename,$format)=
                    429:         &Apache::loncommon::create_workbook($r);
                    430:     return if (! defined($excel_workbook));
                    431:    #
                    432:    # Add a worksheet
                    433:     my $sheetname = $env{'course.'.$env{'request.course.id'}.'.description'};
                    434:     $sheetname = &Apache::loncommon::clean_excel_name($sheetname);
                    435:     $excel_sheet = $excel_workbook->addworksheet($sheetname);
                    436:    #
                    437:    # Put the course description in the header
                    438:     $excel_sheet->write($header_row,$cols_output++,
                    439:                    $env{'course.'.$env{'request.course.id'}.'.description'},
                    440:                         $format->{'h1'});
                    441: } 
                    442: 
                    443: sub excel_finish {
                    444:     my ($r) = @_;
                    445:     if ($request_aborted || ! defined($excel_sheet)) {
                    446:         &excel_cleanup();
                    447:         return;
                    448:     }
                    449:     #
                    450:     # Write the excel file
                    451:     $excel_workbook->close();
                    452:     #
                    453:     # Close the progress window
                    454:     &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
                    455:     #
                    456:     # Tell the user where to get their excel file
                    457:     $r->print('<br />'.
                    458:               '<a href="'.$filename.'">'.&mt('Your Excel spreadsheet').'</a>'."\n");
                    459:     $r->rflush();
                    460:     &excel_cleanup();
                    461:     return;
                    462: }
                    463: 
                    464: 
                    465: #
                    466: # CSV data
                    467: #
                    468: # -----------
                    469: 
                    470: #
                    471: # Go through the complete course and collect data
                    472: #
1.55      www       473: 
1.51      www       474: sub getData {
                    475: 
1.53      www       476:     my ($showPoints,$uname,$udom)=@_;
                    477: 
1.51      www       478:     # Create the nav map
1.53      www       479:     my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom);
1.51      www       480: 
1.118     raeburn   481:     if (!defined($navmap)) {
                    482:         return ();
                    483:     }
                    484: 
1.51      www       485:     my $res = $navmap->firstResource(); # temp resource to access constants
1.1       bowersj2  486: 
                    487:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    488:     my $depth = 1;
                    489:     $iterator->next(); # ignore first BEGIN_MAP
                    490:     my $curRes = $iterator->next();
1.119     raeburn   491: 
1.5       bowersj2  492:     # General overview of the following: Walk along the course resources.
                    493:     # For every problem in the resource, tell its parent maps how many
                    494:     # parts and how many parts correct it has. After that, each map will
                    495:     # have a count of the total parts underneath it, correct and otherwise.
                    496:     # After that, we will walk through the course again and read off
                    497:     # maps in order, with their data. 
                    498:     # (If in the future people decide not to be cumulative, only add
                    499:     #  the counts to the parent map.)
1.17      bowersj2  500:     # For convenience, "totalParts" is also "totalPoints" when we're looking
                    501:     #  at points; I can't come up with a variable name that makes sense
                    502:     #  equally for both cases.
1.5       bowersj2  503: 
                    504:     my $totalParts = 0; my $totalPossible = 0; my $totalRight = 0;
1.28      bowersj2  505:     my $totalAttempted = 0;
1.14      bowersj2  506:     my $now = time();
1.28      bowersj2  507:     my $topLevelParts = 0; my $topLevelRight = 0; my $topLevelAttempted = 0;
1.5       bowersj2  508: 
                    509:     # Pre-run: Count parts correct
1.1       bowersj2  510:     while ( $depth > 0 ) {
                    511:         if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
                    512:         if ($curRes == $iterator->END_MAP()) { $depth--; }
                    513: 
1.114     raeburn   514:         if (ref($curRes) && $curRes->is_gradable() && !$curRes->randomout && 
                    515:             ($curRes->deeplink ne 'absent'))
1.5       bowersj2  516:         {
                    517:             # Get number of correct, incorrect parts
                    518:             my $parts = $curRes->parts();
                    519:             my $partsRight = 0;
1.17      bowersj2  520: 	    my $partsCount = 0;
1.28      bowersj2  521: 	    my $partsAttempted = 0;
1.5       bowersj2  522:             my $stack = $iterator->getStack();
                    523:             
                    524:             for my $part (@{$parts}) {
1.28      bowersj2  525: 		my $dateStatus = $curRes->getDateStatus($part);
1.97      www       526:                 my $weight = $curRes->weight($part);
                    527:                 my $problemstatus = $curRes->problemstatus($part);
                    528: 
1.98      www       529:                 if ($curRes->solved($part) eq 'excused') {
1.21      matthew   530:                     next;
                    531:                 }
1.17      bowersj2  532: 		if ($showPoints) {
1.28      bowersj2  533: 		    my $score = 0;
                    534: 		    # If we're not telling status and the answer date isn't passed yet, 
                    535: 		    # it's an "attempted" point
1.97      www       536: 		    if ((($problemstatus eq 'no') ||
                    537:                          ($problemstatus eq 'no_feedback_ever')) &&
1.28      bowersj2  538: 			($dateStatus != $curRes->ANSWER_OPEN)) {
1.31      albertel  539: 			my $status = $curRes->simpleStatus($part);
                    540: 			if ($status == $curRes->ATTEMPTED) {
1.97      www       541: 			    $partsAttempted += $weight;
1.31      albertel  542: 			    $totalAttempted += $partsAttempted;
                    543: 			}
1.28      bowersj2  544: 		    } else {
1.97      www       545: 			$score = &Apache::grades::compute_points($weight, $curRes->awarded($part));
1.28      bowersj2  546: 		    }
1.17      bowersj2  547: 		    $partsRight += $score;
                    548: 		    $totalRight += $score;
1.97      www       549: 		    $partsCount += $weight;
1.18      bowersj2  550: 
1.83      www       551:                     $curRes->{DATA}->{PROB_SCORE}  += $score;
1.97      www       552:                     $curRes->{DATA}->{PROB_WEIGHT} += $weight;
1.83      www       553: 
1.17      bowersj2  554: 		    if ($curRes->opendate($part) < $now) {
1.97      www       555: 			$totalPossible += $weight;
                    556:                         $curRes->{DATA}->{PROB_POSSIBLE} += $weight;
1.17      bowersj2  557: 		    }
1.97      www       558: 		    $totalParts += $weight;
1.17      bowersj2  559: 		} else {
1.27      bowersj2  560: 		    my $status = $curRes->simpleStatus($part);
1.17      bowersj2  561: 		    my $thisright = 0;
                    562: 		    $partsCount++;
1.37      albertel  563: 		    if ($status == $curRes->CORRECT ||
                    564: 			$status == $curRes->PARTIALLY_CORRECT ) {
1.17      bowersj2  565: 			$partsRight++;
                    566: 			$totalRight++;
                    567: 			$thisright = 1;
                    568: 		    }
1.28      bowersj2  569: 
                    570: 		    if ($status == $curRes->ATTEMPTED) {
                    571: 			$partsAttempted++;
                    572: 			$totalAttempted++;
                    573: 		    }
1.17      bowersj2  574: 		    
1.19      bowersj2  575: 		    $totalParts++;
1.17      bowersj2  576: 		    if ($curRes->opendate($part) < $now) {
                    577: 			$totalPossible++;
                    578: 		    }
                    579: 		}
1.5       bowersj2  580:             }
1.15      bowersj2  581: 
                    582:             if ($depth == 1) { # in top-level only
1.19      bowersj2  583: 		$topLevelParts += $partsCount;
1.15      bowersj2  584: 		$topLevelRight += $partsRight;
1.28      bowersj2  585: 		$topLevelAttempted += $partsAttempted;
1.15      bowersj2  586: 	    }
                    587: 
1.5       bowersj2  588:             # Crawl down stack and record parts correct and total
                    589:             for my $res (@{$stack}) {
                    590:                 if (ref($res) && $res->is_map()) {
                    591:                     if (!defined($res->{DATA}->{CHILD_PARTS})) {
                    592:                         $res->{DATA}->{CHILD_PARTS} = 0;
                    593:                         $res->{DATA}->{CHILD_CORRECT} = 0;
1.28      bowersj2  594: 			$res->{DATA}->{CHILD_ATTEMPTED} = 0;
1.5       bowersj2  595:                     }
                    596:                     
1.17      bowersj2  597:                     $res->{DATA}->{CHILD_PARTS} += $partsCount;
1.5       bowersj2  598:                     $res->{DATA}->{CHILD_CORRECT} += $partsRight;
1.28      bowersj2  599: 		    $res->{DATA}->{CHILD_ATTEMPTED} += $partsAttempted;
1.5       bowersj2  600:                 }
                    601:             }
                    602:         }
                    603:         $curRes = $iterator->next();
                    604:     }
1.119     raeburn   605:     return ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,
                    606:             $topLevelParts,$topLevelRight,$topLevelAttempted);
1.51      www       607: }
                    608: 
                    609: #
                    610: # Outputting everything.
                    611: #
                    612: 
                    613: sub outputTable {
1.5       bowersj2  614: 
1.119     raeburn   615:     my ($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible,$totalRight,
                    616:         $totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_;
1.5       bowersj2  617: 
1.7       bowersj2  618:     my @start = (255, 255, 192);
1.5       bowersj2  619:     my @end   = (0, 192, 0);
                    620: 
                    621:     my $indentString = '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;';
                    622: 
                    623:     # Second pass: Print the maps.
1.43      bisitz    624:     $r->print(&Apache::loncommon::start_data_table()
                    625:              .&Apache::loncommon::start_data_table_header_row()
                    626:              .'<th>'.&mt('Folder').'</th>');
1.51      www       627:     my $title = &mt($showPoints ? "Points Scored" : "Done");
1.28      bowersj2  628:     if ($totalAttempted) {
1.51      www       629:         $title .= " / " . &mt("Attempted");
1.28      bowersj2  630:     }
1.49      www       631:     $r->print("<th>$title".($notshowTotals?'':" / ".&mt('Total')).'</th>'
1.43      bisitz    632:              .&Apache::loncommon::end_data_table_header_row());
1.51      www       633: #
                    634: # Output of folder scores
                    635: #
                    636: 
                    637:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    638:     my $depth = 1;
                    639:     $iterator->next(); # ignore first BEGIN_MAP
                    640:     my $curRes = $iterator->next();
                    641: 
1.5       bowersj2  642:     while ($depth > 0) {
                    643:         if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
                    644:         if ($curRes == $iterator->END_MAP()) { $depth--; }
                    645: 
                    646:         if (ref($curRes) && $curRes->is_map()) {
                    647:             my $title = $curRes->compTitle();
                    648:             
                    649:             my $correct = $curRes->{DATA}->{CHILD_CORRECT};
                    650:             my $total = $curRes->{DATA}->{CHILD_PARTS};
1.28      bowersj2  651: 	    my $attempted = $curRes->{DATA}->{CHILD_ATTEMPTED};
1.5       bowersj2  652: 
1.6       bowersj2  653:             if ($total > 0) {
                    654:                 my $ratio;
                    655:                 $ratio = $correct / $total;
1.51      www       656:                 my $color = &mixColors(\@start, \@end, $ratio);
1.43      bisitz    657:                 $r->print(&Apache::loncommon::start_data_table_row()
                    658:                          .'<td style="background-color:'.$color.';">');
1.6       bowersj2  659:                 
1.15      bowersj2  660: 		my $thisIndent = '';
                    661:                 for (my $i = 1; $i < $depth; $i++) { $thisIndent .= $indentString; }
1.6       bowersj2  662:                 
1.15      bowersj2  663:                 $r->print("$thisIndent$title</td>");
1.28      bowersj2  664: 		if ($totalAttempted) {
1.45      bisitz    665: 		    $r->print('<td valign="top">'
                    666:                              .$thisIndent
                    667:                              .'<span class="LC_nobreak">'
1.49      www       668:                              .$correct.' / '.$attempted.($notshowTotals?'':' / '.$total)
1.45      bisitz    669:                              .'</span></td>'
                    670:                              .&Apache::loncommon::end_data_table_row()
                    671:                     );
1.28      bowersj2  672: 		} else {
1.45      bisitz    673: 		    $r->print('<td valign="top">'
                    674:                              .$thisIndent
                    675:                              .'<span class="LC_nobreak">'
1.49      www       676:                              .$correct.($notshowTotals?'':' / '.$total)
1.45      bisitz    677:                              .'</span></td>'
1.43      bisitz    678:                              .&Apache::loncommon::end_data_table_row());
1.28      bowersj2  679: 		}
1.6       bowersj2  680:             }
1.5       bowersj2  681:         }
1.4       bowersj2  682: 
1.5       bowersj2  683:         $curRes = $iterator->next();
                    684:     }
1.4       bowersj2  685: 
1.6       bowersj2  686:     # If there were any problems at the top level, print an extra "catchall"
1.15      bowersj2  687:     if ($topLevelParts > 0) {
                    688:         my $ratio = $topLevelRight / $topLevelParts;
1.68      www       689:         my $color = &mixColors(\@start, \@end, $ratio);
1.43      bisitz    690:         $r->print(&Apache::loncommon::start_data_table_row()
                    691:                  .'<td style="background-color:'.$color.';">');
1.25      www       692:         $r->print(&mt("Problems Not Contained In A Folder")."</td><td>");
1.43      bisitz    693:         $r->print("$topLevelRight / $topLevelParts</td>"
                    694:                  .&Apache::loncommon::end_data_table_row());
1.6       bowersj2  695:     }
1.4       bowersj2  696: 
1.51      www       697: #
                    698: # show totals (if applicable), close table
                    699: #
1.35      albertel  700:     if ($showPoints) {
1.68      www       701:         my $maxHelpLink = &Apache::loncommon::help_open_topic("Quick_Grades_Possibly_Correct");
1.2       bowersj2  702: 
1.51      www       703:         $title = $showPoints ? "Points" : "Parts Done";
                    704:         my $totaltitle = $showPoints ? &mt("Awarded Total Points") : &mt("Total Parts Done");
                    705:         $r->print(&Apache::loncommon::start_data_table_row()
1.48      bisitz    706:                  .'<td colspan="2" align="right">'.$totaltitle.': <b>'.$totalRight.'</b><br />');
1.51      www       707:         $r->print(&mt('Max Possible To Date')." $maxHelpLink: <b>$totalPossible</b><br />");
                    708:         $title = $showPoints ? "Points" : "Parts";
                    709:         $r->print(&mt("Total $title In Course").': <b>'.$totalParts.'</b></td>'
1.43      bisitz    710:                  .&Apache::loncommon::end_data_table_row());
1.34      www       711:     }
1.1       bowersj2  712: 
1.72      www       713:     $r->print(&Apache::loncommon::end_data_table());
1.118     raeburn   714:     return;
1.5       bowersj2  715: }
                    716: 
1.53      www       717: #
1.65      www       718: # === Outputting category-based grades.
                    719: #
                    720: # $category{'order'}: output order of categories by id
                    721: # $category{'all'}: complete list of all categories 
                    722: # $category{$id.'_name'}: display-name of category
1.53      www       723: #
                    724: 
                    725: sub outputCategories {
                    726: 
                    727:     my ($r,$showPoints,$notshowTotals,
                    728:            $navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_;
1.62      www       729: # Take care of storing and retrieving categories
                    730: 
1.64      www       731:     my $cangrade=&Apache::lonnet::allowed('mgr');
                    732: 
1.62      www       733:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    734:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.64      www       735:     my %categories=();
1.65      www       736: # Loading old categories
                    737:     %categories=&Apache::lonnet::dump('grading_categories',$cdom,$cnum);
1.64      www       738: # Storing
1.72      www       739:     if (($cangrade) && (($env{'form.storechanges'}) || ($env{'form.storemove'} ne '') || ($env{'form.cmd'} ne ''))) {
1.65      www       740: # Process the changes
                    741:         %categories=&process_category_edits($r,$cangrade,%categories);
1.64      www       742: # Actually store
                    743:         &Apache::lonnet::put('grading_categories',\%categories,$cdom,$cnum);
                    744:     }
1.65      www       745: # new categories loaded now
1.99      www       746:     &output_category_table($r,$cangrade,$navmap,1,%categories);
1.65      www       747: #
                    748:     if ($cangrade) {
1.84      www       749:         $r->print(&Apache::loncommon::resourcebrowser_javascript().
                    750:                   '<input type="hidden" name="storemove" value="" />'.
1.72      www       751:                   '<input type="hidden" name="cmd" value="" />'.
1.86      www       752:                   '<input type="hidden" name="resourcesymb" value="" />'.
1.72      www       753:                   '<input type="submit" name="storechanges" value="'.&mt("Save changes to grading categories").'" />'.
1.74      www       754:                   '<script>function storecmd (cmd) { document.quickform.cmd.value=cmd; document.quickform.submit(); }</script>');
1.65      www       755:     }
1.82      www       756: }
                    757: 
                    758: #
                    759: # Get data for all symbs
                    760: #
                    761: 
                    762: sub dumpdata {
                    763:     my ($navmap)=@_;
                    764:     my %returndata=();
                    765: 
                    766: # Run through the map and get all data
                    767: 
                    768:     my $iterator = $navmap->getIterator(undef, undef, undef, 1);
                    769:     my $depth = 1;
                    770:     $iterator->next(); # ignore first BEGIN_MAP
                    771:     my $curRes = $iterator->next();
                    772: 
                    773:     while ($depth > 0) {
                    774:         if ($curRes == $iterator->BEGIN_MAP()) {$depth++;}
                    775:         if ($curRes == $iterator->END_MAP()) { $depth--; }
1.83      www       776:         if (ref($curRes)) {
                    777:             if ($curRes->is_map()) {
                    778:                 $returndata{$curRes->symb()}='folder:'.$curRes->{DATA}->{CHILD_PARTS}.':'.$curRes->{DATA}->{CHILD_ATTEMPTED}.':'.$curRes->{DATA}->{CHILD_CORRECT};
                    779:             } else {
                    780:                 $returndata{$curRes->symb()}='res:'.$curRes->{DATA}->{PROB_WEIGHT}.':'.$curRes->{DATA}->{PROB_POSSIBLE}.':'.$curRes->{DATA}->{PROB_SCORE};
                    781:             } 
1.82      www       782:         }
                    783:         $curRes = $iterator->next();
                    784:     }
                    785:     return %returndata;
1.65      www       786: }
                    787: 
                    788: #
                    789: # Process editing commands, update category hash
                    790: #
                    791: 
                    792: sub process_category_edits {
                    793:     my ($r,$cangrade,%categories)=@_;
                    794:     unless ($cangrade) { return %categories; }
1.72      www       795: # First store everything
                    796:     foreach my $id (split(/\,/,$categories{'order'})) {
1.80      www       797: # Set names, types, and weight (there is only one of each per category)
1.72      www       798:         %categories=&set_category_name($cangrade,$id,$env{'form.name_'.$id},%categories);
                    799:         %categories=&set_category_total($cangrade,$id,$env{'form.totaltype_'.$id},$env{'form.total_'.$id},%categories);
                    800:         %categories=&set_category_weight($cangrade,$id,$env{'form.weight_'.$id},%categories);
1.81      www       801:         %categories=&set_category_displayachieved($cangrade,$id,$env{'form.displayachieved_'.$id},%categories);
1.80      www       802: # Set values for category rules (before names may change)
                    803:         %categories=&set_category_rules($cangrade,$id,%categories);
1.72      www       804:     }
                    805: 
                    806: # Now deal with commands
1.67      www       807:     my $cmd=$env{'form.cmd'};
                    808:     if ($cmd eq 'createnewcat') {
1.69      www       809:         %categories=&make_new_category($r,$cangrade,undef,%categories);
1.72      www       810:     } elsif ($cmd=~/^up\_(.+)$/) {
                    811:         %categories=&move_up_category($1,$cangrade,%categories);
                    812:     } elsif ($cmd=~/^down\_(.+)$/) {
                    813:         %categories=&move_down_category($1,$cangrade,%categories);
1.69      www       814:     } elsif ($cmd=~/^delcat\_(.+)$/) {
                    815:         %categories=&del_category($1,$cangrade,%categories);
1.75      www       816:     } elsif ($cmd=~/^addcont\_(.+)$/) {
1.87      www       817:         %categories=&add_category_content($1,$cangrade,$env{'form.resourcesymb'},%categories);
1.75      www       818:     } elsif ($cmd=~/^delcont\_(.+)\_\_\_\_\_\_(.+)$/) {
                    819:         %categories=&del_category_content($1,$cangrade,$2,%categories);
1.77      www       820:     } elsif ($cmd=~/^newrule\_(.+)$/) {
                    821:         %categories=&add_calculation_rule($1,$cangrade,':',%categories);
1.79      www       822:     } elsif ($cmd=~/^delrule\_(.+)\_\_\_\_\_\_(.*)$/) {
                    823:         %categories=&del_calculation_rule($1,$cangrade,$2,%categories);
1.73      www       824:     }
                    825: # Move to a new position
                    826:     my $moveid=$env{'form.storemove'};
                    827:     if ($moveid) {
                    828:         %categories=&move_category($moveid,$cangrade,$env{'form.newpos_'.$moveid},%categories);
1.72      www       829:     } 
1.65      www       830:     return %categories;
                    831: }
                    832: 
                    833: #
                    834: # Output the table
                    835: #
                    836: 
                    837: sub output_category_table {
1.99      www       838:     my ($r,$cangrade,$navmaps,$output,%categories)=@_;
1.96      www       839:     
                    840:     my $totalweight=0;
                    841:     my $totalpoints=0;
                    842: 
1.99      www       843:     if ($output) { 
                    844:        $r->print(&Apache::loncommon::start_data_table());
1.65      www       845: #
1.99      www       846:        &output_category_table_header($r,$cangrade);
                    847:     }
1.65      www       848: #
                    849:     my @order=split(/\,/,$categories{'order'});
                    850: #
1.88      www       851:     my %performance=&dumpdata($navmaps);
1.65      www       852:     my $maxpos=$#order;
                    853:     for (my $i=0;$i<=$maxpos;$i++) {
1.99      www       854:         my ($correct,$possible,$type,$weight)=&output_and_calc_category($r,$cangrade,$navmaps,$order[$i],$i,$maxpos,\%performance,$output,%categories);
1.96      www       855:         unless ($possible) { next; }
                    856:         $totalpoints+=$weight*$correct/$possible;
                    857:         $totalweight+=$weight;
1.65      www       858:     }
                    859: #
1.96      www       860:     my $perc=0;
                    861:     if ($totalweight) { $perc=100.*$totalpoints/$totalweight; }
                    862: 
1.99      www       863:     if ($output) { 
                    864:         &bottom_line_category($r,$cangrade,$perc); 
                    865:         $r->print(&Apache::loncommon::end_data_table());
                    866:     }
1.96      www       867:     return $perc;
1.65      www       868: }
                    869: 
                    870: sub output_category_table_header {
                    871:     my ($r,$cangrade)=@_;
                    872:     $r->print(&Apache::loncommon::start_data_table_header_row());
                    873:     if ($cangrade) {
                    874:         $r->print('<th colspan="2">'.&mt("Move").'</th><th>'.&mt('Action').'</th>');
                    875:     }
                    876:     $r->print('<th>'.&mt('Category').'</th>'.
                    877:               '<th>'.&mt('Contents').'</th>'.
1.81      www       878:               '<th>'.&mt('Total Points').'</th>'.
1.65      www       879:               '<th>'.&mt('Calculation').'</th>'.
1.81      www       880:               '<th>'.&mt('Relative Weight').'</th>'.
                    881:               '<th>'.&mt('Achieved').'</th>');
1.65      www       882:     $r->print(&Apache::loncommon::end_data_table_header_row());
                    883: }
                    884: 
                    885: 
                    886: #
                    887: # Output one category to table
                    888: #
                    889: 
                    890: sub output_and_calc_category {
1.89      www       891:     my ($r,$cangrade,$navmaps,$id,$currentpos,$maxpos,$performance,$output,%categories)=@_;
1.99      www       892:     
                    893:     if ($output) { $r->print("\n".&Apache::loncommon::start_data_table_row()); }
1.95      www       894: 
1.99      www       895:     if ($output && $cangrade) {
                    896:         my $iconpath = &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL') . "/");
                    897:         my %lt=&Apache::lonlocal::texthash(
1.65      www       898:            'up' => 'Move Up',
                    899:            'dw' => 'Move Down');
                    900: 
                    901:         $r->print(<<ENDMOVE);
                    902: <td>
                    903: <div class="LC_docs_entry_move">
1.72      www       904:   <a href='javascript:storecmd("up_$id");'>
1.65      www       905:     <img src="${iconpath}move_up.gif" alt='$lt{'up'}' class="LC_icon" />
                    906:   </a>
                    907: </div>
                    908: <div class="LC_docs_entry_move">
1.72      www       909:   <a href='javascript:storecmd("down_$id");'>
1.65      www       910:     <img src="${iconpath}move_down.gif" alt='$lt{'dw'}' class="LC_icon" />
                    911:   </a>
                    912: </div>
                    913: </td>
                    914: ENDMOVE
                    915:         $r->print("\n<td>\n<select name='newpos_$id' onchange='this.form.storemove.value=\"$id\";this.form.submit()'>");
                    916:         for (my $i=0;$i<=$maxpos;$i++) {
                    917:             if ($i==$currentpos) {
                    918:                 $r->print('<option value="" selected="selected">('.$i.')</option>');
                    919:             } else {
                    920:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                    921:             }
                    922:         }
                    923:         $r->print("\n</select>\n</td>\n");
1.72      www       924:         $r->print('<td><a href="javascript:storecmd(\'delcat_'.$id.'\');">'.&mt('Delete').'</a></td>');
1.69      www       925:         $r->print('<td><input type="text" name="name_'.$id.
                    926:                   '" value="'.&Apache::lonhtmlcommon::entity_encode($categories{$id.'_name'}).'" /></td>');
1.89      www       927:     } elsif ($output) {
1.69      www       928:         $r->print('<td>'.$categories{$id.'_name'}.'</td>');
1.65      www       929:     }
1.89      www       930: # Content display and summing up of points
                    931:     my $totalpossible=0;
                    932:     my $totalcorrect=0;
1.91      www       933:     my @individual=();
1.89      www       934:     if ($output) { $r->print('<td><ul>'); }
1.75      www       935:     foreach my $contentid (split(/\,/,$categories{$id.'_content'})) {
1.89      www       936:         my ($type,$possible,$attempted,$correct)=split(/\:/,$$performance{$contentid});
                    937:         $totalpossible+=$possible;
                    938:         $totalcorrect+=$correct;
1.91      www       939:         if ($possible>0) { push(@individual,"$possible:$correct"); }
1.89      www       940:         if ($output) {
                    941:            $r->print('<li>');
1.96      www       942:            $r->print(&Apache::lonnet::gettitle($contentid).' ('.&numberout($correct).'/'.&numberout($possible).')');
1.89      www       943:            if ($cangrade) {
                    944:               $r->print(' <a href="javascript:storecmd(\'delcont_'.$id.'______'.$contentid.'\');">'.&mt('Delete').'</a>');
                    945:            }
                    946:            $r->print('</li>');
1.75      www       947:         }
                    948:     }
1.89      www       949:     if ($output) {
                    950:        $r->print('</ul>');
                    951:        if ($cangrade) {
                    952:            $r->print('<br />'.&Apache::loncommon::selectresource_link('quickform','addcont_'.$id,&mt('Add Problem or Folder')).'<br />');
                    953:        }
1.96      www       954:        $r->print('<p><b>'.&mt('Total raw points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'</b></p>');
1.89      www       955:        $r->print('</td>'); 
1.70      www       956:     }
1.81      www       957: # Total
1.90      www       958:     if ($output) { $r->print('<td>'); }
1.81      www       959:     if ($cangrade) {
1.89      www       960:        if ($output) { 
1.90      www       961:           $r->print(
1.81      www       962:                   '<select name="totaltype_'.$id.'">'.
                    963:                   '<option value="default"'.($categories{$id.'_totaltype'} eq 'default'?' selected="selected"':'').'>'.&mt('default').'</option>'.
                    964:                   '<option value="typein"'.($categories{$id.'_totaltype'} eq 'typein'?' selected="selected"':'').'>'.&mt('Type-in value').'</option>'.
                    965:                   '</select>'.
                    966:                   '<input type="text" size="4" name="total_'.$id.
1.90      www       967:                   '" value="'.&Apache::lonhtmlcommon::entity_encode($categories{$id.'_total'}).'" />'); 
1.89      www       968:        }
1.81      www       969:     } else {
1.89      www       970:        if ($output) {
1.90      www       971:           $r->print('<td>'.($categories{$id.'_totaltype'} eq 'default'?&mt('default'):$categories{$id.'_total'}));
1.89      www       972:        }
1.81      www       973:     }
1.90      www       974: # Adjust total points
                    975:     if ($categories{$id.'_totaltype'} eq 'typein') {
                    976:        $totalpossible=1.*$categories{$id.'_total'};
                    977:     }
                    978:     if ($output) {
1.96      www       979:        $r->print('<p><b>'.&mt('Adjusted raw points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'</b></p>');
1.90      www       980:     }
1.81      www       981: 
                    982: 
1.70      www       983: # Calculation
1.89      www       984:     if ($output) { $r->print('<td><ul>'); }
1.76      www       985:     foreach my $calcrule (split(/\,/,$categories{$id.'_calculations'})) {
1.89      www       986:         if ($output) { $r->print('<li>'); }
1.78      www       987:         my ($code,$value)=split(/\:/,$calcrule);
1.89      www       988:         if ($output) { $r->print(&pretty_prt_rule($cangrade,$id,$code,$value)); }
1.76      www       989:         if ($cangrade) {
1.89      www       990:            if ($output) { $r->print(' <a href="javascript:storecmd(\'delrule_'.$id.'______'.$code.'\');">'.&mt('Delete').'</a>'); }
1.76      www       991:         }
1.91      www       992:         if ($code eq 'capabove') {
                    993:             if ($totalpossible>0) {
1.92      www       994:                 if ($totalcorrect/$totalpossible>$value/100.) {
                    995:                     $totalcorrect=$totalpossible*$value/100.;
1.91      www       996:                 }
                    997:             }
                    998:         } elsif ($code eq 'capbelow') {
                    999:             if ($totalpossible>0) {
1.92      www      1000:                 if ($totalcorrect/$totalpossible<$value/100.) {
                   1001:                     $totalcorrect=$totalpossible*$value/100.;
1.91      www      1002:                 }
                   1003:             }
1.92      www      1004:         } elsif ($code eq 'droplow') {
1.94      www      1005:             ($totalpossible,$totalcorrect,@individual)=&drop(0,0,$value,@individual);
1.92      www      1006:         } elsif ($code eq 'drophigh') {
1.94      www      1007:             ($totalpossible,$totalcorrect,@individual)=&drop(1,0,$value,@individual);
1.92      www      1008:         } elsif ($code eq 'droplowperc') {
1.94      www      1009:             ($totalpossible,$totalcorrect,@individual)=&drop(0,1,$value,@individual);
1.92      www      1010:         } elsif ($code eq 'drophighperc') {
1.94      www      1011:             ($totalpossible,$totalcorrect,@individual)=&drop(1,1,$value,@individual);
1.91      www      1012:         }
1.89      www      1013:         if ($output) { $r->print('</li>'); }
1.76      www      1014:     }
1.94      www      1015: # Re-adjust total points if force total
                   1016:     if ($categories{$id.'_totaltype'} eq 'typein') {
                   1017:        $totalpossible=1.*$categories{$id.'_total'};
                   1018:     }
                   1019: 
1.91      www      1020:     if ($output) { 
1.92      www      1021:         $r->print('</ul>'); 
                   1022:         if ($cangrade) { $r->print('<br />'.&new_calc_rule_form($id)); }
1.96      www      1023:         $r->print('<p><b>'.&mt('Calculated points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'</b></p>');
1.92      www      1024:         $r->print('</td>'); 
1.91      www      1025:     }
1.95      www      1026: #
                   1027: # Prepare for export
                   1028: #
1.70      www      1029: # Weight
1.95      www      1030:     my $weight=$categories{$id.'_weight'};
                   1031:     unless (1.*$weight>0) { $weight=0; }
1.70      www      1032:     if ($cangrade) {
1.89      www      1033:        if ($output) { 
                   1034:           $r->print('<td>'.
1.70      www      1035:                   '<input type="text" size="4" name="weight_'.$id.
1.95      www      1036:                   '" value="'.&Apache::lonhtmlcommon::entity_encode($weight).'" /></td>');
1.89      www      1037:        }
1.70      www      1038:     } else {
1.89      www      1039:        if ($output) {
1.95      www      1040:           $r->print('<td>'.$weight.'</td>');
1.89      www      1041:        }
1.70      www      1042:     }
1.81      www      1043: # Achieved
1.95      www      1044:     my $type=$categories{$id.'_displayachieved'};
                   1045:     unless (($type eq 'percent') || ($type eq 'points')) { $type='points'; }
1.89      www      1046:     if ($output) { $r->print('<td>'); }
1.81      www      1047:     if ($cangrade) {
1.89      www      1048:         if ($output) {
                   1049:            $r->print('<select name="displayachieved_'.$id.'">'.
1.95      www      1050:                   '<option value="percent"'.($type eq 'percent'?' selected="selected"':'').'>'.&mt('percent').'</option>'.
                   1051:                   '<option value="points"'.($type eq 'points'?' selected="selected"':'').'>'.&mt('points').'</option>'.
1.81      www      1052:                   '</select>');
1.89      www      1053:         }
1.95      www      1054:     }
                   1055:     if ($output) {
1.96      www      1056:         $r->print('<p><b>');
1.95      www      1057:         if ($type eq 'percent') {
                   1058:             my $perc='---';
                   1059:             if ($totalpossible) {
                   1060:                 $perc=100.*$totalcorrect/$totalpossible;
1.89      www      1061:             }
1.96      www      1062:             $r->print(&mt('[_1] percent',&numberout($perc)));
1.95      www      1063:         } else {
1.96      www      1064:             $r->print(&mt('[_1]/[_2] points',&numberout($totalcorrect),&numberout($totalpossible)));
1.81      www      1065:         }
1.96      www      1066:         $r->print('</b></p>');
1.81      www      1067:     }
1.89      www      1068:     if ($output) { $r->print('</td>'); }
1.70      www      1069: 
1.95      www      1070:     return ($totalcorrect,$totalpossible,$type,$weight);
1.65      www      1071: }
                   1072: 
                   1073: #
1.92      www      1074: # Drop folders and problems
                   1075: #
                   1076: 
                   1077: sub drop {
1.93      www      1078:     my ($high,$percent,$n,@individual)=@_;
1.94      www      1079: # Sort assignments by points or percent
1.92      www      1080:     my @newindividual=sort {
                   1081:         my ($pa,$ca)=split(/\:/,$a);
                   1082:         my ($pb,$cb)=split(/\:/,$b);
                   1083:         if ($percent) {
                   1084:             my $perca=0;
                   1085:             if ($pa>0) { $perca=$ca/$pa; }
                   1086:             my $percb=0;
                   1087:             if ($pb>0) { $percb=$cb/$pb; }
                   1088:             $perca<=>$percb;
                   1089:         } else {
                   1090:             $ca<=>$cb;
                   1091:         }
                   1092:     } @individual;
1.94      www      1093: # Drop the ones we don't want
1.93      www      1094:     if ($#newindividual>=$n) {
                   1095:         if ($high) {
                   1096:            splice(@newindividual,$#newindividual+1-$n,$n);
                   1097:         } else {
                   1098:            splice(@newindividual,0,$n);
                   1099:         }
                   1100:     } else {
                   1101:         @newindividual=();
                   1102:     }
1.94      www      1103: # Re-calculate how many points possible and achieved
                   1104:     my $newpossible=0;
1.92      www      1105:     my $newcorrect=0;
1.93      www      1106:     for my $score (@newindividual) {
1.94      www      1107:         my ($thispossible,$thiscorrect)=(split(/\:/,$score));
                   1108:         $newpossible+=$thispossible;
                   1109:         $newcorrect+=$thiscorrect;
1.93      www      1110:     }
1.94      www      1111:     return ($newpossible,$newcorrect,@newindividual);
1.92      www      1112: } 
                   1113: #
1.65      www      1114: # Bottom line with grades
                   1115: #
                   1116: 
                   1117: sub bottom_line_category {
1.96      www      1118:     my ($r,$cangrade,$perc)=@_;
1.67      www      1119:     $r->print(&Apache::loncommon::start_data_table_row());
                   1120:     if ($cangrade) {
1.72      www      1121:         $r->print('<td colspan="3"><a href="javascript:storecmd(\'createnewcat\');">'.&mt('Create New Category').'</a></td>');
1.67      www      1122:     }
1.96      www      1123:     $r->print('<td colspan="6"><b>'.&mt('Total: [_1] percent',&numberout($perc)).'</b></td>');
1.65      www      1124: }
                   1125: 
1.96      www      1126: sub numberout {
                   1127:     my ($number)=@_;
                   1128:     my $printout=sprintf("%.3f", $number);
                   1129:     $printout=~s/0+$//;
                   1130:     $printout=~s/\.$//;
                   1131:     return $printout;
                   1132: }
1.65      www      1133: #
                   1134: # Make one new category
                   1135: #
                   1136: 
                   1137: sub make_new_category {
                   1138:     my ($r,$cangrade,$ordernum,%categories)=@_;
                   1139:     unless ($cangrade) { return %categories; }
                   1140: # Generate new ID
                   1141:     my $id=time.'_'.$$.'_'.rand(10000);
                   1142: # Add new ID to list of all IDs ever created in this course
                   1143:     $categories{'all'}.=','.$id;
                   1144:     $categories{'all'}=~s/^\,//;
                   1145: # Add new ID to ordered list of displayed and evaluated categories
                   1146:     $categories{'order'}.=','.$id;
                   1147:     $categories{'order'}=~s/^\,//;
                   1148: # Move it into desired space
                   1149:     if (defined($ordernum)) {
                   1150:         %categories=&move_category($id,$cangrade,$ordernum,%categories);
                   1151:     }
1.71      www      1152:     $categories{$id.'_weight'}=0;
                   1153:     $categories{$id.'_totaltype'}='default';
1.81      www      1154:     $categories{$id.'_displayachieved'}='percent';
1.65      www      1155:     return %categories;
1.53      www      1156: }
                   1157: 
1.76      www      1158: 
                   1159: # === Calculation Rule Editing
                   1160: 
1.80      www      1161: sub category_rule_codes {
                   1162:     return &Apache::lonlocal::texthash(
1.91      www      1163:                 'droplowperc'  => 'Drop N lowest grade percentage problems/folders',
                   1164:                 'drophighperc' => 'Drop N highest grade percentage problems/folderss',
                   1165:                 'droplow'  => 'Drop N lowest point problems/folders',
                   1166:                 'drophigh' => 'Drop N highest point problems/folders',
1.78      www      1167:                 'capabove' => 'Cap percentage above N percent',
                   1168:                 'capbelow' => 'Cap percentage below N percent');
1.80      www      1169: }
                   1170: 
                   1171: sub pretty_prt_rule {
                   1172:     my ($cangrade,$id,$code,$value)=@_;
                   1173:     my $cid=$id.'_'.$code;
                   1174:     my %lt=&category_rule_codes();
1.78      www      1175:     my $ret='<span class="LC_nobreak">';
                   1176:     if ($cangrade) {
                   1177:         $ret.='<select name="sel_'.$cid.'">';
                   1178:         foreach my $calc (''=>'',sort(keys(%lt))) {
                   1179:             $ret.='<option value="'.$calc.'"'.($calc eq $code?' selected="selected"':'').' />'.$lt{$calc}.'</input>';
                   1180:         }
1.80      www      1181:         $ret.='</select> N=<input type="text" size="5" name="val_'.$cid.'" value="'.$value.'" /></span>';
1.78      www      1182:     } else {
                   1183:         $ret.=$lt{$code}.'; N='.$value;
                   1184:     }
                   1185:     $ret.='</span>';
                   1186:     return $ret;
1.76      www      1187: }
                   1188: 
                   1189: sub new_calc_rule_form {
1.77      www      1190:     my ($id)=@_;
                   1191:     return '<a href="javascript:storecmd(\'newrule_'.$id.'\');">'.&mt('New Calculation Rule').'</a>';
1.76      www      1192: }
                   1193: 
                   1194: #
                   1195: # Add a calculation rule
                   1196: #
                   1197: 
                   1198: sub add_calculation_rule {
                   1199:     my ($id,$cangrade,$newcontent,%categories)=@_;
                   1200:     unless ($cangrade) { return %categories; }
                   1201:     my %newcontent=($newcontent => 1);
                   1202:     foreach my $current (split(/\,/,$categories{$id.'_calculations'})) {
                   1203:         $newcontent{$current}=1;
                   1204:     }
                   1205:     $categories{$id.'_calculations'}=join(',',sort(keys(%newcontent)));
                   1206:     return %categories;
                   1207: }
                   1208: 
                   1209: #
                   1210: # Delete a calculation rule
                   1211: #
                   1212: 
                   1213: sub del_calculation_rule {
                   1214:     my ($id,$cangrade,$delcontent,%categories)=@_;
                   1215:     unless ($cangrade) { return %categories; }
                   1216:     my @newcontent=();
                   1217:     foreach my $current (split(/\,/,$categories{$id.'_calculations'})) {
1.78      www      1218:         unless ($current=~/^\Q$delcontent\E\:/) {
1.76      www      1219:             push(@newcontent,$current);
                   1220:         }
                   1221:     }
                   1222:     $categories{$id.'_calculations'}=join(',',@newcontent);
                   1223:     return %categories;
                   1224: }
                   1225: 
1.80      www      1226: sub set_category_rules {
                   1227:     my ($cangrade,$id,%categories)=@_;
                   1228:     unless ($cangrade) { return %categories; }
                   1229:     my %lt=&category_rule_codes();
                   1230:     my @newrules=();
                   1231:     foreach my $code ('',(keys(%lt))) {
                   1232:         if ($env{'form.sel_'.$id.'_'.$code}) {
                   1233:             push(@newrules,$env{'form.sel_'.$id.'_'.$code}.':'.$env{'form.val_'.$id.'_'.$code});
                   1234:         }
                   1235:     }
                   1236:     $categories{$id.'_calculations'}=join(',',sort(@newrules));
                   1237:     return %categories;
                   1238: }
                   1239: 
                   1240: 
1.76      www      1241: # === Category Editing
                   1242: 
1.65      www      1243: #
1.75      www      1244: # Add to category content
                   1245: #
                   1246: 
                   1247: sub add_category_content {
                   1248:     my ($id,$cangrade,$newcontent,%categories)=@_;
                   1249:     unless ($cangrade) { return %categories; }
1.87      www      1250:     &Apache::lonnet::logthis("In here $newcontent");
1.75      www      1251:     my %newcontent=($newcontent => 1);
                   1252:     foreach my $current (split(/\,/,$categories{$id.'_content'})) {
                   1253:         $newcontent{$current}=1;
                   1254:     }
                   1255:     $categories{$id.'_content'}=join(',',sort(keys(%newcontent)));
                   1256:     return %categories;
                   1257: }
                   1258: 
                   1259: #
                   1260: # Delete from category content
                   1261: #
                   1262: 
                   1263: sub del_category_content {
                   1264:     my ($id,$cangrade,$delcontent,%categories)=@_;
                   1265:     unless ($cangrade) { return %categories; }
                   1266:     my @newcontent=();
                   1267:     foreach my $current (split(/\,/,$categories{$id.'_content'})) {
                   1268:         unless ($current eq $delcontent) {
                   1269:             push(@newcontent,$current);
                   1270:         }
                   1271:     }
                   1272:     $categories{$id.'_content'}=join(',',@newcontent);
                   1273:     return %categories;
                   1274: }
                   1275: 
                   1276: #
1.68      www      1277: # Delete category
                   1278: #
                   1279: 
                   1280: sub del_category {
1.75      www      1281:     my ($id,$cangrade,%categories)=@_;
                   1282:     unless ($cangrade) { return %categories; }
                   1283:     my @neworder=();
                   1284:     foreach my $currentid (split(/\,/,$categories{'order'})) {
                   1285:         unless ($currentid eq $id) {
                   1286:             push(@neworder,$currentid);
                   1287:         }
                   1288:     }
                   1289:     $categories{'order'}=join(',',@neworder);
                   1290:     return %categories;
1.68      www      1291: }
                   1292: 
                   1293: #
1.72      www      1294: # Move category up
                   1295: #
                   1296: 
                   1297: sub move_up_category {
                   1298:     my ($id,$cangrade,%categories)=@_;
                   1299:     my $currentpos=&current_pos_category($id,%categories);
                   1300:     if ($currentpos<1) { return %categories; }
                   1301:     return &move_category($id,$cangrade,$currentpos-1,%categories);
                   1302: }
                   1303: 
                   1304: #
                   1305: # Move category down
                   1306: #
                   1307: 
                   1308: sub move_down_category {
                   1309:     my ($id,$cangrade,%categories)=@_;
                   1310:     my $currentpos=&current_pos_category($id,%categories);
                   1311:     my @order=split(/\,/,$categories{'order'});
                   1312:     if ($currentpos>=$#order) { return %categories; }
                   1313:     return &move_category($id,$cangrade,$currentpos+1,%categories);
                   1314: }
                   1315: 
                   1316: #
1.65      www      1317: # Move a category to a desired position n the display order
                   1318: #
                   1319: 
                   1320: sub move_category {
                   1321:     my ($id,$cangrade,$ordernum,%categories)=@_;
                   1322:     unless ($cangrade) { return %categories; }
                   1323:     my @order=split(/\,/,$categories{'order'});
                   1324: # Where is the index currently?
                   1325:     my $currentpos=&current_pos_category($id,%categories);
                   1326:     if (defined($currentpos)) {
                   1327:         if ($currentpos<$ordernum) {
                   1328: # This is moving to a higher index
                   1329: # ....X1234....
                   1330: # ....1234X....
                   1331:             for (my $i=$currentpos;$i<$ordernum;$i++) {
                   1332:                 $order[$i]=$order[$i+1];
                   1333:             }
                   1334:             $order[$ordernum]=$id;
                   1335:         }
                   1336:         if ($currentpos>$ordernum) {
                   1337: # This is moving to a lower index
                   1338: # ....1234X....
                   1339: # ....X1234....
                   1340:             for (my $i=$currentpos;$i>$ordernum;$i--) {
                   1341:                 $order[$i]=$order[$i-1];
                   1342:             }
                   1343:             $order[$ordernum]=$id;
                   1344:         }
                   1345:     }
                   1346:     $categories{'order'}=join(',',@order);
                   1347:     return %categories;
                   1348: }
                   1349: 
                   1350: #
                   1351: #  Find current postion of a category in the order
                   1352: #
                   1353: 
                   1354: sub current_pos_category {
                   1355:     my ($id,%categories)=@_;
                   1356:     my @order=split(/\,/,$categories{'order'});
                   1357:     for (my $i=0;$i<=$#order;$i++) {
                   1358:         if ($order[$i] eq $id) { return $i; }
                   1359:     }
                   1360: # not found
                   1361:     return undef;
                   1362: }
                   1363: 
                   1364: #
                   1365: # Set name of a category
                   1366: #
                   1367: sub set_category_name {
1.69      www      1368:     my ($cangrade,$id,$name,%categories)=@_;
                   1369:     unless ($cangrade) { return %categories; }
1.65      www      1370:     $categories{$id.'_name'}=$name;
                   1371:     return %categories;
                   1372: }
                   1373: 
                   1374: #
1.71      www      1375: # Set total of a category
1.70      www      1376: #
1.71      www      1377: sub set_category_total {
                   1378:     my ($cangrade,$id,$totaltype,$total,%categories)=@_;
1.70      www      1379:     unless ($cangrade) { return %categories; }
1.71      www      1380:     if (($categories{$id.'_total'} eq '') && ($total=~/\d/)) {
                   1381:         $totaltype='typein';
1.70      www      1382:     }
1.71      www      1383:     $categories{$id.'_totaltype'}=$totaltype;
                   1384:     if ($totaltype eq 'default') {
                   1385:         $categories{$id.'_total'}='';
1.70      www      1386:     } else {
1.71      www      1387:         $total=~s/\D//gs;
                   1388:         unless ($total) { $total=0; }
                   1389:         $categories{$id.'_total'}=$total;
1.70      www      1390:     }
                   1391:     return %categories;
                   1392: }
                   1393: 
1.71      www      1394: sub set_category_weight {
                   1395:     my ($cangrade,$id,$weight,%categories)=@_;
                   1396:     unless ($cangrade) { return %categories; }
                   1397:     $weight=~s/\D//gs;
                   1398:     unless ($weight) { $weight=0; }
                   1399:     $categories{$id.'_weight'}=$weight;
                   1400:     return %categories;
                   1401: }
1.70      www      1402: 
1.81      www      1403: sub set_category_displayachieved {
                   1404:     my ($cangrade,$id,$value,%categories)=@_;
                   1405:     unless ($cangrade) { return %categories; }
                   1406:     unless (($value eq 'percent') || ($value eq 'points')) { $value='percent'; }
                   1407:     $categories{$id.'_displayachieved'}=$value;
                   1408:     return %categories;
                   1409: }
                   1410: 
                   1411: 
1.70      www      1412: #
1.65      www      1413: # === end category-related
                   1414: #
                   1415: #
1.5       bowersj2 1416: # Pass this two refs to arrays for the start and end color, and a number
                   1417: # from 0 to 1 for how much of the latter you want to mix in. It will
                   1418: # return a string ready to show ("#FFC309");
1.51      www      1419: 
1.5       bowersj2 1420: sub mixColors {
                   1421:     my $start = shift;
                   1422:     my $end = shift;
                   1423:     my $ratio = shift;
                   1424:     
1.9       matthew  1425:     my ($a,$b);
1.5       bowersj2 1426:     my $final = "";
1.9       matthew  1427:     $a = $start->[0]; $b = $end->[0];
1.5       bowersj2 1428:     my $mix1 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
1.9       matthew  1429:     $a = $start->[1]; $b = $end->[1];
1.5       bowersj2 1430:     my $mix2 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
1.9       matthew  1431:     $a = $start->[2]; $b = $end->[2];
1.5       bowersj2 1432:     my $mix3 = POSIX::floor((1-$ratio)*$a + $ratio*$b);
                   1433: 
1.16      bowersj2 1434:     $final = sprintf "%02x%02x%02x", $mix1, $mix2, $mix3;
1.5       bowersj2 1435:     return "#" . $final;
1.1       bowersj2 1436: }
                   1437: 
                   1438: 1;

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