--- loncom/interface/lonquickgrades.pm 2011/01/17 00:19:38 1.63 +++ loncom/interface/lonquickgrades.pm 2020/09/01 03:39:38 1.119 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Quick Student Grades Display # -# $Id: lonquickgrades.pm,v 1.63 2011/01/17 00:19:38 www Exp $ +# $Id: lonquickgrades.pm,v 1.119 2020/09/01 03:39:38 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,12 +29,31 @@ package Apache::lonquickgrades; use strict; -use Apache::Constants qw(:common :http); +use Apache::Constants qw(:common :http REDIRECT); use POSIX; use Apache::loncommon; use Apache::lonlocal; use Apache::lonnet; use Apache::grades; +use Apache::loncoursedata; +use Apache::lonstudentassessment; +use Apache::lonuserstate; + +use Time::HiRes; +use Spreadsheet::WriteExcel; +use Spreadsheet::WriteExcel::Utility(); +# +# Excel data +# +my $excel_sheet; +my $excel_workbook; +my $filename; +my $format; +my $request_aborted; +my $header_row; +my $cols_output; +my %prog_state; + sub handler { my $r = shift; @@ -57,50 +76,258 @@ sub real_handler { return OK; } - # Send header, don't cache this page - &Apache::loncommon::no_cache($r); - $r->send_http_header; - + my $cangrade=&Apache::lonnet::allowed('mgr'); my $showPoints = - $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard'; - my $notshowSPRSlink = - (($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'external') - || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals')); - my $notshowTotals= - $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'; - my $showCategories= - $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories'; + (($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard') + || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories')); + my $reinitresult; - my $title = "Grading and Statistics";#$showPoints ? "Points Display" : "Completed Problems Display"; - my $brcrum = [{href=>"/adm/quickgrades",text => "Points Display"}]; - $r->print(&Apache::loncommon::start_page($title,undef, - {'bread_crumbs' => $brcrum}) - ); + if ($env{'request.course.id'}) { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my ($blocked,$blocktext) = + &Apache::loncommon::blocking_status('grades',$cnum,$cdom); + if ($blocked) { + my $checkrole = "cm./$cdom/$cnum"; + if ($env{'request.course.sec'} ne '') { + $checkrole .= "/$env{'request.course.sec'}"; + } + unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) && + ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) { + &grades_blocked($r,$blocktext,$showPoints); + return OK; + } + } + } - &startGradeScreen($r,'quick'); + unless ($cangrade) { + # Check for critical messages and redirect if present. + my ($redirect,$url) = &Apache::loncommon::critical_redirect(300,'grades'); + if ($redirect) { + &Apache::loncommon::content_type($r,'text/html'); + $r->header_out(Location => $url); + return REDIRECT; + } + # Check if course needs to be re-initialized + my $loncaparev = $r->dir_config('lonVersion'); + ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev); + + if ($reinitresult eq 'switch') { + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + $r->print(&Apache::loncommon::check_release_result(@reinit)); + return OK; + } elsif ($reinitresult eq 'update') { + my $cid = $env{'request.course.id'}; + my $cnum = $env{'course.'.$cid.'.num'}; + my $cdom = $env{'course.'.$cid.'.domain'}; + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + &startpage($r,$showPoints); + my $preamble = '
'. + '
'. + &mt('Your course session is being updated because of recent changes by course personnel.'). + ' '.&mt('Please be patient.').'
'. + '
'; + %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($r,undef,$preamble); + &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Updating course')); + $r->rflush(); + my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum"); + &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Finished')); + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + my $closure = < +// + +ENDCLOSE + if ($ferr) { + $r->print($closure.&Apache::loncommon::end_page()); + my $requrl = $r->uri; + $env{'user.error.msg'}="$requrl:bre:0:0:Course not initialized"; + $env{'user.reinit'} = 1; + return HTTP_NOT_ACCEPTABLE; + } else { + $r->print($closure); + } + } elsif ((&Apache::loncommon::course_type() eq 'Placement') && + (!$env{'request.role.adv'})) { + my $furl = &Apache::lonpageflip::first_accessible_resource(); + &Apache::loncommon::content_type($r,'text/html'); + $r->header_out(Location => $furl); + return REDIRECT; + } + } + + unless ($reinitresult eq 'update') { + # Send header, don't cache this page + &Apache::loncommon::no_cache($r); + $r->send_http_header; + &startpage($r,$showPoints); + } $r->rflush(); -# my $uname='korte'; -# my $udom='gerd'; + &startGradeScreen($r,'quick'); +# +# Pick student +# my $uname; my $udom; + my $stdid; + if ($cangrade) { + $r->print("

".&mt("Download Multiple")."

