'); }
+
+ 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)=@_;
+ my ($r,$cangrade,$perc)=@_;
+ $r->print(&Apache::loncommon::start_data_table_row());
+ if ($cangrade) {
+ $r->print('
');
}
+sub numberout {
+ my ($number)=@_;
+ my $printout=sprintf("%.3f", $number);
+ $printout=~s/0+$//;
+ $printout=~s/\.$//;
+ return $printout;
+}
#
# Make one new category
#
@@ -573,10 +931,171 @@ sub make_new_category {
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
#
@@ -628,13 +1147,51 @@ sub current_pos_category {
# Set name of a category
#
sub set_category_name {
- my ($canedit,$id,$name,%categories)=@_;
- unless ($canedit) { return %categories; }
+ 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
#
#
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.
