--- loncom/interface/lonquickgrades.pm 2020/09/08 04:24:18 1.49.6.6.2.1 +++ loncom/interface/lonquickgrades.pm 2011/06/01 21:32:50 1.97 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Quick Student Grades Display # -# $Id: lonquickgrades.pm,v 1.49.6.6.2.1 2020/09/08 04:24:18 raeburn Exp $ +# $Id: lonquickgrades.pm,v 1.97 2011/06/01 21:32:50 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,13 +29,12 @@ package Apache::lonquickgrades; use strict; -use Apache::Constants qw(:common :http REDIRECT); +use Apache::Constants qw(:common :http); use POSIX; use Apache::loncommon; use Apache::lonlocal; use Apache::lonnet; use Apache::grades; -use Apache::lonuserstate; sub handler { my $r = shift; @@ -58,95 +57,31 @@ sub real_handler { return OK; } - my $cangrade=&Apache::lonnet::allowed('mgr'); - my $showPoints = - $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard'; + # Send header, don't cache this page + &Apache::loncommon::no_cache($r); + $r->send_http_header; - my $reinitresult; + my $showPoints = + (($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'standard') + || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories')); + 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'; - 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; - } - } - } - 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.').'
'. - '
'; - my %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); - } - } - } - - 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 $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}) + ); - &startGradeScreen($r); + &startGradeScreen($r,'quick'); + my $cangrade=&Apache::lonnet::allowed('mgr'); # # Pick student # @@ -158,16 +93,12 @@ ENDCLOSE 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]; + $uname=(&Apache::lonnet::idget($udom,$stdid))[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'); @@ -175,63 +106,95 @@ ENDCLOSE $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]' ,'' ,' ' - ,$chooseopt). - '  

'); + ,$chooseopt).'
'. + '

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

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

'); } - } else { - $r->print('

'.&mt('This may take a few moments to display.').'