". + ''."\n". + ''. + ''. + ''. + ''. + ''. + ''."\n". + ''."\n". + '
'.&mt('Sections').''. + &Apache::loncommon::help_open_topic("Chart_Sections"). + ''.&mt('Groups').''. + ''.&mt('Student Data').''. + &Apache::loncommon::help_open_topic("Chart_Student_Data"). + ''.&mt('Access Status').''. + &Apache::loncommon::help_open_topic("Chart_Enrollment_Status"). + ''.&mt('Output Format').''. + &Apache::loncommon::help_open_topic("Chart_Output_Formats"). + ' 
'."\n". + &Apache::lonstatistics::SectionSelect('Section','multiple',5). + ''. + &Apache::lonstatistics::GroupSelect('Group','multiple',5). + ''. + &Apache::lonstatistics::StudentDataSelect('StudentData','multiple',5,undef). + ''."\n". + &Apache::lonhtmlcommon::StatusOptions(undef,undef,5). + ''."\n". + &Apache::lonstudentassessment::CreateAndParseOutputSelector(). + ''. + ''. + '
'."\n" + ); + $r->print("

".&mt("Display Individual")."

"); + if ($env{'form.uname'}) { $uname=$env{'form.uname'}; } + if ($env{'form.udom'}) { $udom=$env{'form.udom'}; } + if ($env{'form.id'}) { $stdid=$env{'form.id'}; } + if (($stdid) && ($udom)) { + $uname=(&Apache::lonnet::idget($udom,[$stdid],'ids'))[1]; + } + if (($stdid) && (!$uname)) { + $r->print('

'.&mt("Unknown Student/Employee ID: [_1]",$stdid).'

