Skip to content
Browse files

release 3.1.5; performance improvements when adding a new assignment

  • Loading branch information...
1 parent e68f0db commit 9af37e616336e6946686d2d436cc7c3b19159f22 Ben Crowell committed
Showing with 79 additions and 36 deletions.
  1. +2 −0 BrowserWindow.pm
  2. +7 −10 Fun.pm
  3. +62 −15 GradeBook.pm
  4. +1 −1 Makefile
  5. +5 −8 ServerDialogs.pm
  6. +1 −1 ServerOG.cgi
  7. +1 −1 Version.pm
View
2 BrowserWindow.pm
@@ -316,7 +316,9 @@ BEGIN {
# only whitespace, erroneous input with bogus characters in it. The following regex checks whether it contains
# only digits and dots, contains no more than one dot, and contains at least one digit. Can also have the
# optional x on the end for extra credit, but that's already been stripped off. A minus sign on the front is also OK.
+ #
# at least 1 digit sign, then only digits and dots not more than one dot
+ # ---------------- ------------------------------- ---------------------
my $old_was_numeric = ($gv =~ m/[0-9]/) && ($gv =~ m/^\-?[0-9\.]+$/) && !($gv =~ m/\..*\./);
my $new_is_numeric = ($grade =~ m/[0-9]/) && ($grade =~ m/^\-?[0-9\.]+$/) && !($grade =~ m/\..*\./);
# Nonnumeric input can be ok, but only in the special case of a blank grade or a nonnumeric type:
View
17 Fun.pm
@@ -245,10 +245,12 @@ sub server_list_work_filter_bit_string {
$stuff, # list of raw problems, in this format: file=lm&book=1&chapter=0&problem=5
) = @_;
- # kludge: In WorkFile.pm, in spotter, used by SpotterOG, we sort all the raw html query keys in string sort order, with the find=.
- # Therefore, we have to construct a similar list @order here, but with the find= eliminated.
- # Is this unnecessary? May actually be sorted already.
- my @x = sort @$stuff;
+ # Construct a list of raw html query keys, eliminating duplications.
+ # I used to start this off with my @x = sort @$stuff;, because I thought WorkFile.pm used raw string sort order, so it was necessary to duplicate that.
+ # That definitely caused a bug, where, e.g., if problem 3 and problem 11 were both assigned, students got scored on the wrong problems
+ # because 11 came before 3 in string sort order. Eliminating the sort seems to have fixed the bug, but I'm still a little unsure of whether that
+ # could cause a bug somewhere else.
+ my @x = @$stuff;
my %y = ();
my @order = ();
foreach my $x(@x) {
@@ -257,12 +259,7 @@ sub server_list_work_filter_bit_string {
$y{$x} = 1;
}
}
- if (scalar(@order)!=length($scores)) {
- print "in Fun::server_list_work_filter_bit_string, length mismatch between order, ".scalar(@order).", and scores, \"$scores\",".length($scores)."\n";
- #foreach my $x(@order) {print " $x\n"}
- #ExtraGUI::error_message("in Fun::server_list_work_filter_bit_string, length mismatch between order, ".scalar(@order).", and scores, \"$scores\",".length($scores))
-
-}
+ if (scalar(@order)!=length($scores)) {die "in Fun::server_list_work_filter_bit_string, length mismatch between order, ".scalar(@order).", and scores, \"$scores\",".length($scores)."\n" }
my $filtered = '';
for (my $i=0; $i<length($scores); $i++) {
View
77 GradeBook.pm
@@ -21,6 +21,8 @@ Basically the internal structure is flatter than the file structure, and some
things that are really hashes are maintained as strings of the form "key:value","key:value",...
See comments above hashify() for more details, and for thoughts on neatening this up.
+Undo:
+
A subset of this package's write methods is designated as the "user-write" API. Criteria for inclusion in the user-write API:
Should be user-initiated at least sometimes; should modify the gb; should modify it in a way that can be reflected with hashify();
should be something the user does directly, not an indirect consequence; shouldn't be a private method; should be a method, i.e., invoked as $gb->method().
@@ -1334,14 +1336,23 @@ sub undo {
return if @$a<2 || (@$a==2 && $self->{UNDO_STACK_OVERFLOWED});
my $undone = pop @$a;
my $stuff = $a->[-1];
+ my $completed = 0;
if (exists $stuff->{'set_grades_on_assignment_shortcut'}) {
my $shortcut = $undone->{'set_grades_on_assignment_shortcut'};
$self->{PREVENT_UNDO} = 1;
- #print STDERR "doing shortcut for undo, $shortcut->{'cat'},$shortcut->{'ass'},$shortcut->{'student'},$shortcut->{'old'}\n";
$self->set_grades_on_assignment(CATEGORY=>$shortcut->{'cat'},ASS=>$shortcut->{'ass'},GRADES=>{$shortcut->{'student'}=>$shortcut->{'old'}});
$self->{PREVENT_UNDO} = 0;
+ $completed = 1;
}
- else {
+ if (exists $stuff->{'add_assignment_shortcut'}) {
+ my $shortcut = $undone->{'add_assignment_shortcut'};
+ $self->{PREVENT_UNDO} = 1;
+ #print STDERR "doing shortcut for undo, $shortcut->{'cat'},$shortcut->{'ass'}\n";
+ $self->delete_assignment((CATEGORY=>$shortcut->{'cat'}).".".(ASS=>$shortcut->{'ass'}));
+ $self->{PREVENT_UNDO} = 0;
+ $completed = 1;
+ }
+ if (!$completed) { # not an undo of a method that has a shortcut
my $json = $stuff->{'state'};
return unless $json;
my $h;
@@ -1381,6 +1392,7 @@ sub user_write_api {
{
# Set up undo functionality.
my $done = 0;
+ my %has_shortcut = ('set_grades_on_assignment'=>1,'add_assignment'=>1);
sub set_up_undo {
# We set $gb->{PREVENT_UNDO}=1 initially when we create a gb object, because any calls to write methods are just initializations, not user-initiated edits.
# We only set $gb->{PREVENT_UNDO}=0 when the user clicks on a menu or types in a score, as detected by BrowserWindow::menu_bar() Roster::key_pressed_in_scores().
@@ -1408,19 +1420,31 @@ sub user_write_api {
# special-case set_grades_on_assignment for efficiency
my $shortcut = 0;
my %shortcut_data = ();
- if ($could_save && $name eq 'set_grades_on_assignment') {
- my @x = @_;
- shift @x;
- my %x = (@x,);
- my $grades = $x{GRADES};
- if (scalar(keys %$grades)==1) {
+ # Check whether it's a method on the list of those that we might be able to do a shortcut on. Even if is, that doesn't
+ # mean we will actually do the shortcut method. If we actually do, we set the $shortcut flag.
+ if ($could_save && exists $has_shortcut{$name}) {
+ if ($name eq 'set_grades_on_assignment') {
+ # Shortcut for setting exactly one grade (which is what happens when the use is using the GUI).
+ my @x = @_; # $gb,%args
+ shift @x; # gobble $gb
+ my %x = (@x,); # args
+ my $grades = $x{GRADES};
+ if (scalar(keys %$grades)==1) {
+ $shortcut = 1;
+ my @k = keys (%$grades);
+ $shortcut_data{'student'} = $k[0];
+ $shortcut_data{'cat'} = $x{CATEGORY};
+ $shortcut_data{'ass'} = $x{ASS};
+ $shortcut_data{'old'} = $self->get_current_grade($shortcut_data{'student'},$shortcut_data{'cat'},$shortcut_data{'ass'});
+ }
+ }
+ if ($name eq 'add_assignment') {
+ my @x = @_; # $gb, %args
+ shift @x; # gobble $gb
+ my %x = (@x,); # args
$shortcut = 1;
- my @k = keys (%$grades);
- $shortcut_data{'student'} = $k[0];
$shortcut_data{'cat'} = $x{CATEGORY};
$shortcut_data{'ass'} = $x{ASS};
- $shortcut_data{'old'} = $self->get_current_grade($shortcut_data{'student'},$shortcut_data{'cat'},$shortcut_data{'ass'});
- #print STDERR "student=",$shortcut_data{'student'},",cat=",$shortcut_data{'cat'},",ass=",$shortcut_data{'ass'},",old=",$shortcut_data{'old'},"\n";
}
}
if (wantarray) {@result = &$c(@_)} else {$result = &$c(@_)}
@@ -1438,7 +1462,7 @@ sub user_write_api {
# if changing the structure of the $undo hash below, change it above in misc_initialization() as well
my $undo = {'state'=>$json,'sub'=>$name,'describe'=>$self->describe_operation($name,@_)}; # $json may be undef if it's set_grades_on_assignment
if ($shortcut) {
- $undo->{'set_grades_on_assignment_shortcut'} = \%shortcut_data;
+ $undo->{"${name}_shortcut"} = \%shortcut_data;
}
push @$a,$undo;
if (@$a>100) {splice @$a,1,1; $self->{UNDO_STACK_OVERFLOWED}=1} # prevent undo stack from growing arbitrarily large
@@ -1577,9 +1601,9 @@ sub set_grades_on_assignment {
my $new_grades = $args{GRADES};
my $grades = $self->grades_private_method();
while (my ($student,$score) = each(%$new_grades)) {
- #print "set_grades_on_assignment $ass,$student,$score\n";
my $c = $student.".".$category;
my $record = "\"$ass:$score\"";
+ $score=~s/x$//i; # get rid of trailing x that just means extra credit
if (exists($grades->{$c})) {
$grades->{$c} = set_property($grades->{$c},$ass,$score);
}
@@ -1870,13 +1894,36 @@ sub use_defaults_for_assignments {
if (first_part_of_label($a) eq $c) {
my $ap = $self->assignment_properties($a);
my %ap = %$ap;
+ my %old_ap = %ap;
%ap = (%cp,%ap); # merge the hashes
- $self->assignment_properties($a,\%ap);
+ if (hashes_not_equal(\%old_ap,\%ap)) {
+ # Without the test above, this was a huge pig in terms of performance, due to undo functionality.
+ $self->assignment_properties($a,\%ap);
+ }
}
}
}
}
+# The follownig assumes that all values are scalars, dies if they're not.
+sub hashes_not_equal {
+ my $h1 = shift; # hash ref
+ my $h2 = shift; # hash ref
+ my @k1 = keys %$h1;
+ my @k2 = keys %$h2;
+ if (@k1 != @k2) {return 1} # test equality of number of keys first, since it's efficient
+ @k1 = sort @k1;
+ @k2 = sort @k2;
+ for (my $i=0; $i<@k1; $i++) {
+ if ($k1[$i] ne $k2[$i]) {return 1}
+ my $v1 = $h1->{$k1[$i]};
+ my $v2 = $h2->{$k2[$i]};
+ die "non-scalar value in hashes_not_equal" if ((ref $v1) || (ref $v2));
+ if ($v1 ne $v2) {return 1} # string comparison works for both numbers and strings
+ }
+ return 0;
+}
+
=head3 strip_redundant_properties
First argument is the assignment key. Second argument is its list of properties.
View
2 Makefile
@@ -1,4 +1,4 @@
-VERSION = 3.1.4
+VERSION = 3.1.5
# ... When changing this version number, make sure to change the one in Version.pm as well.
prefix=/usr
View
13 ServerDialogs.pm
@@ -64,6 +64,7 @@ sub server {
local $Words::words_prefix = "b.server";
my $gb = $self->{DATA}->{GB};
my $prefs = $gb->preferences();
+ # ...this sometimes comes back as undef...why?
my $recent_dir = $prefs->get('recent_directory');
my $server_domain = $prefs->get('server_domain');
my $server_user = $prefs->get('server_user');
@@ -380,13 +381,11 @@ sub list_work {
# n_parts = number of parts on list
# See TODO file for some more testing that I should do.
my $individualized = 0;
+
+ # If using howdy and selected a particular assignment, then infer due date, and set up filter.
if (-d $sets_dir) { # This only happens for me when I'm using howdy.
- #print "sets_dir = $sets_dir\n";
- #print "list=\n$list\n";
- #print "inferring hw set =$set=, based on a=$a=, ass=$ass=\n";
- if ($set=~/\d+/) {
+ if ($set=~/\d+/) { # selected a particular assignment
foreach my $f(<$sets_dir/due*.csv>) { # can have more than one sets file associated with a gb, e.g., for 205 and 210 in same gb file
- #print "opening file $f to find due date\n";
open(F,"<$f") or ExtraGUI::error_message("error opening file $f for input");
while (my $line=<F>) {
if ($line=~/(\d+),(\d+\-\d+\-\d+)/ && $1==$set) {
@@ -397,9 +396,7 @@ sub list_work {
}
close F;
}
- #print "due date is $due\n";
foreach my $f(<$sets_dir/sets*.csv>) { # can have more than one sets file associated with a gb, e.g., for 205 and 210 in same gb file
- #print "opening file $f to find list of problems\n";
open(F,"<$f") or ExtraGUI::error_message("error opening file $f for input");
while (my $line=<F>) {
if ($line=~/(\d+),(\d*),(\d+),(\d+),([a-z]*),([^,]*),([^,]*),([^,\n]*)/ && $1==$set) {
@@ -428,7 +425,7 @@ sub list_work {
}
close F;
}
- }
+ } # end if selected a particular assignment
}
$f1->Label(-text=>'due date')->pack(-side=>'left');
View
2 ServerOG.cgi
@@ -196,7 +196,7 @@ if ($request->{VALID}) {
else {
$this_one_failed = 1;
$this_one_succeeded = 0;
- $err = "error for recipient $recipient: doesn't exist in roster, or unable to append to file $msgs/$recipient";
+ $err = " error for recipient $recipient: doesn't exist in roster, or unable to append to file $msgs/$recipient, or recipient's account is disabled";
} # open to append; create if necessary
#----- Email it as well:
View
2 Version.pm
@@ -11,7 +11,7 @@
package Version;
sub version {
- return "3.1.4";
+ return "3.1.5";
}
sub default_hash_function {

0 comments on commit 9af37e6

Please sign in to comment.
Something went wrong with that request. Please try again.