'); } $r->rflush(); - my $notshowTotals= - $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'; - - my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts, - $topLevelRight,$topLevelAttempted) = &getData($showPoints,$uname,$udom); + my ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted)= + &getData($showPoints,$uname,$udom); - if (ref($navmap)) { - &outputTable($r,$showPoints,$notshowTotals,$navmap,$totalParts,$totalPossible, - $totalRight,$totalAttempted,$topLevelParts,$topLevelRight, - $topLevelAttempted); + if ($showCategories) { + &outputCategories($r,$showPoints,$notshowTotals, + $navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted); } else { - 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; + &outputTable($r,$showPoints,$notshowTotals, + $navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted); } 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 startGradeScreen { + my ($r,$mode)=@_; + + 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') + || ($env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories')); + my $notshowTotals= + $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'externalnototals'; + my $showCategories= + $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'categories'; + + my $allowed_to_view = &Apache::lonnet::allowed('vgr',$env{'request.course.id'}); + my $allowed_to_edit = &Apache::lonnet::allowed('mgr',$env{'request.course.id'}); + + if ($allowed_to_view) { + my @notes; + push(@notes,&mt('Students do not see total points.')) if ($notshowTotals); + 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, &Apache::lonhtmlcommon::coursepreflink(&mt('Grade display settings'),'grading')); + $r->print(&Apache::loncommon::head_subbox(join('  ',@notes))); + } + + + $r->print("\n".''."\n"); + $r->print('
'); +} + +sub endGradeScreen { + my ($r)=@_; + $r->print('
'.&Apache::loncommon::end_page()); } -# -# Go through the complete course and collect data -# sub getData { @@ -240,17 +203,13 @@ sub getData { # 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 @@ -283,11 +242,12 @@ sub getData { my $stack = $iterator->getStack(); for my $part (@{$parts}) { + my $completionStatus = $curRes->getCompletionStatus($part); my $dateStatus = $curRes->getDateStatus($part); my $weight = $curRes->weight($part); my $problemstatus = $curRes->problemstatus($part); - if ($curRes->solved($part) eq 'excused') { + if ($completionStatus == $curRes->EXCUSED()) { next; } if ($showPoints) { @@ -309,8 +269,12 @@ sub getData { $totalRight += $score; $partsCount += $weight; + $curRes->{DATA}->{PROB_SCORE} += $score; + $curRes->{DATA}->{PROB_WEIGHT} += $weight; + if ($curRes->opendate($part) < $now) { $totalPossible += $weight; + $curRes->{DATA}->{PROB_POSSIBLE} += $weight; } $totalParts += $weight; } else { @@ -359,8 +323,7 @@ sub getData { } $curRes = $iterator->next(); } - return ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted, - $topLevelParts,$topLevelRight,$topLevelAttempted); + return ($navmap,$totalParts,$totalPossible,$totalRight,$totalAttempted,$topLevelParts,$topLevelRight,$topLevelAttempted); } # @@ -369,8 +332,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); @@ -455,85 +418,754 @@ 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"); - $r->print(&Apache::loncommon::start_data_table_row() + $title = $showPoints ? "Points" : "Parts Done"; + my $totaltitle = $showPoints ? &mt("Awarded Total Points") : &mt("Total Parts Done"); + $r->print(&Apache::loncommon::start_data_table_row() .''.$totaltitle.': '.$totalRight.'
'); - $r->print(&mt('Max Possible To Date')." $maxHelpLink: $totalPossible
"); - $title = $showPoints ? "Points" : "Parts"; - $r->print(&mt("Total $title In Course").': '.$totalParts.'' + $r->print(&mt('Max Possible To Date')." $maxHelpLink: $totalPossible
"); + $title = $showPoints ? "Points" : "Parts"; + $r->print(&mt("Total $title In Course").': '.$totalParts.'' .&Apache::loncommon::end_data_table_row()); } $r->print(&Apache::loncommon::end_data_table()); - return; } -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}) - ); +# +# === 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 { + + my ($r,$showPoints,$notshowTotals, + $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,%categories); +# + if ($cangrade) { + $r->print(&Apache::loncommon::resourcebrowser_javascript(). + ''. + ''. + ''. + ''. + ''); + } +# +# Debug +# +# my %data=&dumpdata($navmap); +# foreach (keys(%data)) { +# $r->print("\n
".$_.'='.$data{$_}); +# } +# my @debugarray=('5:1','4:3','1:1','5:5','6:7'); +# $r->print("Array: ".join(',',@debugarray).'
'); +# $r->print("0,0,0: ".join(',',&drop(0,0,0,@debugarray)).'
'); +# $r->print("1,0,0: ".join(',',&drop(1,0,0,@debugarray)).'
'); +# $r->print("0,1,0: ".join(',',&drop(0,1,0,@debugarray)).'
'); +# $r->print("1,1,0: ".join(',',&drop(1,1,0,@debugarray)).'
'); +# +# $r->print("0,0,2: ".join(',',&drop(0,0,2,@debugarray)).'
'); +# $r->print("1,0,2: ".join(',',&drop(1,0,2,@debugarray)).'
'); +# $r->print("0,1,2: ".join(',',&drop(0,1,2,@debugarray)).'
'); +# $r->print("1,1,2: ".join(',',&drop(1,1,2,@debugarray)).'
'); +# +# $r->print("0,0,4: ".join(',',&drop(0,0,4,@debugarray)).'
'); +# $r->print("1,0,4: ".join(',',&drop(1,0,4,@debugarray)).'
'); +# $r->print("0,1,4: ".join(',',&drop(0,1,4,@debugarray)).'
'); +# $r->print("1,1,4: ".join(',',&drop(1,1,4,@debugarray)).'
'); +# +# $r->print("0,0,5: ".join(',',&drop(0,0,5,@debugarray)).'
'); +# $r->print("1,0,5: ".join(',',&drop(1,0,5,@debugarray)).'
'); +# $r->print("0,1,5: ".join(',',&drop(0,1,5,@debugarray)).'
'); +# $r->print("1,1,5: ".join(',',&drop(1,1,5,@debugarray)).'
'); +# +# $r->print("0,0,7: ".join(',',&drop(0,0,7,@debugarray)).'
'); +# $r->print("1,0,7: ".join(',',&drop(1,0,7,@debugarray)).'
'); +# $r->print("0,1,7: ".join(',',&drop(0,1,7,@debugarray)).'
'); +# $r->print("1,1,7: ".join(',',&drop(1,1,7,@debugarray)).'
'); + } -sub startGradeScreen { - my ($r)=@_; +# +# Get data for all symbs +# - 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 $showSPRSlink = - $env{'course.'.$env{'request.course.id'}.'.grading'} eq 'spreadsheet'; +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 +# - 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'}"); +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); } - 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'}"); +# 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; +} - if ($allowed_to_view) { - my @notes; - push(@notes,&mt('Students do not see total points.')) if ($notshowTotals); - 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 link to spreadsheet.')) if ($showSPRSlink); - push(@notes,&Apache::lonhtmlcommon::coursepreflink(&mt('Grade display settings'),'grading')); - $r->print(&Apache::loncommon::head_subbox(join('  ',@notes))); - } elsif (!$allowed_to_edit) { - if (!$showPoints && !$notshowSPRSlink ) { - $r->print(&Apache::loncommon::head_subbox( - &mt('This screen shows how many problems (or problem parts) you have completed' - .', and how many you have not yet done.' - .' You can also look at [_1]a detailed score sheet[_2].' - ,'',''))); +# +# Output the table +# + +sub output_category_table { + my ($r,$cangrade,$navmaps,%categories)=@_; + + my $totalweight=0; + my $totalpoints=0; + + $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,1,%categories); + unless ($possible) { next; } + $totalpoints+=$weight*$correct/$possible; + $totalweight+=$weight; + } +# + my $perc=0; + if ($totalweight) { $perc=100.*$totalpoints/$totalweight; } + + &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)=@_; + + my $iconpath = &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL') . "/"); + my %lt=&Apache::lonlocal::texthash( + 'up' => 'Move Up', + 'dw' => 'Move Down'); + if ($output) { $r->print("\n".&Apache::loncommon::start_data_table_row()); } + + if ($output && $cangrade) { + $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(''); + 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(''); + 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); } -sub endGradeScreen { - my ($r)=@_; - $r->print(&Apache::loncommon::end_page()); - return; +# +# 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"); + sub mixColors { my $start = shift; my $end = shift; 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.