'); + $stdid=''; + } + if (($uname eq '') && ($udom eq '')) { + $uname = $env{'user.name'}; + $udom = $env{'user.domain'}; + } + $r->print('
'); + my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '. + &Apache::loncommon::selectstudent_link('quickform','uname','udom'); + $r->print("

\n".&Apache::loncommon::studentbrowser_javascript()."\n"); + $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]' + ,'' + ,' ' + ,$chooseopt). + '  

'); + if (($uname) && ($udom)) { + $r->print('

'.&mt('Full Name: [_1]',&Apache::loncommon::plainname($uname,$udom)).'

'); + } + } + $r->rflush(); - my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)= - &getData($showPoints,$uname,$udom); + my $notshowTotals= + $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'; + my $showCategories= + $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories'; - if ($showCategories) { - &outputCategories($r,$showPoints,$notshowTotals, - $navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted); + my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts, + $topLevelRight,$topLevelAttempted) = &getData($showPoints,$uname,$udom); + + if (ref($navmap)) { + if ($showCategories) { + &outputCategories($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible, + $totalRight,$totalAttempted,$topLevelParts,$topLevelRight, + $topLevelAttempted); + } else { + &outputTable($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible, + $totalRight,$totalAttempted,$topLevelParts,$topLevelRight, + $topLevelAttempted); + } } else { - &outputTable($r,$showPoints,$notshowTotals, - $navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted); + if ($cangrade) { $r->print("\n
\n"); } + my $requrl = $r->uri; + $env{'user.error.msg'} = "$requrl:bre:0:0:Navmap initialization failed."; + return HTTP_NOT_ACCEPTABLE; } + if ($cangrade) { $r->print("\n\n"); } &endGradeScreen($r); return OK; +} + +sub grades_blocked { + my ($r,$blocktext,$caller) = @_; + my $title = 'Points Display'; + if ($caller eq 'spreadsheet') { + $title = 'Spreadsheet'; + } elsif ($env{'course.'.$env{'request.course.id'}.'.grading'} ne 'standard') { + $title = 'Completed Problems Display'; + } + my $brcrum = [{href=>"/adm/quickgrades",text => $title}]; + &Apache::lonhtmlcommon::clear_breadcrumbs(); + &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/quickgrades', + text=> $title}); + my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs($title); + &Apache::loncommon::content_type($r,'text/html'); + &Apache::loncommon::no_cache($r); + $r->send_http_header; + $r->print(&Apache::loncommon::start_page($title). + $breadcrumbs. + $blocktext. + &Apache::loncommon::end_page()); + return; +} + +sub getStudentCatGrade { + my ($uname,$udom,%categories)=@_; + my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)= + &getData(1,$uname,$udom); + return &output_category_table(undef,0,$navmap,0,%categories); +} + +sub getAllStudentData { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my %categories=&Apache::lonnet::dump('grading_categories',$cdom,$cnum); + + my $classlist = &Apache::loncoursedata::get_classlist(); + + my $statusidx = &Apache::loncoursedata::CL_STATUS(); + my $usernameidx = &Apache::loncoursedata::CL_SNAME(); + my $domainidx = &Apache::loncoursedata::CL_SDOM(); + my $fullnameidx = &Apache::loncoursedata::CL_FULLNAME(); + + foreach my $key (keys(%{$classlist})) { + my $student = $classlist->{$key}; + my $perc=&getStudentCatGrade($classlist->{$student}->[$usernameidx], + $classlist->{$student}->[$domainidx], + %categories); + } +} + +sub startpage { + my ($r,$showPoints) = @_; + my $title = "Grading and Statistics";#$showPoints ? "Points Display" : "Completed Problems Display"; + my $brcrum = [{href=>"/adm/quickgrades",text => "Points Display"}]; + $r->print(&Apache::loncommon::start_page($title,undef, + {'bread_crumbs' => $brcrum}) + ); } sub startGradeScreen { @@ -112,13 +339,24 @@ sub startGradeScreen { (($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'external') || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals') || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories')); - my $notshowTotals= + my $notshowTotals = $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'; - my $showCategories= + my $showSPRSlink = + $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'spreadsheet'; + my $showCategories = $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories'; + + my $allowed_to_view = &Apache::lonnet::allowed('vgr',$env{'request.course.id'}); + if ((!$allowed_to_view) && ($env{'request.course.sec'} ne '')) { + $allowed_to_view = &Apache::lonnet::allowed('vgr', + "$env{'request.course.id'}/$env{'request.course.sec'}"); + } - my $allowed_to_view = &Apache::lonnet::allowed('vgr',$env{'request.course.id'}); - my $allowed_to_edit = &Apache::lonnet::allowed('mgr',$env{'request.course.id'}); + my $allowed_to_edit = &Apache::lonnet::allowed('mgr',$env{'request.course.id'}); + if ((!$allowed_to_edit) && ($env{'request.course.sec'} ne '')) { + $allowed_to_edit = &Apache::lonnet::allowed('mgr', + "$env{'request.course.id'}/$env{'request.course.sec'}"); + } if ($allowed_to_view) { my @notes; @@ -126,6 +364,7 @@ sub startGradeScreen { push(@notes,&mt('Students do not see link to spreadsheet.')) if ($notshowSPRSlink); push(@notes,&mt('Students will see points based on problem weights.')) if ($showPoints); push(@notes,&mt('Students will see points based on categories.')) if ($showCategories); + push(@notes,&mt('Students will see link to spreadsheet.')) if ($showSPRSlink); push(@notes, &Apache::lonhtmlcommon::coursepreflink(&mt('Grade display settings'),'grading')); $r->print(&Apache::loncommon::head_subbox(join('  ',@notes))); } @@ -145,39 +384,111 @@ sub startGradeScreen { &mt('Statistics and Reports').''); $r->print("\n".''. - &mt('Assessment Overview Chart').''); + &mt('Assessment Chart').''); } if ($allowed_to_edit) { $r->print("\n".'    '. - &mt('Problem Grading').'    '); + &mt('Content Grading').'    '); + if ($env{'form.symb'}) { + $r->print("\n".'    '. + &mt('Problem Grading').'    '); + + } } $r->print("\n".''."\n"); $r->print('
'); } sub endGradeScreen { - my ($r)=@_; - $r->print('
'); + my ($r)=@_; + $r->print(''.&Apache::loncommon::end_page()); + return; } +# ----------- + + +sub excel_cleanup { + undef ($excel_sheet); + undef ($excel_workbook); + undef ($filename); + undef ($format); +} + + +sub excel_initialize { + my ($r) = @_; + + &excel_cleanup(); + + # Create sheet + ($excel_workbook,$filename,$format)= + &Apache::loncommon::create_workbook($r); + return if (! defined($excel_workbook)); + # + # Add a worksheet + my $sheetname = $env{'course.'.$env{'request.course.id'}.'.description'}; + $sheetname = &Apache::loncommon::clean_excel_name($sheetname); + $excel_sheet = $excel_workbook->addworksheet($sheetname); + # + # Put the course description in the header + $excel_sheet->write($header_row,$cols_output++, + $env{'course.'.$env{'request.course.id'}.'.description'}, + $format->{'h1'}); +} + +sub excel_finish { + my ($r) = @_; + if ($request_aborted || ! defined($excel_sheet)) { + &excel_cleanup(); + return; + } + # + # Write the excel file + $excel_workbook->close(); + # + # Close the progress window + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + # + # Tell the user where to get their excel file + $r->print('
'. + ''.&mt('Your Excel spreadsheet').''."\n"); + $r->rflush(); + &excel_cleanup(); + return; +} + + +# +# CSV data +# +# ----------- + +# +# Go through the complete course and collect data +# sub getData { my ($showPoints,$uname,$udom)=@_; - &Apache::lonnet::logthis("About to call with $uname $udom"); - # Create the nav map my $navmap = Apache::lonnavmaps::navmap->new($uname,$udom); + if (!defined($navmap)) { + return (); + } + my $res = $navmap->firstResource(); # temp resource to access constants my $iterator = $navmap->getIterator(undef, undef, undef, 1); my $depth = 1; $iterator->next(); # ignore first BEGIN_MAP my $curRes = $iterator->next(); - + # General overview of the following: Walk along the course resources. # For every problem in the resource, tell its parent maps how many # parts and how many parts correct it has. After that, each map will @@ -200,7 +511,8 @@ sub getData { if ($curRes == $iterator->BEGIN_MAP()) {$depth++;} if ($curRes == $iterator->END_MAP()) { $depth--; } - if (ref($curRes) && $curRes->is_problem() && !$curRes->randomout) + if (ref($curRes) && $curRes->is_gradable() && !$curRes->randomout && + ($curRes->deeplink ne 'absent')) { # Get number of correct, incorrect parts my $parts = $curRes->parts(); @@ -210,35 +522,40 @@ sub getData { my $stack = $iterator->getStack(); for my $part (@{$parts}) { - my $completionStatus = $curRes->getCompletionStatus($part); my $dateStatus = $curRes->getDateStatus($part); - - if ($completionStatus == $curRes->EXCUSED()) { + my $weight = $curRes->weight($part); + my $problemstatus = $curRes->problemstatus($part); + + if ($curRes->solved($part) eq 'excused') { next; } if ($showPoints) { my $score = 0; # If we're not telling status and the answer date isn't passed yet, # it's an "attempted" point - if ((($curRes->problemstatus($part) eq 'no') || - ($curRes->problemstatus($part) eq 'no_feedback_ever')) && + if ((($problemstatus eq 'no') || + ($problemstatus eq 'no_feedback_ever')) && ($dateStatus != $curRes->ANSWER_OPEN)) { my $status = $curRes->simpleStatus($part); if ($status == $curRes->ATTEMPTED) { - $partsAttempted += $curRes->weight($part); + $partsAttempted += $weight; $totalAttempted += $partsAttempted; } } else { - $score = &Apache::grades::compute_points($curRes->weight($part), $curRes->awarded($part)); + $score = &Apache::grades::compute_points($weight, $curRes->awarded($part)); } $partsRight += $score; $totalRight += $score; - $partsCount += $curRes->weight($part); + $partsCount += $weight; + + $curRes->{DATA}->{PROB_SCORE} += $score; + $curRes->{DATA}->{PROB_WEIGHT} += $weight; if ($curRes->opendate($part) < $now) { - $totalPossible += $curRes->weight($part); + $totalPossible += $weight; + $curRes->{DATA}->{PROB_POSSIBLE} += $weight; } - $totalParts += $curRes->weight($part); + $totalParts += $weight; } else { my $status = $curRes->simpleStatus($part); my $thisright = 0; @@ -255,7 +572,6 @@ sub getData { $totalAttempted++; } - my $dateStatus = $curRes->getDateStatus($part); $totalParts++; if ($curRes->opendate($part) < $now) { $totalPossible++; @@ -286,7 +602,8 @@ sub getData { } $curRes = $iterator->next(); } - return ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted); + return ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted, + $topLevelParts,$topLevelRight,$topLevelAttempted); } # @@ -295,8 +612,8 @@ sub getData { sub outputTable { - my ($r,$showPoints,$notshowTotals, - $navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_; + my ($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible,$totalRight, + $totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_; my @start = (255, 255, 192); my @end = (0, 192, 0); @@ -369,7 +686,7 @@ sub outputTable { # If there were any problems at the top level, print an extra "catchall" if ($topLevelParts > 0) { my $ratio = $topLevelRight / $topLevelParts; - my $color = mixColors(\@start, \@end, $ratio); + my $color = &mixColors(\@start, \@end, $ratio); $r->print(&Apache::loncommon::start_data_table_row() .''); $r->print(&mt("Problems Not Contained In A Folder").""); @@ -381,7 +698,7 @@ sub outputTable { # show totals (if applicable), close table # if ($showPoints) { - my $maxHelpLink = Apache::loncommon::help_open_topic("Quick_Grades_Possibly_Correct"); + my $maxHelpLink = &Apache::loncommon::help_open_topic("Quick_Grades_Possibly_Correct"); $title = $showPoints ? "Points" : "Parts Done"; my $totaltitle = $showPoints ? &mt("Awarded Total Points") : &mt("Total Parts Done"); @@ -393,13 +710,16 @@ sub outputTable { .&Apache::loncommon::end_data_table_row()); } - $r->print(&Apache::loncommon::end_data_table() - .&Apache::loncommon::end_page()); - + $r->print(&Apache::loncommon::end_data_table()); + return; } # -# Outputting category-based grades. +# === Outputting category-based grades. +# +# $category{'order'}: output order of categories by id +# $category{'all'}: complete list of all categories +# $category{$id.'_name'}: display-name of category # sub outputCategories { @@ -408,14 +728,691 @@ sub outputCategories { $navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)=@_; # Take care of storing and retrieving categories + my $cangrade=&Apache::lonnet::allowed('mgr'); + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my %categories=(); +# Loading old categories + %categories=&Apache::lonnet::dump('grading_categories',$cdom,$cnum); +# Storing + if (($cangrade) && (($env{'form.storechanges'}) || ($env{'form.storemove'} ne '') || ($env{'form.cmd'} ne ''))) { +# Process the changes + %categories=&process_category_edits($r,$cangrade,%categories); +# Actually store + &Apache::lonnet::put('grading_categories',\%categories,$cdom,$cnum); + } +# new categories loaded now + &output_category_table($r,$cangrade,$navmap,1,%categories); +# + if ($cangrade) { + $r->print(&Apache::loncommon::resourcebrowser_javascript(). + ''. + ''. + ''. + ''. + ''); + } +} - my %categories=&Apache::lonnet::dump('grading_categories',$cdom,$cnum); -# categories loaded now +# +# Get data for all symbs +# + +sub dumpdata { + my ($navmap)=@_; + my %returndata=(); + +# Run through the map and get all data + + my $iterator = $navmap->getIterator(undef, undef, undef, 1); + my $depth = 1; + $iterator->next(); # ignore first BEGIN_MAP + my $curRes = $iterator->next(); + + while ($depth > 0) { + if ($curRes == $iterator->BEGIN_MAP()) {$depth++;} + if ($curRes == $iterator->END_MAP()) { $depth--; } + if (ref($curRes)) { + if ($curRes->is_map()) { + $returndata{$curRes->symb()}='folder:'.$curRes->{DATA}->{CHILD_PARTS}.':'.$curRes->{DATA}->{CHILD_ATTEMPTED}.':'.$curRes->{DATA}->{CHILD_CORRECT}; + } else { + $returndata{$curRes->symb()}='res:'.$curRes->{DATA}->{PROB_WEIGHT}.':'.$curRes->{DATA}->{PROB_POSSIBLE}.':'.$curRes->{DATA}->{PROB_SCORE}; + } + } + $curRes = $iterator->next(); + } + return %returndata; +} + +# +# Process editing commands, update category hash +# + +sub process_category_edits { + my ($r,$cangrade,%categories)=@_; + unless ($cangrade) { return %categories; } +# First store everything + foreach my $id (split(/\,/,$categories{'order'})) { +# Set names, types, and weight (there is only one of each per category) + %categories=&set_category_name($cangrade,$id,$env{'form.name_'.$id},%categories); + %categories=&set_category_total($cangrade,$id,$env{'form.totaltype_'.$id},$env{'form.total_'.$id},%categories); + %categories=&set_category_weight($cangrade,$id,$env{'form.weight_'.$id},%categories); + %categories=&set_category_displayachieved($cangrade,$id,$env{'form.displayachieved_'.$id},%categories); +# Set values for category rules (before names may change) + %categories=&set_category_rules($cangrade,$id,%categories); + } + +# Now deal with commands + my $cmd=$env{'form.cmd'}; + if ($cmd eq 'createnewcat') { + %categories=&make_new_category($r,$cangrade,undef,%categories); + } elsif ($cmd=~/^up\_(.+)$/) { + %categories=&move_up_category($1,$cangrade,%categories); + } elsif ($cmd=~/^down\_(.+)$/) { + %categories=&move_down_category($1,$cangrade,%categories); + } elsif ($cmd=~/^delcat\_(.+)$/) { + %categories=&del_category($1,$cangrade,%categories); + } elsif ($cmd=~/^addcont\_(.+)$/) { + %categories=&add_category_content($1,$cangrade,$env{'form.resourcesymb'},%categories); + } elsif ($cmd=~/^delcont\_(.+)\_\_\_\_\_\_(.+)$/) { + %categories=&del_category_content($1,$cangrade,$2,%categories); + } elsif ($cmd=~/^newrule\_(.+)$/) { + %categories=&add_calculation_rule($1,$cangrade,':',%categories); + } elsif ($cmd=~/^delrule\_(.+)\_\_\_\_\_\_(.*)$/) { + %categories=&del_calculation_rule($1,$cangrade,$2,%categories); + } +# Move to a new position + my $moveid=$env{'form.storemove'}; + if ($moveid) { + %categories=&move_category($moveid,$cangrade,$env{'form.newpos_'.$moveid},%categories); + } + return %categories; +} + +# +# Output the table +# +sub output_category_table { + my ($r,$cangrade,$navmaps,$output,%categories)=@_; + + my $totalweight=0; + my $totalpoints=0; + + if ($output) { + $r->print(&Apache::loncommon::start_data_table()); +# + &output_category_table_header($r,$cangrade); + } +# + my @order=split(/\,/,$categories{'order'}); +# + my %performance=&dumpdata($navmaps); + my $maxpos=$#order; + for (my $i=0;$i<=$maxpos;$i++) { + my ($correct,$possible,$type,$weight)=&output_and_calc_category($r,$cangrade,$navmaps,$order[$i],$i,$maxpos,\%performance,$output,%categories); + unless ($possible) { next; } + $totalpoints+=$weight*$correct/$possible; + $totalweight+=$weight; + } +# + my $perc=0; + if ($totalweight) { $perc=100.*$totalpoints/$totalweight; } + + if ($output) { + &bottom_line_category($r,$cangrade,$perc); + $r->print(&Apache::loncommon::end_data_table()); + } + return $perc; +} + +sub output_category_table_header { + my ($r,$cangrade)=@_; + $r->print(&Apache::loncommon::start_data_table_header_row()); + if ($cangrade) { + $r->print(''.&mt("Move").''.&mt('Action').''); + } + $r->print(''.&mt('Category').''. + ''.&mt('Contents').''. + ''.&mt('Total Points').''. + ''.&mt('Calculation').''. + ''.&mt('Relative Weight').''. + ''.&mt('Achieved').''); + $r->print(&Apache::loncommon::end_data_table_header_row()); } + +# +# Output one category to table +# + +sub output_and_calc_category { + my ($r,$cangrade,$navmaps,$id,$currentpos,$maxpos,$performance,$output,%categories)=@_; + + if ($output) { $r->print("\n".&Apache::loncommon::start_data_table_row()); } + + if ($output && $cangrade) { + my $iconpath = &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL') . "/"); + my %lt=&Apache::lonlocal::texthash( + 'up' => 'Move Up', + 'dw' => 'Move Down'); + + $r->print(< +
+ + $lt{ + +
+
+ + $lt{ + +
+ +ENDMOVE + $r->print("\n\n\n\n"); + $r->print(''.&mt('Delete').''); + $r->print(''); + } elsif ($output) { + $r->print(''.$categories{$id.'_name'}.''); + } +# Content display and summing up of points + my $totalpossible=0; + my $totalcorrect=0; + my @individual=(); + if ($output) { $r->print('
    '); } + foreach my $contentid (split(/\,/,$categories{$id.'_content'})) { + my ($type,$possible,$attempted,$correct)=split(/\:/,$$performance{$contentid}); + $totalpossible+=$possible; + $totalcorrect+=$correct; + if ($possible>0) { push(@individual,"$possible:$correct"); } + if ($output) { + $r->print('
  • '); + $r->print(&Apache::lonnet::gettitle($contentid).' ('.&numberout($correct).'/'.&numberout($possible).')'); + if ($cangrade) { + $r->print(' '.&mt('Delete').''); + } + $r->print('
  • '); + } + } + if ($output) { + $r->print('
'); + if ($cangrade) { + $r->print('
'.&Apache::loncommon::selectresource_link('quickform','addcont_'.$id,&mt('Add Problem or Folder')).'
'); + } + $r->print('

'.&mt('Total raw points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'

'); + $r->print(''); + } +# Total + if ($output) { $r->print(''); } + if ($cangrade) { + if ($output) { + $r->print( + ''. + ''); + } + } else { + if ($output) { + $r->print(''.($categories{$id.'_totaltype'} eq 'default'?&mt('default'):$categories{$id.'_total'})); + } + } +# Adjust total points + if ($categories{$id.'_totaltype'} eq 'typein') { + $totalpossible=1.*$categories{$id.'_total'}; + } + if ($output) { + $r->print('

'.&mt('Adjusted raw points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'

'); + } + + +# Calculation + if ($output) { $r->print('
    '); } + foreach my $calcrule (split(/\,/,$categories{$id.'_calculations'})) { + if ($output) { $r->print('
  • '); } + my ($code,$value)=split(/\:/,$calcrule); + if ($output) { $r->print(&pretty_prt_rule($cangrade,$id,$code,$value)); } + if ($cangrade) { + if ($output) { $r->print(' '.&mt('Delete').''); } + } + if ($code eq 'capabove') { + if ($totalpossible>0) { + if ($totalcorrect/$totalpossible>$value/100.) { + $totalcorrect=$totalpossible*$value/100.; + } + } + } elsif ($code eq 'capbelow') { + if ($totalpossible>0) { + if ($totalcorrect/$totalpossible<$value/100.) { + $totalcorrect=$totalpossible*$value/100.; + } + } + } elsif ($code eq 'droplow') { + ($totalpossible,$totalcorrect,@individual)=&drop(0,0,$value,@individual); + } elsif ($code eq 'drophigh') { + ($totalpossible,$totalcorrect,@individual)=&drop(1,0,$value,@individual); + } elsif ($code eq 'droplowperc') { + ($totalpossible,$totalcorrect,@individual)=&drop(0,1,$value,@individual); + } elsif ($code eq 'drophighperc') { + ($totalpossible,$totalcorrect,@individual)=&drop(1,1,$value,@individual); + } + if ($output) { $r->print('
  • '); } + } +# Re-adjust total points if force total + if ($categories{$id.'_totaltype'} eq 'typein') { + $totalpossible=1.*$categories{$id.'_total'}; + } + + if ($output) { + $r->print('
'); + if ($cangrade) { $r->print('
'.&new_calc_rule_form($id)); } + $r->print('

'.&mt('Calculated points: [_1]/[_2]',&numberout($totalcorrect),&numberout($totalpossible)).'

'); + $r->print(''); + } +# +# Prepare for export +# +# Weight + my $weight=$categories{$id.'_weight'}; + unless (1.*$weight>0) { $weight=0; } + if ($cangrade) { + if ($output) { + $r->print(''. + ''); + } + } else { + if ($output) { + $r->print(''.$weight.''); + } + } +# Achieved + my $type=$categories{$id.'_displayachieved'}; + unless (($type eq 'percent') || ($type eq 'points')) { $type='points'; } + if ($output) { $r->print(''); } + if ($cangrade) { + if ($output) { + $r->print(''); + } + } + if ($output) { + $r->print('

'); + if ($type eq 'percent') { + my $perc='---'; + if ($totalpossible) { + $perc=100.*$totalcorrect/$totalpossible; + } + $r->print(&mt('[_1] percent',&numberout($perc))); + } else { + $r->print(&mt('[_1]/[_2] points',&numberout($totalcorrect),&numberout($totalpossible))); + } + $r->print('

'); + } + if ($output) { $r->print(''); } + + return ($totalcorrect,$totalpossible,$type,$weight); +} + +# +# Drop folders and problems +# + +sub drop { + my ($high,$percent,$n,@individual)=@_; +# Sort assignments by points or percent + my @newindividual=sort { + my ($pa,$ca)=split(/\:/,$a); + my ($pb,$cb)=split(/\:/,$b); + if ($percent) { + my $perca=0; + if ($pa>0) { $perca=$ca/$pa; } + my $percb=0; + if ($pb>0) { $percb=$cb/$pb; } + $perca<=>$percb; + } else { + $ca<=>$cb; + } + } @individual; +# Drop the ones we don't want + if ($#newindividual>=$n) { + if ($high) { + splice(@newindividual,$#newindividual+1-$n,$n); + } else { + splice(@newindividual,0,$n); + } + } else { + @newindividual=(); + } +# Re-calculate how many points possible and achieved + my $newpossible=0; + my $newcorrect=0; + for my $score (@newindividual) { + my ($thispossible,$thiscorrect)=(split(/\:/,$score)); + $newpossible+=$thispossible; + $newcorrect+=$thiscorrect; + } + return ($newpossible,$newcorrect,@newindividual); +} +# +# Bottom line with grades +# + +sub bottom_line_category { + my ($r,$cangrade,$perc)=@_; + $r->print(&Apache::loncommon::start_data_table_row()); + if ($cangrade) { + $r->print(''.&mt('Create New Category').''); + } + $r->print(''.&mt('Total: [_1] percent',&numberout($perc)).''); +} + +sub numberout { + my ($number)=@_; + my $printout=sprintf("%.3f", $number); + $printout=~s/0+$//; + $printout=~s/\.$//; + return $printout; +} +# +# Make one new category +# + +sub make_new_category { + my ($r,$cangrade,$ordernum,%categories)=@_; + unless ($cangrade) { return %categories; } +# Generate new ID + my $id=time.'_'.$$.'_'.rand(10000); +# Add new ID to list of all IDs ever created in this course + $categories{'all'}.=','.$id; + $categories{'all'}=~s/^\,//; +# Add new ID to ordered list of displayed and evaluated categories + $categories{'order'}.=','.$id; + $categories{'order'}=~s/^\,//; +# Move it into desired space + if (defined($ordernum)) { + %categories=&move_category($id,$cangrade,$ordernum,%categories); + } + $categories{$id.'_weight'}=0; + $categories{$id.'_totaltype'}='default'; + $categories{$id.'_displayachieved'}='percent'; + return %categories; +} + + +# === Calculation Rule Editing + +sub category_rule_codes { + return &Apache::lonlocal::texthash( + 'droplowperc' => 'Drop N lowest grade percentage problems/folders', + 'drophighperc' => 'Drop N highest grade percentage problems/folderss', + 'droplow' => 'Drop N lowest point problems/folders', + 'drophigh' => 'Drop N highest point problems/folders', + 'capabove' => 'Cap percentage above N percent', + 'capbelow' => 'Cap percentage below N percent'); +} + +sub pretty_prt_rule { + my ($cangrade,$id,$code,$value)=@_; + my $cid=$id.'_'.$code; + my %lt=&category_rule_codes(); + my $ret=''; + if ($cangrade) { + $ret.=' N='; + } else { + $ret.=$lt{$code}.'; N='.$value; + } + $ret.=''; + return $ret; +} + +sub new_calc_rule_form { + my ($id)=@_; + return ''.&mt('New Calculation Rule').''; +} + +# +# Add a calculation rule +# + +sub add_calculation_rule { + my ($id,$cangrade,$newcontent,%categories)=@_; + unless ($cangrade) { return %categories; } + my %newcontent=($newcontent => 1); + foreach my $current (split(/\,/,$categories{$id.'_calculations'})) { + $newcontent{$current}=1; + } + $categories{$id.'_calculations'}=join(',',sort(keys(%newcontent))); + return %categories; +} + +# +# Delete a calculation rule +# + +sub del_calculation_rule { + my ($id,$cangrade,$delcontent,%categories)=@_; + unless ($cangrade) { return %categories; } + my @newcontent=(); + foreach my $current (split(/\,/,$categories{$id.'_calculations'})) { + unless ($current=~/^\Q$delcontent\E\:/) { + push(@newcontent,$current); + } + } + $categories{$id.'_calculations'}=join(',',@newcontent); + return %categories; +} + +sub set_category_rules { + my ($cangrade,$id,%categories)=@_; + unless ($cangrade) { return %categories; } + my %lt=&category_rule_codes(); + my @newrules=(); + foreach my $code ('',(keys(%lt))) { + if ($env{'form.sel_'.$id.'_'.$code}) { + push(@newrules,$env{'form.sel_'.$id.'_'.$code}.':'.$env{'form.val_'.$id.'_'.$code}); + } + } + $categories{$id.'_calculations'}=join(',',sort(@newrules)); + return %categories; +} + + +# === Category Editing + +# +# Add to category content +# + +sub add_category_content { + my ($id,$cangrade,$newcontent,%categories)=@_; + unless ($cangrade) { return %categories; } + &Apache::lonnet::logthis("In here $newcontent"); + my %newcontent=($newcontent => 1); + foreach my $current (split(/\,/,$categories{$id.'_content'})) { + $newcontent{$current}=1; + } + $categories{$id.'_content'}=join(',',sort(keys(%newcontent))); + return %categories; +} + +# +# Delete from category content +# + +sub del_category_content { + my ($id,$cangrade,$delcontent,%categories)=@_; + unless ($cangrade) { return %categories; } + my @newcontent=(); + foreach my $current (split(/\,/,$categories{$id.'_content'})) { + unless ($current eq $delcontent) { + push(@newcontent,$current); + } + } + $categories{$id.'_content'}=join(',',@newcontent); + return %categories; +} + +# +# Delete category +# + +sub del_category { + my ($id,$cangrade,%categories)=@_; + unless ($cangrade) { return %categories; } + my @neworder=(); + foreach my $currentid (split(/\,/,$categories{'order'})) { + unless ($currentid eq $id) { + push(@neworder,$currentid); + } + } + $categories{'order'}=join(',',@neworder); + return %categories; +} + +# +# Move category up +# + +sub move_up_category { + my ($id,$cangrade,%categories)=@_; + my $currentpos=¤t_pos_category($id,%categories); + if ($currentpos<1) { return %categories; } + return &move_category($id,$cangrade,$currentpos-1,%categories); +} + +# +# Move category down +# + +sub move_down_category { + my ($id,$cangrade,%categories)=@_; + my $currentpos=¤t_pos_category($id,%categories); + my @order=split(/\,/,$categories{'order'}); + if ($currentpos>=$#order) { return %categories; } + return &move_category($id,$cangrade,$currentpos+1,%categories); +} + +# +# Move a category to a desired position n the display order +# + +sub move_category { + my ($id,$cangrade,$ordernum,%categories)=@_; + unless ($cangrade) { return %categories; } + my @order=split(/\,/,$categories{'order'}); +# Where is the index currently? + my $currentpos=¤t_pos_category($id,%categories); + if (defined($currentpos)) { + if ($currentpos<$ordernum) { +# This is moving to a higher index +# ....X1234.... +# ....1234X.... + for (my $i=$currentpos;$i<$ordernum;$i++) { + $order[$i]=$order[$i+1]; + } + $order[$ordernum]=$id; + } + if ($currentpos>$ordernum) { +# This is moving to a lower index +# ....1234X.... +# ....X1234.... + for (my $i=$currentpos;$i>$ordernum;$i--) { + $order[$i]=$order[$i-1]; + } + $order[$ordernum]=$id; + } + } + $categories{'order'}=join(',',@order); + return %categories; +} + +# +# Find current postion of a category in the order +# + +sub current_pos_category { + my ($id,%categories)=@_; + my @order=split(/\,/,$categories{'order'}); + for (my $i=0;$i<=$#order;$i++) { + if ($order[$i] eq $id) { return $i; } + } +# not found + return undef; +} + +# +# Set name of a category +# +sub set_category_name { + my ($cangrade,$id,$name,%categories)=@_; + unless ($cangrade) { return %categories; } + $categories{$id.'_name'}=$name; + return %categories; +} + +# +# Set total of a category +# +sub set_category_total { + my ($cangrade,$id,$totaltype,$total,%categories)=@_; + unless ($cangrade) { return %categories; } + if (($categories{$id.'_total'} eq '') && ($total=~/\d/)) { + $totaltype='typein'; + } + $categories{$id.'_totaltype'}=$totaltype; + if ($totaltype eq 'default') { + $categories{$id.'_total'}=''; + } else { + $total=~s/\D//gs; + unless ($total) { $total=0; } + $categories{$id.'_total'}=$total; + } + return %categories; +} + +sub set_category_weight { + my ($cangrade,$id,$weight,%categories)=@_; + unless ($cangrade) { return %categories; } + $weight=~s/\D//gs; + unless ($weight) { $weight=0; } + $categories{$id.'_weight'}=$weight; + return %categories; +} + +sub set_category_displayachieved { + my ($cangrade,$id,$value,%categories)=@_; + unless ($cangrade) { return %categories; } + unless (($value eq 'percent') || ($value eq 'points')) { $value='percent'; } + $categories{$id.'_displayachieved'}=$value; + return %categories; +} + + +# +# === end category-related +# +# # Pass this two refs to arrays for the start and end color, and a number # from 0 to 1 for how much of the latter you want to mix in. It will # return a string ready to show ("#FFC309"); 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.