loncom/interface/lonquickgrades.pm - view

File: [LON-CAPA] / loncom / interface / lonquickgrades.pm
Revision 1.121: download - view: text, annotated - select for diffs
Mon Jul 19 15:48:26 2021 UTC (2 years, 10 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Bug 6907 Content in a course can be set to be deep-link only.
  If initial access is via a deep-link (/tiny/$domain/$uniqueid), and
  target folder/resource is deep-link only, access to resources, menus,
  and items listed in Course Contents controlled by deeplink parameter value.

1: # The LearningOnline Network with CAPA 2: # Quick Student Grades Display 3: # 4: # $Id: lonquickgrades.pm,v 1.121 2021/07/19 15:48:26 raeburn Exp $ 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; 32: use Apache::Constants qw(:common :http REDIRECT); 33: use POSIX; 34: use Apache::loncommon; 35: use Apache::lonlocal; 36: use Apache::lonnet; 37: use Apache::grades; 38: use Apache::loncoursedata; 39: use Apache::lonstudentassessment; 40: use Apache::lonuserstate; 41: 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: 58: sub handler { 59: my $r = shift; 60: return real_handler($r); 61: } 62: 63: sub real_handler { 64: my $r = shift; 65: 66: &Apache::loncommon::get_unprocessed_cgi($ENV{QUERY_STRING}); 67: 68: # Handle header-only request 69: if ($env{'browser.mathml'}) { 70: &Apache::loncommon::content_type($r,'text/xml'); 71: } else { 72: &Apache::loncommon::content_type($r,'text/html'); 73: } 74: if ($r->header_only) { 75: $r->send_http_header; 76: return OK; 77: } 78: 79: my $cangrade=&Apache::lonnet::allowed('mgr'); 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; 85: 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: 104: unless ($cangrade) { 105: # Check for critical messages and redirect if present. 106: my ($redirect,$url) = &Apache::loncommon::critical_redirect(300,'grades'); 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'); 115: ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev); 116: 117: if ($reinitresult eq 'switch') { 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; 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.'). 132: ' '.&mt('Please be patient').'.<br /></div>'. 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(); 137: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum"); 138: &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Finished!')); 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 147: if ($ferr) { 148: $r->print($closure.&Apache::loncommon::end_page()); 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; 153: } else { 154: $r->print($closure); 155: } 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; 162: } 163: } 164: 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(); 172: 173: &startGradeScreen($r,'quick'); 174: 175: # 176: # Pick student 177: # 178: my $uname; 179: my $udom; 180: my $stdid; 181: if ($cangrade) { 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> </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>"); 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)) { 219: $uname=(&Apache::lonnet::idget($udom,[$stdid],'ids'))[1]; 220: } 221: if (($stdid) && (!$uname)) { 222: $r->print('<p><span class="LC_warning">'.&mt("Unknown Student/Employee ID: [_1]",$stdid).'</span></p>'); 223: $stdid=''; 224: } 225: if (($uname eq '') && ($udom eq '')) { 226: $uname = $env{'user.name'}; 227: $udom = $env{'user.domain'}; 228: } 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" /> ' 236: ,$chooseopt). 237: '  <input type="submit" name="display" value="'.&mt('Display Individual Student').'" /></p>'); 238: if (($uname) && ($udom)) { 239: $r->print('<p>'.&mt('Full Name: [_1]',&Apache::loncommon::plainname($uname,$udom)).'</p>'); 240: } 241: } 242: $r->rflush(); 243: 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: 249: my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts, 250: $topLevelRight,$topLevelAttempted) = &getData($showPoints,$uname,$udom); 251: 252: if (ref($navmap)) { 253: if ($showCategories) { 254: &outputCategories($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible, 255: $totalRight,$totalAttempted,$topLevelParts,$topLevelRight, 256: $topLevelAttempted); 257: } else { 258: &outputTable($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible, 259: $totalRight,$totalAttempted,$topLevelParts,$topLevelRight, 260: $topLevelAttempted); 261: } 262: } else { 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; 267: } 268: if ($cangrade) { $r->print("\n</form>\n"); } 269: &endGradeScreen($r); 270: return OK; 271: } 272: 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: 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'}; 306: 307: my %categories=&Apache::lonnet::dump('grading_categories',$cdom,$cnum); 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: } 322: } 323: 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: } 332: 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')); 342: my $notshowTotals = 343: $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'; 344: my $showSPRSlink = 345: $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'spreadsheet'; 346: my $showCategories = 347: $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories'; 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: } 354: 355: my $allowed_to_edit = &Apache::lonnet::allowed('mgr',$env{'request.course.id'}); 356: if ((!$allowed_to_edit) && ($env{'request.course.sec'} ne '')) { 357: $allowed_to_edit = &Apache::lonnet::allowed('mgr', 358: "$env{'request.course.id'}/$env{'request.course.sec'}"); 359: } 360: 361: if ($allowed_to_view) { 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); 367: push(@notes,&mt('Students will see link to spreadsheet.')) if ($showSPRSlink); 368: push(@notes, &Apache::lonhtmlcommon::coursepreflink(&mt('Grade display settings'),'grading')); 369: $r->print(&Apache::loncommon::head_subbox(join('  ',@notes))); 370: } 371: 372: 373: $r->print("\n".'<ul class="LC_TabContentBigger" id="main">'); 374: $r->print("\n".'<li'.($mode eq 'quick'?' class="active"':'').'><a href="/adm/quickgrades"><b>    '. 375: ($showPoints?&mt('Individual Points Overview'):($showCategories?&mt('Grades Overview'):&mt('Completion Overview'))). 376: '    </b></a></li>'); 377: 378: if (!($showPoints || $notshowSPRSlink) || ($allowed_to_view)) { 379: $r->print("\n".'<li'.($mode eq 'spreadsheet'?' class="active"':'').'><a href="/adm/'.($allowed_to_view?'classcalc':'studentcalc').'"><b>'. 380: &mt('Spreadsheet (Detailed)').'</b></a></li>'); 381: } 382: if ($allowed_to_view) { 383: $r->print("\n".'<li'.($mode eq 'statistics'?' class="active"':'').'><a href="/adm/statistics"><b>'. 384: &mt('Statistics and Reports').'</b></a></li>'); 385: 386: $r->print("\n".'<li'.($mode eq 'chart'?' class="active"':'').'><a href="/adm/statistics?reportSelected=student_assessment"><b>'. 387: &mt('Assessment Chart').'</b></a></li>'); 388: 389: } 390: if ($allowed_to_edit) { 391: $r->print("\n".'<li'.($mode eq 'grading'?' class="active"':'').'><a href="/adm/grades"><b>    '. 392: &mt('Content Grading').'    </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'}). 396: '&command=gradingmenu"><b>    '. 397: &mt('Problem Grading').'    </b></a></li>'); 398: 399: } 400: } 401: $r->print("\n".'</ul>'."\n"); 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 { 406: my ($r)=@_; 407: $r->print('</div></div></div>'.&Apache::loncommon::end_page()); 408: return; 409: } 410: 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: # 473: 474: sub getData { 475: 476: my ($showPoints,$uname,$udom)=@_; 477: 478: # Create the nav map 479: my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom); 480: 481: if (!defined($navmap)) { 482: return (); 483: } 484: 485: my $res = $navmap->firstResource(); # temp resource to access constants 486: 487: my $deeplinkcond = 1; 488: my $iterator = $navmap->getIterator(undef, undef, undef, 1, undef, undef, $deeplinkcond); 489: my $depth = 1; 490: $iterator->next(); # ignore first BEGIN_MAP 491: my $curRes = $iterator->next(); 492: 493: # General overview of the following: Walk along the course resources. 494: # For every problem in the resource, tell its parent maps how many 495: # parts and how many parts correct it has. After that, each map will 496: # have a count of the total parts underneath it, correct and otherwise. 497: # After that, we will walk through the course again and read off 498: # maps in order, with their data. 499: # (If in the future people decide not to be cumulative, only add 500: # the counts to the parent map.) 501: # For convenience, "totalParts" is also "totalPoints" when we're looking 502: # at points; I can't come up with a variable name that makes sense 503: # equally for both cases. 504: 505: my $totalParts = 0; my $totalPossible = 0; my $totalRight = 0; 506: my $totalAttempted = 0; 507: my $now = time(); 508: my $topLevelParts = 0; my $topLevelRight = 0; my $topLevelAttempted = 0; 509: 510: # Pre-run: Count parts correct 511: while ( $depth > 0 ) { 512: if ($curRes == $iterator->BEGIN_MAP()) {$depth++;} 513: if ($curRes == $iterator->END_MAP()) { $depth--; } 514: my ($deeplink,$nodeeplinkcheck,$symb); 515: $nodeeplinkcheck = 1; 516: if (ref($curRes)) { 517: $symb = $curRes->symb(); 518: $deeplink = $curRes->deeplink('quickgrades'); 519: if ($deeplink eq 'absent') { 520: $nodeeplinkcheck = 0; 521: } 522: } 523: if (ref($curRes) && $curRes->is_gradable() && !$curRes->randomout && 524: ($nodeeplinkcheck)) 525: { 526: # Get number of correct, incorrect parts 527: my $parts = $curRes->parts(); 528: my $partsRight = 0; 529: my $partsCount = 0; 530: my $partsAttempted = 0; 531: my $stack = $iterator->getStack(); 532: 533: for my $part (@{$parts}) { 534: my $dateStatus = $curRes->getDateStatus($part); 535: my $weight = $curRes->weight($part); 536: my $problemstatus = $curRes->problemstatus($part); 537: 538: if ($curRes->solved($part) eq 'excused') { 539: next; 540: } 541: if ($showPoints) { 542: my $score = 0; 543: # If we're not telling status and the answer date isn't passed yet, 544: # it's an "attempted" point 545: if ((($problemstatus eq 'no') || 546: ($problemstatus eq 'no_feedback_ever')) && 547: ($dateStatus != $curRes->ANSWER_OPEN)) { 548: my $status = $curRes->simpleStatus($part); 549: if ($status == $curRes->ATTEMPTED) { 550: $partsAttempted += $weight; 551: $totalAttempted += $partsAttempted; 552: } 553: } else { 554: $score = &Apache::grades::compute_points($weight, $curRes->awarded($part)); 555: } 556: $partsRight += $score; 557: $totalRight += $score; 558: $partsCount += $weight; 559: 560: $curRes->{DATA}->{PROB_SCORE} += $score; 561: $curRes->{DATA}->{PROB_WEIGHT} += $weight; 562: 563: if ($curRes->opendate($part) < $now) { 564: $totalPossible += $weight; 565: $curRes->{DATA}->{PROB_POSSIBLE} += $weight; 566: } 567: $totalParts += $weight; 568: } else { 569: my $status = $curRes->simpleStatus($part); 570: my $thisright = 0; 571: $partsCount++; 572: if ($status == $curRes->CORRECT || 573: $status == $curRes->PARTIALLY_CORRECT ) { 574: $partsRight++; 575: $totalRight++; 576: $thisright = 1; 577: } 578: 579: if ($status == $curRes->ATTEMPTED) { 580: $partsAttempted++; 581: $totalAttempted++; 582: } 583: 584: $totalParts++; 585: if ($curRes->opendate($part) < $now) { 586: $totalPossible++; 587: } 588: } 589: } 590: 591: if ($depth == 1) { # in top-level only 592: $topLevelParts += $partsCount; 593: $topLevelRight += $partsRight; 594: $topLevelAttempted += $partsAttempted; 595: } 596: 597: # Crawl down stack and record parts correct and total 598: for my $res (@{$stack}) { 599: if (ref($res) && $res->is_map()) { 600: if (!defined($res->{DATA}->{CHILD_PARTS})) { 601: $res->{DATA}->{CHILD_PARTS} = 0; 602: $res->{DATA}->{CHILD_CORRECT} = 0; 603: $res->{DATA}->{CHILD_ATTEMPTED} = 0; 604: } 605: 606: $res->{DATA}->{CHILD_PARTS} += $partsCount; 607: $res->{DATA}->{CHILD_CORRECT} += $partsRight; 608: $res->{DATA}->{CHILD_ATTEMPTED} += $partsAttempted; 609: } 610: } 611: } 612: $curRes = $iterator->next(); 613: } 614: return ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted, 615: $topLevelParts,$topLevelRight,$topLevelAttempted); 616: } 617: 618: # 619: # Outputting everything. 620: # 621: 622: sub outputTable { 623: 624: my ($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible,$totalRight, 625: $totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_; 626: 627: my @start = (255, 255, 192); 628: my @end = (0, 192, 0); 629: 630: my $indentString = '     '; 631: 632: # Second pass: Print the maps. 633: $r->print(&Apache::loncommon::start_data_table() 634: .&Apache::loncommon::start_data_table_header_row() 635: .'<th>'.&mt('Folder').'</th>'); 636: my $title = &mt($showPoints ? "Points Scored" : "Done"); 637: if ($totalAttempted) { 638: $title .= " / " . &mt("Attempted"); 639: } 640: $r->print("<th>$title".($notshowTotals?'':" / ".&mt('Total')).'</th>' 641: .&Apache::loncommon::end_data_table_header_row()); 642: # 643: # Output of folder scores 644: # 645: 646: my $deeplinkcond = 1; 647: my $iterator = $navmap->getIterator(undef, undef, undef, 1, undef, undef, $deeplinkcond); 648: my $depth = 1; 649: $iterator->next(); # ignore first BEGIN_MAP 650: my $curRes = $iterator->next(); 651: 652: while ($depth > 0) { 653: if ($curRes == $iterator->BEGIN_MAP()) {$depth++;} 654: if ($curRes == $iterator->END_MAP()) { $depth--; } 655: 656: if (ref($curRes) && $curRes->is_map()) { 657: my $title = $curRes->compTitle(); 658: 659: my $correct = $curRes->{DATA}->{CHILD_CORRECT}; 660: my $total = $curRes->{DATA}->{CHILD_PARTS}; 661: my $attempted = $curRes->{DATA}->{CHILD_ATTEMPTED}; 662: 663: if ($total > 0) { 664: my $ratio; 665: $ratio = $correct / $total; 666: my $color = &mixColors(\@start, \@end, $ratio); 667: $r->print(&Apache::loncommon::start_data_table_row() 668: .'<td style="background-color:'.$color.';">'); 669: 670: my $thisIndent = ''; 671: for (my $i = 1; $i < $depth; $i++) { $thisIndent .= $indentString; } 672: 673: $r->print("$thisIndent$title</td>"); 674: if ($totalAttempted) { 675: $r->print('<td valign="top">' 676: .$thisIndent 677: .'<span class="LC_nobreak">' 678: .$correct.' / '.$attempted.($notshowTotals?'':' / '.$total) 679: .'</span></td>' 680: .&Apache::loncommon::end_data_table_row() 681: ); 682: } else { 683: $r->print('<td valign="top">' 684: .$thisIndent 685: .'<span class="LC_nobreak">' 686: .$correct.($notshowTotals?'':' / '.$total) 687: .'</span></td>' 688: .&Apache::loncommon::end_data_table_row()); 689: } 690: } 691: } 692: 693: $curRes = $iterator->next(); 694: } 695: 696: # If there were any problems at the top level, print an extra "catchall" 697: if ($topLevelParts > 0) { 698: my $ratio = $topLevelRight / $topLevelParts; 699: my $color = &mixColors(\@start, \@end, $ratio); 700: $r->print(&Apache::loncommon::start_data_table_row() 701: .'<td style="background-color:'.$color.';">'); 702: $r->print(&mt("Problems Not Contained In A Folder")."</td><td>"); 703: $r->print("$topLevelRight / $topLevelParts</td>" 704: .&Apache::loncommon::end_data_table_row()); 705: } 706: 707: # 708: # show totals (if applicable), close table 709: # 710: if ($showPoints) { 711: my $maxHelpLink = &Apache::loncommon::help_open_topic("Quick_Grades_Possibly_Correct"); 712: 713: $title = $showPoints ? "Points" : "Parts Done"; 714: my $totaltitle = $showPoints ? &mt("Awarded Total Points") : &mt("Total Parts Done"); 715: $r->print(&Apache::loncommon::start_data_table_row() 716: .'<td colspan="2" align="right">'.$totaltitle.': <b>'.$totalRight.'</b><br />'); 717: $r->print(&mt('Max Possible To Date')." $maxHelpLink: <b>$totalPossible</b><br />"); 718: $title = $showPoints ? "Points" : "Parts"; 719: $r->print(&mt("Total $title In Course").': <b>'.$totalParts.'</b></td>' 720: .&Apache::loncommon::end_data_table_row()); 721: } 722: 723: $r->print(&Apache::loncommon::end_data_table()); 724: return; 725: } 726: 727: # 728: # === Outputting category-based grades. 729: # 730: # $category{'order'}: output order of categories by id 731: # $category{'all'}: complete list of all categories 732: # $category{$id.'_name'}: display-name of category 733: # 734: 735: sub outputCategories { 736: 737: my ($r,$showPoints,$notshowTotals, 738: $navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_; 739: # Take care of storing and retrieving categories 740: 741: my $cangrade=&Apache::lonnet::allowed('mgr'); 742: 743: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 744: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 745: my %categories=(); 746: # Loading old categories 747: %categories=&Apache::lonnet::dump('grading_categories',$cdom,$cnum); 748: # Storing 749: if (($cangrade) && (($env{'form.storechanges'}) || ($env{'form.storemove'} ne '') || ($env{'form.cmd'} ne ''))) { 750: # Process the changes 751: %categories=&process_category_edits($r,$cangrade,%categories); 752: # Actually store 753: &Apache::lonnet::put('grading_categories',\%categories,$cdom,$cnum); 754: } 755: # new categories loaded now 756: &output_category_table($r,$cangrade,$navmap,1,%categories); 757: # 758: if ($cangrade) { 759: $r->print(&Apache::loncommon::resourcebrowser_javascript(). 760: '<input type="hidden" name="storemove" value="" />'. 761: '<input type="hidden" name="cmd" value="" />'. 762: '<input type="hidden" name="resourcesymb" value="" />'. 763: '<input type="submit" name="storechanges" value="'.&mt("Save changes to grading categories").'" />'. 764: '<script>function storecmd (cmd) { document.quickform.cmd.value=cmd; document.quickform.submit(); }</script>'); 765: } 766: } 767: 768: # 769: # Get data for all symbs 770: # 771: 772: sub dumpdata { 773: my ($navmap)=@_; 774: my %returndata=(); 775: 776: # Run through the map and get all data 777: 778: my $deeplinkcond = 1; 779: my $iterator = $navmap->getIterator(undef, undef, undef, 1, undef, undef, $deeplinkcond); 780: my $depth = 1; 781: $iterator->next(); # ignore first BEGIN_MAP 782: my $curRes = $iterator->next(); 783: 784: while ($depth > 0) { 785: if ($curRes == $iterator->BEGIN_MAP()) {$depth++;} 786: if ($curRes == $iterator->END_MAP()) { $depth--; } 787: if (ref($curRes)) { 788: if ($curRes->is_map()) { 789: $returndata{$curRes->symb()}='folder:'.$curRes->{DATA}->{CHILD_PARTS}.':'.$curRes->{DATA}->{CHILD_ATTEMPTED}.':'.$curRes->{DATA}->{CHILD_CORRECT}; 790: } else { 791: $returndata{$curRes->symb()}='res:'.$curRes->{DATA}->{PROB_WEIGHT}.':'.$curRes->{DATA}->{PROB_POSSIBLE}.':'.$curRes->{DATA}->{PROB_SCORE}; 792: } 793: } 794: $curRes = $iterator->next(); 795: } 796: return %returndata; 797: } 798: 799: # 800: # Process editing commands, update category hash 801: # 802: 803: sub process_category_edits { 804: my ($r,$cangrade,%categories)=@_; 805: unless ($cangrade) { return %categories; } 806: # First store everything 807: foreach my $id (split(/\,/,$categories{'order'})) { 808: # Set names, types, and weight (there is only one of each per category) 809: %categories=&set_category_name($cangrade,$id,$env{'form.name_'.$id},%categories); 810: %categories=&set_category_total($cangrade,$id,$env{'form.totaltype_'.$id},$env{'form.total_'.$id},%categories); 811: %categories=&set_category_weight($cangrade,$id,$env{'form.weight_'.$id},%categories); 812: %categories=&set_category_displayachieved($cangrade,$id,$env{'form.displayachieved_'.$id},%categories); 813: # Set values for category rules (before names may change) 814: %categories=&set_category_rules($cangrade,$id,%categories); 815: } 816: 817: # Now deal with commands 818: my $cmd=$env{'form.cmd'}; 819: if ($cmd eq 'createnewcat') { 820: %categories=&make_new_category($r,$cangrade,undef,%categories); 821: } elsif ($cmd=~/^up\_(.+)$/) { 822: %categories=&move_up_category($1,$cangrade,%categories); 823: } elsif ($cmd=~/^down\_(.+)$/) { 824: %categories=&move_down_category($1,$cangrade,%categories); 825: } elsif ($cmd=~/^delcat\_(.+)$/) { 826: %categories=&del_category($1,$cangrade,%categories); 827: } elsif ($cmd=~/^addcont\_(.+)$/) { 828: %categories=&add_category_content($1,$cangrade,$env{'form.resourcesymb'},%categories); 829: } elsif ($cmd=~/^delcont\_(.+)\_\_\_\_\_\_(.+)$/) { 830: %categories=&del_category_content($1,$cangrade,$2,%categories); 831: } elsif ($cmd=~/^newrule\_(.+)$/) { 832: %categories=&add_calculation_rule($1,$cangrade,':',%categories); 833: } elsif ($cmd=~/^delrule\_(.+)\_\_\_\_\_\_(.*)$/) { 834: %categories=&del_calculation_rule($1,$cangrade,$2,%categories); 835: } 836: # Move to a new position 837: my $moveid=$env{'form.storemove'}; 838: if ($moveid) { 839: %categories=&move_category($moveid,$cangrade,$env{'form.newpos_'.$moveid},%categories); 840: } 841: return %categories; 842: } 843: 844: # 845: # Output the table 846: # 847: 848: sub output_category_table { 849: my ($r,$cangrade,$navmaps,$output,%categories)=@_; 850: 851: my $totalweight=0; 852: my $totalpoints=0; 853: 854: if ($output) { 855: $r->print(&Apache::loncommon::start_data_table()); 856: # 857: &output_category_table_header($r,$cangrade); 858: } 859: # 860: my @order=split(/\,/,$categories{'order'}); 861: # 862: my %performance=&dumpdata($navmaps); 863: my $maxpos=$#order; 864: for (my $i=0;$i<=$maxpos;$i++) { 865: my ($correct,$possible,$type,$weight)=&output_and_calc_category($r,$cangrade,$navmaps,$order[$i],$i,$maxpos,\%performance,$output,%categories); 866: unless ($possible) { next; } 867: $totalpoints+=$weight*$correct/$possible; 868: $totalweight+=$weight; 869: } 870: # 871: my $perc=0; 872: if ($totalweight) { $perc=100.*$totalpoints/$totalweight; } 873: 874: if ($output) { 875: &bottom_line_category($r,$cangrade,$perc); 876: $r->print(&Apache::loncommon::end_data_table()); 877: } 878: return $perc; 879: } 880: 881: sub output_category_table_header { 882: my ($r,$cangrade)=@_; 883: $r->print(&Apache::loncommon::start_data_table_header_row()); 884: if ($cangrade) { 885: $r->print('<th colspan="2">'.&mt("Move").'</th><th>'.&mt('Action').'</th>'); 886: } 887: $r->print('<th>'.&mt('Category').'</th>'. 888: '<th>'.&mt('Contents').'</th>'. 889: '<th>'.&mt('Total Points').'</th>'. 890: '<th>'.&mt('Calculation').'</th>'. 891: '<th>'.&mt('Relative Weight').'</th>'. 892: '<th>'.&mt('Achieved').'</th>'); 893: $r->print(&Apache::loncommon::end_data_table_header_row()); 894: } 895: 896: 897: # 898: # Output one category to table 899: # 900: 901: sub output_and_calc_category { 902: my ($r,$cangrade,$navmaps,$id,$currentpos,$maxpos,$performance,$output,%categories)=@_; 903: 904: if ($output) { $r->print("\n".&Apache::loncommon::start_data_table_row()); } 905: 906: if ($output && $cangrade) { 907: my $iconpath = &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL') . "/"); 908: my %lt=&Apache::lonlocal::texthash( 909: 'up' => 'Move Up', 910: 'dw' => 'Move Down'); 911: 912: $r->print(<<ENDMOVE); 913: <td> 914: <div class="LC_docs_entry_move"> 915: <a href='javascript:storecmd("up_$id");'> 916: <img src="${iconpath}move_up.gif" alt='$lt{'up'}' class="LC_icon" /> 917: </a> 918: </div> 919: <div class="LC_docs_entry_move"> 920: <a href='javascript:storecmd("down_$id");'> 921: <img src="${iconpath}move_down.gif" alt='$lt{'dw'}' class="LC_icon" /> 922: </a> 923: </div> 924: </td> 925: ENDMOVE 926: $r->print("\n<td>\n<select name='newpos_$id' onchange='this.form.storemove.value=\"$id\";this.form.submit()'>"); 927: for (my $i=0;$i<=$maxpos;$i++) { 928: if ($i==$currentpos) { 929: $r->print('<option value="" selected="selected">('.$i.')</option>'); 930: } else { 931: $r->print('<option value="'.$i.'">'.$i.'</option>'); 932: } 933: } 934: $r->print("\n</select>\n</td>\n"); 935: $r->print('<td><a href="javascript:storecmd(\'delcat_'.$id.'\');">'.&mt('Delete').'</a></td>'); 936: $r->print('<td><input type="text" name="name_'.$id. 937: '" value="'.&Apache::lonhtmlcommon::entity_encode($categories{$id.'_name'}).'" /></td>'); 938: } elsif ($output) { 939: $r->print('<td>'.$categories{$id.'_name'}.'</td>'); 940: } 941: # Content display and summing up of points 942: my $totalpossible=0; 943: my $totalcorrect=0; 944: my @individual=(); 945: if ($output) { $r->print('<td><ul>'); } 946: foreach my $contentid (split(/\,/,$categories{$id.'_content'})) { 947: my ($type,$possible,$attempted,$correct)=split(/\:/,$$performance{$contentid}); 948: $totalpossible+=$possible; 949: $totalcorrect+=$correct; 950: if ($possible>0) { push(@individual,"$possible:$correct"); } 951: if ($output) { 952: $r->print('<li>'); 953: $r->print(&Apache::lonnet::gettitle($contentid).' ('.&numberout($correct).'/'.&numberout($possible).')'); 954: if ($cangrade) { 955: $r->print(' <a href="javascript:storecmd(\'delcont_'.$id.'______'.$contentid.'\');">'.&mt('Delete').'</a>'); 956: } 957: $r->print('</li>'); 958: } 959: } 960: if ($output) { 961: $r->print('</ul>'); 962: if ($cangrade) { 963: $r->print('<br />'.&Apache::loncommon::selectresource_link('quickform','addcont_'.$id,&mt('Add Problem or Folder')).'<br />'); 964: } 965: $r->print('<p><b>'.&mt('Total raw points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'</b></p>'); 966: $r->print('</td>'); 967: } 968: # Total 969: if ($output) { $r->print('<td>'); } 970: if ($cangrade) { 971: if ($output) { 972: $r->print( 973: '<select name="totaltype_'.$id.'">'. 974: '<option value="default"'.($categories{$id.'_totaltype'} eq 'default'?' selected="selected"':'').'>'.&mt('default').'</option>'. 975: '<option value="typein"'.($categories{$id.'_totaltype'} eq 'typein'?' selected="selected"':'').'>'.&mt('Type-in value').'</option>'. 976: '</select>'. 977: '<input type="text" size="4" name="total_'.$id. 978: '" value="'.&Apache::lonhtmlcommon::entity_encode($categories{$id.'_total'}).'" />'); 979: } 980: } else { 981: if ($output) { 982: $r->print('<td>'.($categories{$id.'_totaltype'} eq 'default'?&mt('default'):$categories{$id.'_total'})); 983: } 984: } 985: # Adjust total points 986: if ($categories{$id.'_totaltype'} eq 'typein') { 987: $totalpossible=1.*$categories{$id.'_total'}; 988: } 989: if ($output) { 990: $r->print('<p><b>'.&mt('Adjusted raw points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'</b></p>'); 991: } 992: 993: 994: # Calculation 995: if ($output) { $r->print('<td><ul>'); } 996: foreach my $calcrule (split(/\,/,$categories{$id.'_calculations'})) { 997: if ($output) { $r->print('<li>'); } 998: my ($code,$value)=split(/\:/,$calcrule); 999: if ($output) { $r->print(&pretty_prt_rule($cangrade,$id,$code,$value)); } 1000: if ($cangrade) { 1001: if ($output) { $r->print(' <a href="javascript:storecmd(\'delrule_'.$id.'______'.$code.'\');">'.&mt('Delete').'</a>'); } 1002: } 1003: if ($code eq 'capabove') { 1004: if ($totalpossible>0) { 1005: if ($totalcorrect/$totalpossible>$value/100.) { 1006: $totalcorrect=$totalpossible*$value/100.; 1007: } 1008: } 1009: } elsif ($code eq 'capbelow') { 1010: if ($totalpossible>0) { 1011: if ($totalcorrect/$totalpossible<$value/100.) { 1012: $totalcorrect=$totalpossible*$value/100.; 1013: } 1014: } 1015: } elsif ($code eq 'droplow') { 1016: ($totalpossible,$totalcorrect,@individual)=&drop(0,0,$value,@individual); 1017: } elsif ($code eq 'drophigh') { 1018: ($totalpossible,$totalcorrect,@individual)=&drop(1,0,$value,@individual); 1019: } elsif ($code eq 'droplowperc') { 1020: ($totalpossible,$totalcorrect,@individual)=&drop(0,1,$value,@individual); 1021: } elsif ($code eq 'drophighperc') { 1022: ($totalpossible,$totalcorrect,@individual)=&drop(1,1,$value,@individual); 1023: } 1024: if ($output) { $r->print('</li>'); } 1025: } 1026: # Re-adjust total points if force total 1027: if ($categories{$id.'_totaltype'} eq 'typein') { 1028: $totalpossible=1.*$categories{$id.'_total'}; 1029: } 1030: 1031: if ($output) { 1032: $r->print('</ul>'); 1033: if ($cangrade) { $r->print('<br />'.&new_calc_rule_form($id)); } 1034: $r->print('<p><b>'.&mt('Calculated points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'</b></p>'); 1035: $r->print('</td>'); 1036: } 1037: # 1038: # Prepare for export 1039: # 1040: # Weight 1041: my $weight=$categories{$id.'_weight'}; 1042: unless (1.*$weight>0) { $weight=0; } 1043: if ($cangrade) { 1044: if ($output) { 1045: $r->print('<td>'. 1046: '<input type="text" size="4" name="weight_'.$id. 1047: '" value="'.&Apache::lonhtmlcommon::entity_encode($weight).'" /></td>'); 1048: } 1049: } else { 1050: if ($output) { 1051: $r->print('<td>'.$weight.'</td>'); 1052: } 1053: } 1054: # Achieved 1055: my $type=$categories{$id.'_displayachieved'}; 1056: unless (($type eq 'percent') || ($type eq 'points')) { $type='points'; } 1057: if ($output) { $r->print('<td>'); } 1058: if ($cangrade) { 1059: if ($output) { 1060: $r->print('<select name="displayachieved_'.$id.'">'. 1061: '<option value="percent"'.($type eq 'percent'?' selected="selected"':'').'>'.&mt('percent').'</option>'. 1062: '<option value="points"'.($type eq 'points'?' selected="selected"':'').'>'.&mt('points').'</option>'. 1063: '</select>'); 1064: } 1065: } 1066: if ($output) { 1067: $r->print('<p><b>'); 1068: if ($type eq 'percent') { 1069: my $perc='---'; 1070: if ($totalpossible) { 1071: $perc=100.*$totalcorrect/$totalpossible; 1072: } 1073: $r->print(&mt('[_1] percent',&numberout($perc))); 1074: } else { 1075: $r->print(&mt('[_1]/[_2] points',&numberout($totalcorrect),&numberout($totalpossible))); 1076: } 1077: $r->print('</b></p>'); 1078: } 1079: if ($output) { $r->print('</td>'); } 1080: 1081: return ($totalcorrect,$totalpossible,$type,$weight); 1082: } 1083: 1084: # 1085: # Drop folders and problems 1086: # 1087: 1088: sub drop { 1089: my ($high,$percent,$n,@individual)=@_; 1090: # Sort assignments by points or percent 1091: my @newindividual=sort { 1092: my ($pa,$ca)=split(/\:/,$a); 1093: my ($pb,$cb)=split(/\:/,$b); 1094: if ($percent) { 1095: my $perca=0; 1096: if ($pa>0) { $perca=$ca/$pa; } 1097: my $percb=0; 1098: if ($pb>0) { $percb=$cb/$pb; } 1099: $perca<=>$percb; 1100: } else { 1101: $ca<=>$cb; 1102: } 1103: } @individual; 1104: # Drop the ones we don't want 1105: if ($#newindividual>=$n) { 1106: if ($high) { 1107: splice(@newindividual,$#newindividual+1-$n,$n); 1108: } else { 1109: splice(@newindividual,0,$n); 1110: } 1111: } else { 1112: @newindividual=(); 1113: } 1114: # Re-calculate how many points possible and achieved 1115: my $newpossible=0; 1116: my $newcorrect=0; 1117: for my $score (@newindividual) { 1118: my ($thispossible,$thiscorrect)=(split(/\:/,$score)); 1119: $newpossible+=$thispossible; 1120: $newcorrect+=$thiscorrect; 1121: } 1122: return ($newpossible,$newcorrect,@newindividual); 1123: } 1124: # 1125: # Bottom line with grades 1126: # 1127: 1128: sub bottom_line_category { 1129: my ($r,$cangrade,$perc)=@_; 1130: $r->print(&Apache::loncommon::start_data_table_row()); 1131: if ($cangrade) { 1132: $r->print('<td colspan="3"><a href="javascript:storecmd(\'createnewcat\');">'.&mt('Create New Category').'</a></td>'); 1133: } 1134: $r->print('<td colspan="6"><b>'.&mt('Total: [_1] percent',&numberout($perc)).'</b></td>'); 1135: } 1136: 1137: sub numberout { 1138: my ($number)=@_; 1139: my $printout=sprintf("%.3f", $number); 1140: $printout=~s/0+$//; 1141: $printout=~s/\.$//; 1142: return $printout; 1143: } 1144: # 1145: # Make one new category 1146: # 1147: 1148: sub make_new_category { 1149: my ($r,$cangrade,$ordernum,%categories)=@_; 1150: unless ($cangrade) { return %categories; } 1151: # Generate new ID 1152: my $id=time.'_'.$$.'_'.rand(10000); 1153: # Add new ID to list of all IDs ever created in this course 1154: $categories{'all'}.=','.$id; 1155: $categories{'all'}=~s/^\,//; 1156: # Add new ID to ordered list of displayed and evaluated categories 1157: $categories{'order'}.=','.$id; 1158: $categories{'order'}=~s/^\,//; 1159: # Move it into desired space 1160: if (defined($ordernum)) { 1161: %categories=&move_category($id,$cangrade,$ordernum,%categories); 1162: } 1163: $categories{$id.'_weight'}=0; 1164: $categories{$id.'_totaltype'}='default'; 1165: $categories{$id.'_displayachieved'}='percent'; 1166: return %categories; 1167: } 1168: 1169: 1170: # === Calculation Rule Editing 1171: 1172: sub category_rule_codes { 1173: return &Apache::lonlocal::texthash( 1174: 'droplowperc' => 'Drop N lowest grade percentage problems/folders', 1175: 'drophighperc' => 'Drop N highest grade percentage problems/folderss', 1176: 'droplow' => 'Drop N lowest point problems/folders', 1177: 'drophigh' => 'Drop N highest point problems/folders', 1178: 'capabove' => 'Cap percentage above N percent', 1179: 'capbelow' => 'Cap percentage below N percent'); 1180: } 1181: 1182: sub pretty_prt_rule { 1183: my ($cangrade,$id,$code,$value)=@_; 1184: my $cid=$id.'_'.$code; 1185: my %lt=&category_rule_codes(); 1186: my $ret='<span class="LC_nobreak">'; 1187: if ($cangrade) { 1188: $ret.='<select name="sel_'.$cid.'">'; 1189: foreach my $calc (''=>'',sort(keys(%lt))) { 1190: $ret.='<option value="'.$calc.'"'.($calc eq $code?' selected="selected"':'').' />'.$lt{$calc}.'</input>'; 1191: } 1192: $ret.='</select> N=<input type="text" size="5" name="val_'.$cid.'" value="'.$value.'" /></span>'; 1193: } else { 1194: $ret.=$lt{$code}.'; N='.$value; 1195: } 1196: $ret.='</span>'; 1197: return $ret; 1198: } 1199: 1200: sub new_calc_rule_form { 1201: my ($id)=@_; 1202: return '<a href="javascript:storecmd(\'newrule_'.$id.'\');">'.&mt('New Calculation Rule').'</a>'; 1203: } 1204: 1205: # 1206: # Add a calculation rule 1207: # 1208: 1209: sub add_calculation_rule { 1210: my ($id,$cangrade,$newcontent,%categories)=@_; 1211: unless ($cangrade) { return %categories; } 1212: my %newcontent=($newcontent => 1); 1213: foreach my $current (split(/\,/,$categories{$id.'_calculations'})) { 1214: $newcontent{$current}=1; 1215: } 1216: $categories{$id.'_calculations'}=join(',',sort(keys(%newcontent))); 1217: return %categories; 1218: } 1219: 1220: # 1221: # Delete a calculation rule 1222: # 1223: 1224: sub del_calculation_rule { 1225: my ($id,$cangrade,$delcontent,%categories)=@_; 1226: unless ($cangrade) { return %categories; } 1227: my @newcontent=(); 1228: foreach my $current (split(/\,/,$categories{$id.'_calculations'})) { 1229: unless ($current=~/^\Q$delcontent\E\:/) { 1230: push(@newcontent,$current); 1231: } 1232: } 1233: $categories{$id.'_calculations'}=join(',',@newcontent); 1234: return %categories; 1235: } 1236: 1237: sub set_category_rules { 1238: my ($cangrade,$id,%categories)=@_; 1239: unless ($cangrade) { return %categories; } 1240: my %lt=&category_rule_codes(); 1241: my @newrules=(); 1242: foreach my $code ('',(keys(%lt))) { 1243: if ($env{'form.sel_'.$id.'_'.$code}) { 1244: push(@newrules,$env{'form.sel_'.$id.'_'.$code}.':'.$env{'form.val_'.$id.'_'.$code}); 1245: } 1246: } 1247: $categories{$id.'_calculations'}=join(',',sort(@newrules)); 1248: return %categories; 1249: } 1250: 1251: 1252: # === Category Editing 1253: 1254: # 1255: # Add to category content 1256: # 1257: 1258: sub add_category_content { 1259: my ($id,$cangrade,$newcontent,%categories)=@_; 1260: unless ($cangrade) { return %categories; } 1261: &Apache::lonnet::logthis("In here $newcontent"); 1262: my %newcontent=($newcontent => 1); 1263: foreach my $current (split(/\,/,$categories{$id.'_content'})) { 1264: $newcontent{$current}=1; 1265: } 1266: $categories{$id.'_content'}=join(',',sort(keys(%newcontent))); 1267: return %categories; 1268: } 1269: 1270: # 1271: # Delete from category content 1272: # 1273: 1274: sub del_category_content { 1275: my ($id,$cangrade,$delcontent,%categories)=@_; 1276: unless ($cangrade) { return %categories; } 1277: my @newcontent=(); 1278: foreach my $current (split(/\,/,$categories{$id.'_content'})) { 1279: unless ($current eq $delcontent) { 1280: push(@newcontent,$current); 1281: } 1282: } 1283: $categories{$id.'_content'}=join(',',@newcontent); 1284: return %categories; 1285: } 1286: 1287: # 1288: # Delete category 1289: # 1290: 1291: sub del_category { 1292: my ($id,$cangrade,%categories)=@_; 1293: unless ($cangrade) { return %categories; } 1294: my @neworder=(); 1295: foreach my $currentid (split(/\,/,$categories{'order'})) { 1296: unless ($currentid eq $id) { 1297: push(@neworder,$currentid); 1298: } 1299: } 1300: $categories{'order'}=join(',',@neworder); 1301: return %categories; 1302: } 1303: 1304: # 1305: # Move category up 1306: # 1307: 1308: sub move_up_category { 1309: my ($id,$cangrade,%categories)=@_; 1310: my $currentpos=&current_pos_category($id,%categories); 1311: if ($currentpos<1) { return %categories; } 1312: return &move_category($id,$cangrade,$currentpos-1,%categories); 1313: } 1314: 1315: # 1316: # Move category down 1317: # 1318: 1319: sub move_down_category { 1320: my ($id,$cangrade,%categories)=@_; 1321: my $currentpos=&current_pos_category($id,%categories); 1322: my @order=split(/\,/,$categories{'order'}); 1323: if ($currentpos>=$#order) { return %categories; } 1324: return &move_category($id,$cangrade,$currentpos+1,%categories); 1325: } 1326: 1327: # 1328: # Move a category to a desired position n the display order 1329: # 1330: 1331: sub move_category { 1332: my ($id,$cangrade,$ordernum,%categories)=@_; 1333: unless ($cangrade) { return %categories; } 1334: my @order=split(/\,/,$categories{'order'}); 1335: # Where is the index currently? 1336: my $currentpos=&current_pos_category($id,%categories); 1337: if (defined($currentpos)) { 1338: if ($currentpos<$ordernum) { 1339: # This is moving to a higher index 1340: # ....X1234.... 1341: # ....1234X.... 1342: for (my $i=$currentpos;$i<$ordernum;$i++) { 1343: $order[$i]=$order[$i+1]; 1344: } 1345: $order[$ordernum]=$id; 1346: } 1347: if ($currentpos>$ordernum) { 1348: # This is moving to a lower index 1349: # ....1234X.... 1350: # ....X1234.... 1351: for (my $i=$currentpos;$i>$ordernum;$i--) { 1352: $order[$i]=$order[$i-1]; 1353: } 1354: $order[$ordernum]=$id; 1355: } 1356: } 1357: $categories{'order'}=join(',',@order); 1358: return %categories; 1359: } 1360: 1361: # 1362: # Find current postion of a category in the order 1363: # 1364: 1365: sub current_pos_category { 1366: my ($id,%categories)=@_; 1367: my @order=split(/\,/,$categories{'order'}); 1368: for (my $i=0;$i<=$#order;$i++) { 1369: if ($order[$i] eq $id) { return $i; } 1370: } 1371: # not found 1372: return undef; 1373: } 1374: 1375: # 1376: # Set name of a category 1377: # 1378: sub set_category_name { 1379: my ($cangrade,$id,$name,%categories)=@_; 1380: unless ($cangrade) { return %categories; } 1381: $categories{$id.'_name'}=$name; 1382: return %categories; 1383: } 1384: 1385: # 1386: # Set total of a category 1387: # 1388: sub set_category_total { 1389: my ($cangrade,$id,$totaltype,$total,%categories)=@_; 1390: unless ($cangrade) { return %categories; } 1391: if (($categories{$id.'_total'} eq '') && ($total=~/\d/)) { 1392: $totaltype='typein'; 1393: } 1394: $categories{$id.'_totaltype'}=$totaltype; 1395: if ($totaltype eq 'default') { 1396: $categories{$id.'_total'}=''; 1397: } else { 1398: $total=~s/\D//gs; 1399: unless ($total) { $total=0; } 1400: $categories{$id.'_total'}=$total; 1401: } 1402: return %categories; 1403: } 1404: 1405: sub set_category_weight { 1406: my ($cangrade,$id,$weight,%categories)=@_; 1407: unless ($cangrade) { return %categories; } 1408: $weight=~s/\D//gs; 1409: unless ($weight) { $weight=0; } 1410: $categories{$id.'_weight'}=$weight; 1411: return %categories; 1412: } 1413: 1414: sub set_category_displayachieved { 1415: my ($cangrade,$id,$value,%categories)=@_; 1416: unless ($cangrade) { return %categories; } 1417: unless (($value eq 'percent') || ($value eq 'points')) { $value='percent'; } 1418: $categories{$id.'_displayachieved'}=$value; 1419: return %categories; 1420: } 1421: 1422: 1423: # 1424: # === end category-related 1425: # 1426: # 1427: # Pass this two refs to arrays for the start and end color, and a number 1428: # from 0 to 1 for how much of the latter you want to mix in. It will 1429: # return a string ready to show ("#FFC309"); 1430: 1431: sub mixColors { 1432: my $start = shift; 1433: my $end = shift; 1434: my $ratio = shift; 1435: 1436: my ($a,$b); 1437: my $final = ""; 1438: $a = $start->[0]; $b = $end->[0]; 1439: my $mix1 = POSIX::floor((1-$ratio)*$a + $ratio*$b); 1440: $a = $start->[1]; $b = $end->[1]; 1441: my $mix2 = POSIX::floor((1-$ratio)*$a + $ratio*$b); 1442: $a = $start->[2]; $b = $end->[2]; 1443: my $mix3 = POSIX::floor((1-$ratio)*$a + $ratio*$b); 1444: 1445: $final = sprintf "%02x%02x%02x", $mix1, $mix2, $mix3; 1446: return "#" . $final; 1447: } 1448: 1449: 1;