openwebwork-cvs — WeBWorK CVS activity

[WWcvs] webwork-modperl: Added a missing start_form and hidden authentication.

[Mike G. v. a. <we...@ma...>]

Log Message:
-----------
Added a missing start_form and hidden authentication.  These had been
dropped in a recent revision.

This closes bug #806

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator:
        ProblemSets.pm

Revision Data
-------------
Index: ProblemSets.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/ProblemSets.pm,v
retrieving revision 1.59
retrieving revision 1.60
diff -Llib/WeBWorK/ContentGenerator/ProblemSets.pm -Llib/WeBWorK/ContentGenerator/ProblemSets.pm -u -r1.59 -r1.60
--- lib/WeBWorK/ContentGenerator/ProblemSets.pm
+++ lib/WeBWorK/ContentGenerator/ProblemSets.pm
@@ -177,7 +177,11 @@
 	my $statusHeader = $sort eq "status"
 		? CGI::u("Status")
 		: CGI::a({href=>$self->systemLink($urlpath, params=>{sort=>"status"})}, "Status");
+# print the start of the form
 
+    print CGI::start_form(-method=>"POST",-action=>$actionURL),
+          $self->hidden_authen_fields;
+    
 # and send the start of the table 
 	print CGI::start_table();
 	if ( ! $existVersions ) {

[WWcvs] webwork-modperl: Fixed bug for problem library version 2 - now it can

[jj v. a. <we...@ma...>]

Log Message:
-----------
Fixed bug for problem library version 2 - now it can select problems from
all sections, or all chapters and all sections, etc.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/Utils:
        ListingDB.pm

Revision Data
-------------
Index: ListingDB.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils/ListingDB.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/WeBWorK/Utils/ListingDB.pm -Llib/WeBWorK/Utils/ListingDB.pm -u -r1.7 -r1.8
--- lib/WeBWorK/Utils/ListingDB.pm
+++ lib/WeBWorK/Utils/ListingDB.pm
@@ -154,39 +154,43 @@
 
 	my $dbh = getDB($ce);
 
+	my $subjstring = '';
+	if($subj) {
+		$subj =~ s/'/\\'/g;
+		$subjstring = " AND t.name=\"$subj\" ";
+	}
 	my $chapstring = '';
 	if($chap) {
 		$chap =~ s/'/\\'/g;
-		$chap = '"'.$chap.'"';
+		$chapstring = " AND c.name=\"$chap\" ";
 	}
 	my $secstring = '';
 	if($sec) {
 		$sec =~ s/'/\\'/g;
-		$sec = '"'.$sec.'"';
+		$secstring = " AND s.name=\"$sec\" ";
 	}
 
 	my $query = "SELECT DBsection_id 
-				FROM DBsection s, DBchapter c 
-				WHERE c.name = $chap AND s.name = $sec";
-	my $section_id = $dbh->selectrow_array($query);
-	die "getDBSectionListings - no such section: $chap $sec\n" unless(defined $section_id);
-
+				FROM DBsection s, DBchapter c, DBsubject t 
+				WHERE t.DBsubject_id = c.DBsubject_id 
+                and s.DBchapter_id = c.DBchapter_id 
+                $subjstring $chapstring $secstring";
+	my $section_id_ref = $dbh->selectall_arrayref($query);
+	die "getDBSectionListings - no such section: $chap $sec\n" unless(defined $section_id_ref);
+	my @section_ids = @{$section_id_ref};
+	@section_ids = map { "DBsection_id = ". $_->[0] } @section_ids;
 	my @results; #returned
 	$query = "SELECT path_id, filename
-		FROM pgfile
-		WHERE DBsection_id = $section_id";
+		FROM pgfile WHERE ". join(" OR ", @section_ids);
 	my $sth = $dbh->prepare($query);
 
 	$sth->execute();
 	while (1){
 		my ($path_id, $pgfile) = $sth->fetchrow_array();
-		if (!defined($pgfile)){
-			last;
-		}else{
-			my $path = $dbh->selectrow_array("SELECT path FROM path 
+		last if (!defined($pgfile));
+		my $path = $dbh->selectrow_array("SELECT path FROM path 
 						WHERE path_id = $path_id");
-			push @results, {"path" => $path, "filename" => $pgfile};
-		}
+		push @results, {"path" => $path, "filename" => $pgfile};
 	}
 	return @results;
 }

[WWcvs] webwork-modperl: Changed column label of Id to Login Name to be

[jj v. a. <we...@ma...>]

Log Message:
-----------
Changed column label of Id to Login Name to be consistent with other pages.
Also aligned the headers to top, which looks nicer if needed for a narrow
browser window.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
        UsersAssignedToSet.pm

Revision Data
-------------
Index: UsersAssignedToSet.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Llib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm -Llib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm -u -r1.16 -r1.17
--- lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm
@@ -132,7 +132,7 @@
 	);
 				        
 	print CGI::start_table({});
-	print CGI::Tr(CGI::th(["Assigned","ID"," ","Student Name"," ","Section"," ","Due Date"]));
+	print CGI::Tr({-valign=>"top"}, CGI::th(["Assigned","Login Name"," ","Student Name"," ","Section"," ","Due Date"]));
 	print CGI::Tr(CGI::td([CGI::hr(),CGI::hr(),"",CGI::hr(),"",CGI::hr(),"",CGI::hr()," "]));
 
 	# get user records

[WWcvs] webwork-modperl: More changes for problem library version 2: changed

[jj v. a. <we...@ma...>]

Log Message:
-----------
More changes for problem library version 2: changed interface for getting
lists of problems so variable amounts of data can be passed.  Also removed
an unneeded button.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
        SetMaker.pm

Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.43
retrieving revision 1.44
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.43 -r1.44
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -493,15 +493,14 @@
 					            -default=> $subject_selected,
 					             -onchange=>"submit();return true"
 				),
-				CGI::submit(-name=>"lib_select_subject", -value=>"Update Chapter List")])),
+				CGI::submit(-name=>"lib_select_subject", -value=>"Update Chapter/Section Lists")])),
 		CGI::Tr(
 			CGI::td(["Chapter:",
 				CGI::popup_menu(-name=> 'library_chapters', 
 					            -values=>\@chaps,
 					            -default=> $chapter_selected,
 					             -onchange=>"submit();return true"
-				),
-				CGI::submit(-name=>"lib_select_chapter", -value=>"Update Section List")])),
+		)])),
 		CGI::Tr(
 			CGI::td("Section:"),
 			CGI::td({-colspan=>2},
@@ -871,11 +870,7 @@
 	} elsif ($r->param('lib_view')) {
  
 		@pg_files=();
-		my $chap = $r->param('library_chapters') || "";
-		$chap = "" if($chap eq "All Chapters");
-		my $sect = $r->param('library_sections') || "";
-		$sect = "" if($sect eq "All Sections");
-		my @dbsearch = WeBWorK::Utils::ListingDB::getSectionListings($r->{ce}, "$chap", "$sect");
+		my @dbsearch = WeBWorK::Utils::ListingDB::getSectionListings($r, subject_default => 'All Subjects', chapter_default => 'All Chapters', section_default=>'All Sections');
 		my ($result, $tolibpath);
 		for $result (@dbsearch) {
 			$tolibpath = "Library/$result->{path}/$result->{filename}";

[WWcvs] webwork-modperl: More changes for problem library version 2.

[jj v. a. <we...@ma...>]

Log Message:
-----------
More changes for problem library version 2.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/Utils:
        ListingDB.pm

Revision Data
-------------
Index: ListingDB.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils/ListingDB.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/WeBWorK/Utils/ListingDB.pm -Llib/WeBWorK/Utils/ListingDB.pm -u -r1.6 -r1.7
--- lib/WeBWorK/Utils/ListingDB.pm
+++ lib/WeBWorK/Utils/ListingDB.pm
@@ -148,6 +148,7 @@
 sub getDBsectionListings {
 
 	my $ce = shift;
+	my $subj = shift;
 	my $chap = shift;
 	my $sec = shift;
 
@@ -362,12 +363,17 @@
 # if section is omitted, get all from the chapter
 sub getSectionListings	{
 	#print STDERR "ListingDB::getSectionListings(chapter,section)\n";
-	my $ce = shift;
-	my $chap = shift;
-	my $sec = shift;
+	my $r = shift;
+	my %defaults = @_;
+	my $ce = $r->ce;
+	my $subj = $r->param('library_subjects') || "";
+	my $chap = $r->param('library_chapters') || "";
+	my $sec = $r->param('library_sections') || "";
+	$subj = '' if ($subj eq $defaults{subject_default});
+	$chap = '' if ($chap eq $defaults{chapter_default});
+	$sec = '' if ($sec eq $defaults{section_default});
 	my $version = $ce->{problemLibrary}->{version} || 1;
-	if($version == 2) { return(getDBsectionListings($ce, $chap, $sec))}
-
+	if($version == 2) { return(getDBsectionListings($ce, $subj, $chap, $sec))}
 
 	my $chapstring = '';
 	if($chap) {

[WWcvs] webwork-modperl: Changes for problem library version 2 to support recent

[jj v. a. <we...@ma...>]

Log Message:
-----------
Changes for problem library version 2 to support recent change to setmaker.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/Utils:
        ListingDB.pm

Revision Data
-------------
Index: ListingDB.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils/ListingDB.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/WeBWorK/Utils/ListingDB.pm -Llib/WeBWorK/Utils/ListingDB.pm -u -r1.5 -r1.6
--- lib/WeBWorK/Utils/ListingDB.pm
+++ lib/WeBWorK/Utils/ListingDB.pm
@@ -26,9 +26,10 @@
 	$VERSION		=1.0;
 	@ISA		=qw(Exporter);
 	@EXPORT	=qw(
-	&createListing &updateListing &deleteListing &getAllChapters &getAllSections
-	&searchListings &getAllListings &getSectionListings
-	&getAllDBchapters &getAllDBsections &getDBsectionListings
+	&createListing &updateListing &deleteListing &getAllChapters
+	&getAllSections &searchListings &getAllListings &getSectionListings
+	&getAllDBsubjects &getAllDBchapters &getAllDBsections
+	&getDBsectionListings
 	);
 	%EXPORT_TAGS		=();
 	@EXPORT_OK		=qw();
@@ -45,6 +46,31 @@
 	return($dbh);
 }
 
+=item getAllDBsubjects($ce)                                                     
+Returns an array of DBsubject names                                             
+                                                                                
+$ce is a WeBWorK::CourseEnvironment object that describes the problem library.  
+                                                                                
+=cut                                                                            
+
+sub getAllDBsubjects {
+	my $ce = shift;
+	my @results=();
+	my ($row,$listing);
+	my $query = "SELECT DISTINCT name FROM DBsubject";
+	my $dbh = getDB($ce);
+	my $sth = $dbh->prepare($query);
+	$sth->execute();
+	while (1) {
+		$row = $sth->fetchrow_array;
+		last if (!defined($row));
+		my $listing = $row;
+		push @results, $listing;
+	}
+	return @results;
+}
+
+
 =item getAllDBchapters($ce)                                                     
 Returns an array of DBchapter names                                             
                                                                                 
@@ -54,24 +80,25 @@
 
 sub getAllDBchapters {
 	my $ce = shift;
+	my $subject = shift;
 	my @results=();
 	my ($row,$listing);
-	my $query = "SELECT DISTINCT name FROM DBchapter";
+	my $where = "";
 	my $dbh = getDB($ce);
+	if($subject) {
+		my $subject_id = "";
+		my $query = "SELECT DBsubject_id FROM DBsubject WHERE name = \"$subject\"";
+		my $subject_id = $dbh->selectrow_array($query);  
+		$where = " WHERE DBsubject_id=\"$subject_id\" ";
+	}
+	my $query = "SELECT DISTINCT name FROM DBchapter $where ";
 	my $sth = $dbh->prepare($query);
 	$sth->execute();
-	while (1)
-	{
+	while (1) {
 		$row = $sth->fetchrow_array;
-		if (!defined($row))
-		{
-			last;
-		}
-		else
-		{
-			my $listing = $row;
-			push @results, $listing;
-		}
+		last if (!defined($row));
+		my $listing = $row;
+		push @results, $listing;
 	}
 	return @results;
 }
@@ -92,7 +119,7 @@
 	my ($row,$listing);
 	my $dbh = getDB($ce);
 	my $query = "SELECT DBchapter_id FROM DBchapter
-								WHERE name = \"$chapter\" ";
+					WHERE name = \"$chapter\" ";
 	my $chapter_id = $dbh->selectrow_array($query);
 	die "ERROR - no such chapter: $chapter\n" unless(defined $chapter_id);
 	$query = "SELECT DISTINCT name FROM DBsection

[WWcvs] webwork-modperl: Mainly improvements for problem library version 2.

[jj v. a. <we...@ma...>]

Log Message:
-----------
Mainly improvements for problem library version 2.  Also removed comments
and added "Edit it" link back in for library problems.  These were not the
only read-only problems in a course, and being able to Edit it, and then
save as is pretty useful.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
        SetMaker.pm

Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.42
retrieving revision 1.43
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.42 -r1.43
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -464,10 +464,15 @@
 	my $r = $self->r;
 	my $ce = $r->ce;
 
+	my $default_subj = "All Subjects";
 	my $default_chap = "All Chapters";
 	my $default_sect = "All Sections";
 
-	my @chaps = WeBWorK::Utils::ListingDB::getAllDBchapters($ce);
+	my @subjs = WeBWorK::Utils::ListingDB::getAllDBsubjects($ce);
+	unshift @subjs, $default_subj;
+	my $subject_selected = $r->param('library_subjects') || $default_subj;
+
+	my @chaps = WeBWorK::Utils::ListingDB::getAllDBchapters($ce, $subject_selected);
 	unshift @chaps, $default_chap;
 	my $chapter_selected = $r->param('library_chapters') || $default_chap;
 
@@ -482,6 +487,14 @@
 	print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"left"}, 
 		CGI::start_table(),
 		CGI::Tr(
+			CGI::td(["Subject:",
+				CGI::popup_menu(-name=> 'library_subjects', 
+					            -values=>\@subjs,
+					            -default=> $subject_selected,
+					             -onchange=>"submit();return true"
+				),
+				CGI::submit(-name=>"lib_select_subject", -value=>"Update Chapter List")])),
+		CGI::Tr(
 			CGI::td(["Chapter:",
 				CGI::popup_menu(-name=> 'library_chapters', 
 					            -values=>\@chaps,
@@ -656,18 +669,15 @@
 		: CGI::div({class=>"RenderSolo"}, $pg->{body_text});
 
 
-	my $edit_link =	 '';
 	#if($self->{r}->param('browse_which') ne 'browse_library') {
 	my $problem_seed = $self->{r}->param('problem_seed') || 0;
-	if($sourceFileName !~ /^Library\//) {
-		$edit_link = CGI::a({href=>$self->systemLink(
-			$urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor",
-				courseID =>$urlpath->arg("courseID"),
-				setID=>"Undefined_Set",
-				problemID=>"1"),
-				params=>{sourceFilePath => "$sourceFileName", problemSeed=> $problem_seed}
-			)}, "Edit it" );
-	}
+	my $edit_link = CGI::a({href=>$self->systemLink(
+		 $urlpath->newFromModule("WeBWorK::ContentGenerator::Instructor::PGProblemEditor",
+			  courseID =>$urlpath->arg("courseID"),
+			  setID=>"Undefined_Set",
+			  problemID=>"1"),
+			params=>{sourceFilePath => "$sourceFileName", problemSeed=> $problem_seed}
+		  )}, "Edit it" );
 
 	my $try_link = CGI::a({href=>$self->systemLink(
 		$urlpath->newFromModule("WeBWorK::ContentGenerator::Problem",
@@ -1119,90 +1129,10 @@
 	return "";	
 }
 
-############################################## End of Body
-
-# SKEL: To emit your own HTTP header, uncomment this:
-# 
-#sub header {
-# my ($self) = @_;
-# 
-# # Generate your HTTP header here.
-# 
-# # If you return something, it will be used as the HTTP status code for this
-# # request. The Apache::Constants module might be useful for gerating status
-# # codes. If you don't return anything, the status code "OK" will be used.
-# return "";
-#}
-
-# SKEL: If you need to do any processing after the HTTP header is sent, but before
-# any template processing occurs, or you need to calculate values that will be
-# used in multiple methods, do it in this method:
-# 
-#sub initialize {
-#my ($self) = @_;
-#}
-
-# SKEL: If you need to add tags to the document <HEAD>, uncomment this method:
-# 
-#sub head {
-# my ($self) = @_;
-# 
-# # You can print head tags here, like <META>, <SCRIPT>, etc.
-# 
-# return "";
-#}
-
-# SKEL: To fill in the "info" box (to the right of the main body), use this
-# method:
-# 
-#sub info {
-# my ($self) = @_;
-# 
-# # Print HTML here.
-# 
-# return "";
-#}
-
-# SKEL: To provide navigation links, use this method:
-# 
-#sub nav {
-# my ($self, $args) = @_;
-# 
-# # See the documentation of path() and pathMacro() in
-# # WeBWorK::ContentGenerator for more information.
-# 
-# return "";
-#}
-
-# SKEL: For a little box for display options, etc., use this method:
-# 
-#sub options {
-# my ($self) = @_;
-# 
-# # Print HTML here.
-# 
-# return "";
-#}
-
-# SKEL: For a list of sibling objects, use this method:
-# 
-#sub siblings {
-# my ($self, $args) = @_;
-# 
-# # See the documentation of siblings() and siblingsMacro() in
-# # WeBWorK::ContentGenerator for more information.
-# # 
-# # Refer to implementations in ProblemSet and Problem.
-# 
-# return "";
-#}
-
 =head1 AUTHOR
 
 Written by John Jones, jj (at) asu.edu.
 
 =cut
 
-
-
 1;

[WWcvs] webwork-modperl: Initial support for version 2 of the problem library.

[jj v. a. <we...@ma...>]

Log Message:
-----------
Initial support for version 2 of the problem library.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
        SetMaker.pm

Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.41 -r1.42
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -56,7 +56,6 @@
 	'headers' => 1, 'macros' => 1, 'email' => 1,
 );
 
-##
 ## This is for searching the disk for directories containing pg files.
 ## to make the recursion work, this returns an array where the first 
 ## item is the number of pg files in the directory.	 The second is a
@@ -75,7 +74,6 @@
 ## menu).	 If it has a file called "=library-no-combine" then it is
 ## always listed as a separate directory even if it contains only one
 ## pg file.
-##
 
 sub get_library_sets {
 	my $top = shift; my $dir =	shift;
@@ -360,10 +358,11 @@
 #
 # Incoming data - current chapter, current section
 sub browse_library_panel {
-	my $self = shift;
+	my $self=shift;
 	my $r = $self->r;
 	my $ce = $r->ce;
-
+	
+	# See if the problem library is installed
 	my $libraryRoot = $r->{ce}->{problemLibrary}->{root};
 
 	unless($libraryRoot) {
@@ -371,7 +370,7 @@
 			"The problem library has not been installed.")));
 		return;
 	}
-	# Test if the Library directory exists.	 If not, try to make it
+	# Test if the Library directory link exists.  If not, try to make it
 	unless(-d "$ce->{courseDirs}->{templates}/Library") {
 		unless(symlink($libraryRoot, "$ce->{courseDirs}->{templates}/Library")) {
 			my $msg =	 <<"HERE";
@@ -385,6 +384,25 @@
 		}
 	}
 
+
+	# Now check what version we are supposed to use
+	my $libraryVersion = $r->{ce}->{problemLibrary}->{version} || 1;
+	if($libraryVersion == 1) {
+		return $self->browse_library_panel1;
+	} elsif($libraryVersion == 2) {
+		return $self->browse_library_panel2;
+	} else {
+		print CGI::Tr(CGI::td(CGI::div({class=>'ResultsWithError', align=>"center"}, 
+			"The problem library version is set to an illegal value.")));
+		return;
+	}
+}
+
+sub browse_library_panel1 {
+	my $self = shift;
+	my $r = $self->r;
+	my $ce = $r->ce;
+	
 	my $default_chap = "All Chapters";
 	my $default_sect = "All Sections";
 
@@ -441,6 +459,51 @@
 		));
 }
 
+sub browse_library_panel2 {
+	my $self = shift;
+	my $r = $self->r;
+	my $ce = $r->ce;
+
+	my $default_chap = "All Chapters";
+	my $default_sect = "All Sections";
+
+	my @chaps = WeBWorK::Utils::ListingDB::getAllDBchapters($ce);
+	unshift @chaps, $default_chap;
+	my $chapter_selected = $r->param('library_chapters') || $default_chap;
+
+	my @sects=();
+	if ($chapter_selected ne $default_chap) {
+		@sects = WeBWorK::Utils::ListingDB::getAllDBsections($ce, $chapter_selected);
+	}
+	unshift @sects, $default_sect;
+	my $section_selected =	$r->param('library_sections') || $default_sect;
+	my $view_problem_line = view_problems_line('lib_view', 'View Problems', $self->r);
+
+	print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"left"}, 
+		CGI::start_table(),
+		CGI::Tr(
+			CGI::td(["Chapter:",
+				CGI::popup_menu(-name=> 'library_chapters', 
+					            -values=>\@chaps,
+					            -default=> $chapter_selected,
+					             -onchange=>"submit();return true"
+				),
+				CGI::submit(-name=>"lib_select_chapter", -value=>"Update Section List")])),
+		CGI::Tr(
+			CGI::td("Section:"),
+			CGI::td({-colspan=>2},
+			CGI::popup_menu(-name=> 'library_sections', 
+					        -values=>\@sects,
+					        -default=> $section_selected
+		 ))),
+		 CGI::Tr(CGI::td({-colspan=>3}, $view_problem_line)),
+		 CGI::end_table(),
+	 ));
+
+	
+}
+
+
 #####	 Version 4 is the set definition file panel
 
 sub browse_setdef_panel {

[WWcvs] webwork-modperl: Update to support version 2 of the ProblemLibrary.

[jj v. a. <we...@ma...>]

Log Message:
-----------
Update to support version 2 of the ProblemLibrary.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/Utils:
        ListingDB.pm

Revision Data
-------------
Index: ListingDB.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils/ListingDB.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/WeBWorK/Utils/ListingDB.pm -Llib/WeBWorK/Utils/ListingDB.pm -u -r1.4 -r1.5
--- lib/WeBWorK/Utils/ListingDB.pm
+++ lib/WeBWorK/Utils/ListingDB.pm
@@ -335,10 +335,11 @@
 # if section is omitted, get all from the chapter
 sub getSectionListings	{
 	#print STDERR "ListingDB::getSectionListings(chapter,section)\n";
-
 	my $ce = shift;
 	my $chap = shift;
 	my $sec = shift;
+	my $version = $ce->{problemLibrary}->{version} || 1;
+	if($version == 2) { return(getDBsectionListings($ce, $chap, $sec))}
 
 
 	my $chapstring = '';

[WWcvs] webwork-modperl: Preparing for upgrading webwork part of problem library

[jj v. a. <we...@ma...>]

Log Message:
-----------
Preparing for upgrading webwork part of problem library code.  Adding a
variable for version so we can maintain backward compatibility.

Modified Files:
--------------
    webwork-modperl/conf:
        global.conf.dist

Revision Data
-------------
Index: global.conf.dist
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/conf/global.conf.dist,v
retrieving revision 1.124
retrieving revision 1.125
diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.124 -r1.125
--- conf/global.conf.dist
+++ conf/global.conf.dist
@@ -349,6 +349,10 @@
 # library is installed.
 $problemLibrary{root}        = "";
 
+# Problem Library version
+# Version 1 is in use.  Version 2 will be released soon.
+$problemLibrary{version} = "1";
+
 # The name of the SQL database containing problem metadata
 $problemLibrary{sourceSQL}   = "ProblemLibrary";
 

[WWcvs] webwork2: Update Scoring.pm to deal with versioned (gateway) sets.

[Gavin L. v. a. <we...@ma...>]

Log Message:
-----------
Update Scoring.pm to deal with versioned (gateway) sets.  For sets with 
assignment_type of 'gateway' or 'proctored_gateway' we report the user's 
score to be the score s/he attained on her or his most successful 
version of the set.

Modified Files:
--------------
    webwork2/lib/WeBWorK/ContentGenerator/Instructor:
        Scoring.pm

Revision Data
-------------
Index: Scoring.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm,v
retrieving revision 1.47
retrieving revision 1.48
diff -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -u -r1.47 -r1.48
--- lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
@@ -380,10 +380,40 @@
 	# pre-fetch user problems
 	$WeBWorK::timer->continue("pre-fetching user problems for set $setID") if defined($WeBWorK::timer);
 	my %UserProblems; # $UserProblems{$userID}{$problemID}
-	foreach my $userID (@sortedUserIDs) {
-		my %CurrUserProblems = map { $_->problem_id => $_ }
-			$db->getAllUserProblems($userID, $setID);
-		$UserProblems{$userID} = \%CurrUserProblems;
+
+  # Gateway change here: for non-gateway (non-versioned) sets, we just get each user's
+  # problems.  For gateway (versioned) sets, we get the user's best version and return
+  # that
+	if ( ! defined( $setRecord->assignment_type() ) ||
+	     $setRecord->assignment_type() !~ /gateway/ ) {
+		foreach my $userID (@sortedUserIDs) {
+			my %CurrUserProblems = map { $_->problem_id => $_ }
+				$db->getAllUserProblems($userID, $setID);
+			$UserProblems{$userID} = \%CurrUserProblems;
+		}
+	} else {  # versioned sets; get the problems for the best version 
+
+		foreach my $userID (@sortedUserIDs) {
+			my %CurrUserProblems;
+			my $numVersions = $db->getUserSetVersionNumber( $userID, $setID );
+			my $bestScore = -1;
+
+			for ( my $i=1; $i<=$numVersions; $i++ ) {
+				my %versionUserProblems = map { $_->problem_id => $_ }
+					$db->getAllUserProblems( $userID, "$setID,v$i" );
+				my $score = 0;
+				foreach ( values ( %versionUserProblems ) ) {
+					my $status = $_->status || 0;
+					my $value = $_->value || 1;
+					$score += $status*$value;
+				}
+				if ( $score > $bestScore ) {
+					%CurrUserProblems = %versionUserProblems;
+					$bestScore = $score;
+				}
+			}
+			$UserProblems{$userID} = \%CurrUserProblems;
+		}
 	}
 	$WeBWorK::timer->continue("done pre-fetching user problems for set $setID") if defined($WeBWorK::timer);
 	

[WWcvs] webwork-modperl: The two middle parts of the top area really go

[jj v. a. <we...@ma...>]

Log Message:
-----------
The two middle parts of the top area really go together, so the line between
them is now less emphatic.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
        SetMaker.pm

Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.40
retrieving revision 1.41
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.40 -r1.41
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -540,7 +540,8 @@
 		$libs,
 	));
 
-	print CGI::Tr(CGI::td({-bgcolor=>"black"}));
+	#print CGI::Tr(CGI::td({-bgcolor=>"black"}));
+	print CGI::hr();
 
 	if ($browse_which eq 'browse_local') {
 		$self->browse_local_panel($library_selected);

[WWcvs] webwork-modperl: Lots of indentation fixup, and started adding code for

[jj v. a. <we...@ma...>]

Log Message:
-----------
Lots of indentation fixup, and started adding code for new and improved
problem library.  Still compatible with current "Problem Library".

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/Utils:
        ListingDB.pm

Revision Data
-------------
Index: ListingDB.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/Utils/ListingDB.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/WeBWorK/Utils/ListingDB.pm -Llib/WeBWorK/Utils/ListingDB.pm -u -r1.3 -r1.4
--- lib/WeBWorK/Utils/ListingDB.pm
+++ lib/WeBWorK/Utils/ListingDB.pm
@@ -20,59 +20,177 @@
 
 BEGIN
 {
-  require Exporter;
-  use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
-  $VERSION		=1.0;
-  @ISA			=qw(Exporter);
-  @EXPORT	=qw(
+	require Exporter;
+	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+	
+	$VERSION		=1.0;
+	@ISA		=qw(Exporter);
+	@EXPORT	=qw(
 	&createListing &updateListing &deleteListing &getAllChapters &getAllSections
-    &searchListings &getAllListings &getSectionListings
+	&searchListings &getAllListings &getSectionListings
+	&getAllDBchapters &getAllDBsections &getDBsectionListings
 	);
-  %EXPORT_TAGS		=();
-  @EXPORT_OK		=qw();
+	%EXPORT_TAGS		=();
+	@EXPORT_OK		=qw();
 }
 use vars @EXPORT_OK;
 
 
 sub getDB {
-  my $ce = shift;
-  my $dbinfo = $ce->{problemLibrary};
-  my $dbh = DBI->connect_cached("dbi:mysql:$dbinfo->{sourceSQL}", 
-        $dbinfo->{userSQL}, $dbinfo->{passwordSQL});
-  die "Cannot connect to problem library database" unless $dbh;
-  return($dbh);
+	my $ce = shift;
+	my $dbinfo = $ce->{problemLibrary};
+	my $dbh = DBI->connect_cached("dbi:mysql:$dbinfo->{sourceSQL}", 
+				  $dbinfo->{userSQL}, $dbinfo->{passwordSQL});
+	die "Cannot connect to problem library database" unless $dbh;
+	return($dbh);
+}
+
+=item getAllDBchapters($ce)                                                     
+Returns an array of DBchapter names                                             
+                                                                                
+$ce is a WeBWorK::CourseEnvironment object that describes the problem library.  
+                                                                                
+=cut                                                                            
+
+sub getAllDBchapters {
+	my $ce = shift;
+	my @results=();
+	my ($row,$listing);
+	my $query = "SELECT DISTINCT name FROM DBchapter";
+	my $dbh = getDB($ce);
+	my $sth = $dbh->prepare($query);
+	$sth->execute();
+	while (1)
+	{
+		$row = $sth->fetchrow_array;
+		if (!defined($row))
+		{
+			last;
+		}
+		else
+		{
+			my $listing = $row;
+			push @results, $listing;
+		}
+	}
+	return @results;
+}
+
+=item getAllDBsections($ce,$chapter)                                            
+Returns an array of DBsection names                                             
+                                                                                
+$ce is a WeBWorK::CourseEnvironment object that describes the problem library.  
+$chapter is an DBchapter name                                                   
+                                                                                
+=cut                                                                            
+
+sub getAllDBsections {
+	my $ce = shift;
+	my $chapter = shift;
+	# $chapter = '"'.$chapter.'"'; # \'$chapter\' or \"$chapter\" does not work in $query anymore! wth?
+	my @results=();
+	my ($row,$listing);
+	my $dbh = getDB($ce);
+	my $query = "SELECT DBchapter_id FROM DBchapter
+								WHERE name = \"$chapter\" ";
+	my $chapter_id = $dbh->selectrow_array($query);
+	die "ERROR - no such chapter: $chapter\n" unless(defined $chapter_id);
+	$query = "SELECT DISTINCT name FROM DBsection
+								WHERE DBchapter_id = $chapter_id";
+	my $sth = $dbh->prepare($query);
+	$sth->execute();
+	while (1)
+	{
+		$row = $sth->fetchrow_array;
+		last if (!defined($row));
+		my $listing = $row;
+		push @results, $listing;
+	}
+	return @results;
+}
+
+=item getDBSectionListings($ce, $chapter, $section)                             
+Returns an array of hash references with the keys: path, filename.              
+                                                                                
+$ce is a WeBWorK::CourseEnvironment object that describes the problem library.  
+$chapter is an DBchapter name                                                   
+$section is a DBsection name                                                    
+                                                                                
+=cut                                                                            
+
+sub getDBsectionListings {
+
+	my $ce = shift;
+	my $chap = shift;
+	my $sec = shift;
+
+	my $dbh = getDB($ce);
+
+	my $chapstring = '';
+	if($chap) {
+		$chap =~ s/'/\\'/g;
+		$chap = '"'.$chap.'"';
+	}
+	my $secstring = '';
+	if($sec) {
+		$sec =~ s/'/\\'/g;
+		$sec = '"'.$sec.'"';
+	}
+
+	my $query = "SELECT DBsection_id 
+				FROM DBsection s, DBchapter c 
+				WHERE c.name = $chap AND s.name = $sec";
+	my $section_id = $dbh->selectrow_array($query);
+	die "getDBSectionListings - no such section: $chap $sec\n" unless(defined $section_id);
+
+	my @results; #returned
+	$query = "SELECT path_id, filename
+		FROM pgfile
+		WHERE DBsection_id = $section_id";
+	my $sth = $dbh->prepare($query);
+
+	$sth->execute();
+	while (1){
+		my ($path_id, $pgfile) = $sth->fetchrow_array();
+		if (!defined($pgfile)){
+			last;
+		}else{
+			my $path = $dbh->selectrow_array("SELECT path FROM path 
+						WHERE path_id = $path_id");
+			push @results, {"path" => $path, "filename" => $pgfile};
+		}
+	}
+	return @results;
 }
 
 ##############################################################################
 # input expected: keywords,<keywords>,chapter,<chapter>,section,<section>,path,<path>,filename,<filename>,author,<author>,instituition,<instituition>,history,<history>
-sub createListing
-  {
-    my $ce = shift;
-    my %listing_data = @_; 
-    my $classify_id;
-    my $dbh = getDB($ce);
- #   my $dbh = WeBWorK::ProblemLibrary::DB::getDB();
-    my $query = "INSERT INTO classify
+sub createListing {
+	my $ce = shift;
+	my %listing_data = @_; 
+	my $classify_id;
+	my $dbh = getDB($ce);
+	#	my $dbh = WeBWorK::ProblemLibrary::DB::getDB();
+	my $query = "INSERT INTO classify
 		(filename,chapter,section,keywords)
 		VALUES
 		($listing_data{filename},$listing_data{chapter},$listing_data{section},$listing_data{keywords})";
-	$dbh->do($query);    #TODO: watch out for comma delimited keywords, sections, chapters!
+	$dbh->do($query);	 #TODO: watch out for comma delimited keywords, sections, chapters!
 
-    $query = "SELECT id FROM classify WHERE filename = $listing_data{filename}";
-    my $sth = $dbh->prepare($query);
-    $sth->execute();
-    if ($sth->rows())
-    {
-        ($classify_id) = $sth->fetchrow_array;
-    }
-    else
-    {
-        #print STDERR "ListingDB::createListingPGfiles: $listing_data{filename} failed insert into classify table";
-        return 0;
-    };
+	$query = "SELECT id FROM classify WHERE filename = $listing_data{filename}";
+	my $sth = $dbh->prepare($query);
+	$sth->execute();
+	if ($sth->rows())
+	{
+		($classify_id) = $sth->fetchrow_array;
+	}
+	else
+	{
+		#print STDERR "ListingDB::createListingPGfiles: $listing_data{filename} failed insert into classify table";
+		return 0;
+	};
 
-    $query = "INSERT INTO pgfiles
+	$query = "INSERT INTO pgfiles
    (
    classify_id,
    path,
@@ -88,186 +206,175 @@
    $listing_data{institution},
    $listing_data{history}
    )";
- 
-   $dbh->do($query);
-   return 1;
-  }
+	
+	$dbh->do($query);
+	return 1;
+}
 
 ##############################################################################
 # input expected any pair of: keywords,<keywords data>,chapter,<chapter data>,section,<section data>,filename,<filename data>,author,<author data>,instituition,<instituition data>
 # returns an array of hash references
-sub searchListings
-{
-    my $ce = shift;
-    my %searchterms = @_;
-    #print STDERR "ListingDB::searchListings  input array @_\n";
-    my @results;
-    my ($row,$key);
-    my $dbh = getDB($ce);
-    my $query = "SELECT c.filename, p.path
-        FROM classify c, pgfiles p
-        WHERE c.id = p.classify_id";
-    foreach $key (keys %searchterms) {
-        $query .= " AND c.$key = $searchterms{$key}";
-    };
-    my $sth = $dbh->prepare($query);
-    $sth->execute();
-    if ($sth->rows())
-    {
-        while (1)
-        {
-            $row = $sth->fetchrow_hashref();
-            if (!defined($row))
-            {
-	            last;
-            }
-            else
-            {
-	            #print STDERR "ListingDB::searchListings(): found $row->{id}\n";
-	            my $listing = $row;
-	            push @results, $listing;
-             }
-        }
-    }
-    return @results;
+sub searchListings {
+	my $ce = shift;
+	my %searchterms = @_;
+	#print STDERR "ListingDB::searchListings  input array @_\n";
+	my @results;
+	my ($row,$key);
+	my $dbh = getDB($ce);
+	my $query = "SELECT c.filename, p.path
+		FROM classify c, pgfiles p
+		WHERE c.id = p.classify_id";
+	foreach $key (keys %searchterms) {
+		$query .= " AND c.$key = $searchterms{$key}";
+	};
+	my $sth = $dbh->prepare($query);
+	$sth->execute();
+	if ($sth->rows())
+	{
+		while (1)
+		{
+			$row = $sth->fetchrow_hashref();
+			if (!defined($row))
+			{
+				last;
+			}
+			else
+			{
+				#print STDERR "ListingDB::searchListings(): found $row->{id}\n";
+				my $listing = $row;
+				push @results, $listing;
+			}
+		}
+	}
+	return @results;
 }
 ##############################################################################
 # returns a list of chapters
-sub getAllChapters
-  {
-    #print STDERR "ListingDB::getAllChapters\n";
-    my $ce = shift;
-    my @results=();
-    my ($row,$listing);
-    my $query = "SELECT DISTINCT chapter FROM classify";
-    my $dbh = getDB($ce);
-    my $sth = $dbh->prepare($query);
-    $sth->execute();
-    while (1)
-    {
-        $row = $sth->fetchrow_array;
-        if (!defined($row))
-        {
-            last;
-        }
-        else
-        {
-            my $listing = $row;
-            push @results, $listing;
-            #print STDERR "ListingDB::getAllChapters $listing\n";
-         }
-    }
-    return @results;
-  }
+sub getAllChapters {
+	#print STDERR "ListingDB::getAllChapters\n";
+	my $ce = shift;
+	my @results=();
+	my ($row,$listing);
+	my $query = "SELECT DISTINCT chapter FROM classify";
+	my $dbh = getDB($ce);
+	my $sth = $dbh->prepare($query);
+	$sth->execute();
+	while (1)
+	{
+		$row = $sth->fetchrow_array;
+		if (!defined($row))
+		{
+			last;
+		}
+		else
+		{
+			my $listing = $row;
+			push @results, $listing;
+			#print STDERR "ListingDB::getAllChapters $listing\n";
+		}
+	}
+	return @results;
+}
 ##############################################################################
 # input chapter
 # returns a list of sections
-sub getAllSections
-  {
-    #print STDERR "ListingDB::getAllSections\n";
-    my $ce = shift;
-    my $chapter = shift;
-    my @results=();
-    my ($row,$listing);
-    my $query = "SELECT DISTINCT section FROM classify
+sub getAllSections {
+	#print STDERR "ListingDB::getAllSections\n";
+	my $ce = shift;
+	my $chapter = shift;
+	my @results=();
+	my ($row,$listing);
+	my $query = "SELECT DISTINCT section FROM classify
 				WHERE chapter = \'$chapter\'";
-    my $dbh = getDB($ce);
-    my $sth = $dbh->prepare($query);
-    $sth->execute();
-    while (1)
-    {
-        $row = $sth->fetchrow_array;
-        if (!defined($row))
-        {
-            last;
-        }
-        else
-        {
-            my $listing = $row;
-            push @results, $listing;
-            #print STDERR "ListingDB::getAllSections $listing\n";
-         }
-    }
-    return @results;
-  }
+	my $dbh = getDB($ce);
+	my $sth = $dbh->prepare($query);
+	$sth->execute();
+	while (1)
+	{
+		$row = $sth->fetchrow_array;
+		if (!defined($row))
+		{
+			last;
+		}
+		else
+		{
+			my $listing = $row;
+			push @results, $listing;
+			#print STDERR "ListingDB::getAllSections $listing\n";
+		}
+	}
+	return @results;
+}
 
 ##############################################################################
 # returns an array of hash references
-sub getAllListings
-{
-    #print STDERR "ListingDB::getAllListings\n";
-    my $ce = shift;
-    my @results;
-    my ($row,$key);
-    my $dbh = getDB($ce);
-    my $query = "SELECT c.*, p.path
-        	FROM classify c, pgfiles p
-    		WHERE c.pgfiles_id = p.pgfiles_id";
-    my $sth = $dbh->prepare($query);
-    $sth->execute();
-    while (1)
-    {
-        $row = $sth->fetchrow_hashref();
-        if (!defined($row))
-        {
-            last;
-        }
-        else
-        {
-            my $listing = $row;
-            push @results, $listing;
-            #print STDERR "ListingDB::getAllListings $listing\n";
-         }
-    }
-    return @results;
+sub getAllListings {
+	#print STDERR "ListingDB::getAllListings\n";
+	my $ce = shift;
+	my @results;
+	my ($row,$key);
+	my $dbh = getDB($ce);
+	my $query = "SELECT c.*, p.path
+			FROM classify c, pgfiles p
+			WHERE c.pgfiles_id = p.pgfiles_id";
+	my $sth = $dbh->prepare($query);
+	$sth->execute();
+	while (1)
+	{
+		$row = $sth->fetchrow_hashref();
+		last if (!defined($row));
+		my $listing = $row;
+		push @results, $listing;
+		#print STDERR "ListingDB::getAllListings $listing\n";
+	}
+	return @results;
 }
 ##############################################################################
 # input chapter, section
 # returns an array of hash references.
 # if section is omitted, get all from the chapter
-sub getSectionListings
-  {
-    #print STDERR "ListingDB::getSectionListings(chapter,section)\n";
-
-    my $ce = shift;
-    my $chap = shift;
-    my $sec = shift;
-
-
-    my $chapstring = '';
-    if($chap) {
-      $chap =~ s/'/\\'/g;
-      $chapstring = " c.chapter = \'$chap\' AND ";
-    }
-    my $secstring = '';
-    if($sec) {
-      $sec =~ s/'/\\'/g;
-      $secstring = " c.section = \'$sec\' AND ";
-    }
+sub getSectionListings	{
+	#print STDERR "ListingDB::getSectionListings(chapter,section)\n";
 
-    my @results; #returned
-    my $query = "SELECT c.*, p.path
+	my $ce = shift;
+	my $chap = shift;
+	my $sec = shift;
+
+
+	my $chapstring = '';
+	if($chap) {
+		$chap =~ s/'/\\'/g;
+		$chapstring = " c.chapter = \'$chap\' AND ";
+	}
+	my $secstring = '';
+	if($sec) {
+		$sec =~ s/'/\\'/g;
+		$secstring = " c.section = \'$sec\' AND ";
+	}
+
+	my @results; #returned
+	my $query = "SELECT c.*, p.path
 	FROM classify c, pgfiles p
 	WHERE $chapstring $secstring c.pgfiles_id = p.pgfiles_id";
-    my $dbh = getDB($ce);
-    my $sth = $dbh->prepare($query);
-    
-    $sth->execute();
-    while (1)
-      {
-        my $row = $sth->fetchrow_hashref();
-        if (!defined($row))
-        {
-            last;
-        }
-        else
-        {
-            push @results, $row;
-            #print STDERR "ListingDB::getSectionListings $row\n";
-         }
-    }
-    return @results;
-  }
+	my $dbh = getDB($ce);
+	my $sth = $dbh->prepare($query);
+	
+	$sth->execute();
+	while (1)
+	{
+		my $row = $sth->fetchrow_hashref();
+		if (!defined($row))
+		{
+			last;
+		}
+		else
+		{
+			push @results, $row;
+			#print STDERR "ListingDB::getSectionListings $row\n";
+		}
+	}
+	return @results;
+}
 
 ###############################################################################
 # INPUT:
@@ -276,16 +383,14 @@
 #  1 = all ok
 #
 # not implemented yet
-sub deleteListing
-{
-    my $ce = shift;
- my $listing_id = shift;
- #print STDERR "ListingDB::deleteListing(): listing == '$listing_id'\n";
-
- my $dbh = getDB($ce);
+sub deleteListing {
+	my $ce = shift;
+	my $listing_id = shift;
+	#print STDERR "ListingDB::deleteListing(): listing == '$listing_id'\n";
 
- return undef;
+	my $dbh = getDB($ce);
 
+	return undef;
 }
 
 ##############################################################################

[WWcvs] webwork2: first steps towards an SQL-specific version of DB.pm.

[Sam H. v. a. <we...@ma...>]

Log Message:
-----------
first steps towards an SQL-specific version of DB.pm. I'm not quite sure=20
how I'm going to proceed on this. We tried too much abstraction, but I=20
don't want to end up with not enough abstraction, either.

Added Files:
-----------
    webwork2/lib/WeBWorK/DB:
        SQL.pm

Revision Data
-------------
--- /dev/null
+++ lib/WeBWorK/DB/SQL.pm
@@ -0,0 +1,244 @@
+########################################################################=
########
+# WeBWorK Online Homework Delivery System
+# Copyright =A9 2000-2003 The WeBWorK Project, http://openwebwork.sf.net=
/
+# $CVSHeader: webwork2/lib/WeBWorK/DB/SQL.pm,v 1.1 2005/07/26 16:35:10 s=
h002i Exp $
+#=20
+# This program is free software; you can redistribute it and/or modify i=
t under
+# the terms of either: (a) the GNU General Public License as published b=
y the
+# Free Software Foundation; either version 2, or (at your option) any la=
ter
+# version, or (b) the "Artistic License" which comes with this package.
+#=20
+# This program is distributed in the hope that it will be useful, but WI=
THOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or =
FITNESS
+# FOR A PARTICULAR PURPOSE.  See either the GNU General Public License o=
r the
+# Artistic License for more details.
+########################################################################=
########
+
+package WeBWorK::DB::SQL;
+
+=3Dhead1 NAME
+
+WeBWorK::DB::SQL - SQL-specific implementation of the WeBWorK::DB API.
+
+=3Dcut
+
+use strict;
+use warnings;
+use Carp;
+use DBI;
+use WeBWorK::Utils qw(runtime_use);
+
+use constant ALLOWED_SCHEMA =3D> "WeBWorK::DB::Schema::SQL";
+use constant ALLOWED_DRIVER =3D> "WeBWorK::DB::Driver::SQL";
+
+########################################################################=
########
+# constructor
+########################################################################=
########
+
+sub new($$) {
+	my ($invocant, $dbLayout) =3D @_;
+	my $class =3D ref($invocant) || $invocant;
+=09
+	# data that is not table-specific
+	my $global_source;
+	my $global_usernameRO;
+	my $global_passwordRO;
+	my $global_usernameRW;
+	my $global_passwordRW;
+	my $global_debug;
+=09
+	# data that is table-specific
+	my %table_data;
+=09
+	# load the modules required to handle each table, and create driver
+	my %dbLayout =3D %$dbLayout;
+	foreach my $table (keys %dbLayout) {
+		my $layout =3D $dbLayout{$table};
+		my $record =3D $layout->{record};
+		my $schema =3D $layout->{schema};
+		my $driver =3D $layout->{driver};
+		my $source =3D $layout->{source};
+		my $params =3D $layout->{params};
+	=09
+		my $usernameRO =3D $params->{usernameRO};
+		my $passwordRO =3D $params->{passwordRO};
+		my $usernameRW =3D $params->{usernameRW};
+		my $passwordRW =3D $params->{passwordRW};
+		my $debug =3D $params->{debug};
+	=09
+		# make sure the schema is the one we can deal with
+		croak "Table '$table' wants schema module '$schema', but ".__PACKAGE__=
." will only work if the requested schema module is '".ALLOWED_SCHEMA."'.=
 Can't continue."
+			unless $schema eq ALLOWED_SCHEMA;
+	=09
+		# make sure the driver is the one we can deal with
+		croak "Table '$table' wants driver module '$driver', but ".__PACKAGE__=
." will only work if the requested driver module is '".ALLOWED_DRIVER."'.=
 Can't continue."
+			unless $driver eq ALLOWED_DRIVER;
+	=09
+		# get DBI data source
+		layout_error($table, "source", $global_source, $source)
+			if defined $global_source and $global_source ne $source;
+		$global_source =3D $source;
+	=09
+		# get usernames and passwords
+		layout_error($table, "usernameRO", $global_usernameRO, $usernameRO)
+			if defined $global_usernameRO and $global_usernameRO ne $usernameRO;
+		layout_error($table, "passwordRO", $global_passwordRO, $passwordRO)
+			if defined $global_passwordRO and $global_passwordRO ne $passwordRO;
+		layout_error($table, "usernameRW", $global_usernameRW, $usernameRW)
+			if defined $global_usernameRW and $global_usernameRW ne $usernameRW;
+		layout_error($table, "passwordRW", $global_passwordRW, $passwordRW)
+			if defined $global_passwordRW and $global_passwordRW ne $passwordRW;
+		$global_usernameRO =3D $usernameRO;
+		$global_passwordRO =3D $passwordRO;
+		$global_usernameRW =3D $usernameRW;
+		$global_passwordRW =3D $passwordRW;
+	=09
+		# debug flag
+		layout_error($table, "debug", $global_debug, $debug)
+			if defined $global_debug and $global_debug ne $debug;
+		$global_debug =3D $debug;
+	=09
+		# we still want to allow a choice of record classes, since it doesn't =
cost us anything.
+		runtime_use($record);
+	=09
+		# this is a temporary data structure that describes how the user descr=
ibed the tables
+		# in the database layout, with some munging
+		$table_data{$table} =3D {
+			record =3D> $record,
+			tableOverride =3D> $params->{tableOverride},
+			fieldOverride =3D> $params->{fieldOverride},
+		};
+	}
+=09
+	my $dbhRO =3D DBI->connect_cached(
+		$global_source,
+		$global_usernameRO,
+		$global_passwordRO,
+		{ RaiseError =3D> 1 },
+	) or die $DBI::errstr;
+=09
+	my $dbhRW =3D DBI->connect_cached(
+		$global_source,
+		$global_usernameRW,
+		$global_passwordRW,
+		{ RaiseError =3D> 1 },
+	) or die $DBI::errstr;
+=09
+	my $self =3D {
+		#source =3D> $global_source,
+		#usernameRO =3D> $global_usernameRO,
+		#passwordRO =3D> $global_passwordRO,
+		#usernameRW =3D> $global_usernameRW,
+		#passwordRW =3D> $global_passwordRW,
+		dbhRO =3D> $dbhRO,
+		dbhRW =3D> $dbhRW,
+		debug =3D> $global_debug,
+		tables =3D> \%table_data,
+	};
+=09
+	bless $self, $class;
+	return $self;
+}
+
+########################################################################=
########
+# general functions
+########################################################################=
########
+
+sub hashDatabaseOK {
+	return 1;
+}
+
+########################################################################=
########
+# password functions
+########################################################################=
########
+
+sub newPassword {
+	my ($self, @prototype) =3D @_;
+=09
+	return $self->record("password")->new(@prototype);
+}
+
+sub listPasswords {
+	my ($self) =3D @_;
+=09
+	croak "listPasswords: requires 0 arguments"
+		unless @_ =3D=3D 1;
+=09
+	my $table =3D $self->sql_table("password");
+	my $field =3D $self->sql_field("user_id");
+	my $stmt =3D "SELECT `$field` from `$table`";
+=09
+	my $dbh =3D $self->{dbhRO};
+	my $sth =3D $dbh->preprare_cached($stmt);
+	$sth->execute;
+	return map { $_->[0] } $sth->fetchall_arrayref;
+}
+
+sub addPassword {
+	my ($self, $Password) =3D @_;
+=09
+	croak "addPassword: requires 1 argument"
+		unless @_ =3D=3D 2;
+	croak "addPassword: argument 1 must be of type ", $self->record("passwo=
rd")
+		unless ref $Password eq $self->{password}->{record};
+=09
+	checkKeyfields($Password);
+=09
+	my $table =3D $self->sql_table("password");
+	my @key_fields =3D $self->sql_fields("password", $self->record("passwor=
d")->KEYFIELDS);
+	my @fields =3D $self->sql_fields("password", $self->record("password")-=
>FIELDS);
+=09
+=09
+=09
+	croak "addPassword: password exists (perhaps you meant to use putPasswo=
rd?)"
+		if $self->{password}->exists($Password->user_id);
+	croak "addPassword: user ", $Password->user_id, " not found"
+		unless $self->{user}->exists($Password->user_id);
+=09
+	return $self->{password}->add($Password);
+}
+
+########################################################################=
########
+# utilities
+########################################################################=
########
+
+sub layout_error {
+	my ($table, $param, $oldval, $newval) =3D @_;
+=09
+	croak "Table '$table' sets $param to '$newval', but some other table al=
ready set it to '$oldval'. ",
+		__PACKAGE__, " can only be used if all tables set $param to the same v=
alue.";
+}
+
+sub record {
+	my ($self, $table) =3D @_;
+=09
+	return $self->{tables}{$table}{record};
+}
+
+sub sql_table {
+	my ($self, $table) =3D @_;
+=09
+	return $self->{tables}{$table}{tableOverride} || $table;
+}
+
+sub sql_field {
+	my ($self, $table, $field) =3D @_;
+=09
+	return $self->{tables}{$table}{fieldOverride}{$field} || $field;
+}
+
+sub sql_fields {
+	my ($self, $table, @fields) =3D @_;
+=09
+	return map { $self->sql_field($table, $_) } @fields;
+}
+
+sub box {
+=09
+}
+
+sub unbox {
+=09
+}
+
+1;

[WWcvs] webwork-modperl: Add browsing by set definition files.

[jj v. a. <we...@ma...>]

Log Message:
-----------
Add browsing by set definition files.  It will do a full search for these
files, and do some work to find the actual pg files.  Also, a minor fix
in the lists of sets in the current course (the "Select ..." line was being
added twice in some cases), some indentation fixing in the souce, and
renamed a variable.  Long ago, SetMaker used set definition files, and
then that was replaced with database lookup but a variable still had
setdef in its name.  Now that it uses both, this needing fixing.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
        SetMaker.pm

Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.39
retrieving revision 1.40
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.39 -r1.40
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -31,12 +31,13 @@
 use WeBWorK::Form;
 use WeBWorK::Utils qw(readDirectory max sortByName);
 use WeBWorK::Utils::Tasks qw(renderProblems);
+use File::Find;
 
 require WeBWorK::Utils::ListingDB;
 
 use constant MAX_SHOW_DEFAULT => 20;
 use constant NO_LOCAL_SET_STRING => 'No sets in this course yet';
-use constant SELECT_SET_STRING => 'Select a Set for This Course';
+use constant SELECT_SET_STRING => 'Select a Set from this Course';
 use constant SELECT_LOCAL_STRING => 'Select a Problem Collection';
 use constant MY_PROBLEMS => '  My Problems  ';
 use constant MAIN_PROBLEMS => '  Main Problems  ';
@@ -129,6 +130,83 @@
 	return sortByName(undef,@pgs);
 }
 
+## Search for set definition files
+
+# initialize global variable for search
+my @found_set_defs = ();
+
+sub get_set_defs_wanted {
+	my $fn = $_;
+	my $fdir = $File::Find::dir;
+	return() if($fn !~ /^set.*\.def$/);
+	#return() if(not -T $fn);
+	push @found_set_defs, "$fdir/$fn";
+}
+
+sub get_set_defs {
+	my $topdir = shift;
+	@found_set_defs = ();
+	find({ wanted => \&get_set_defs_wanted, follow_fast=>1}, $topdir);
+	map { $_ =~ s|^$topdir/?|| } @found_set_defs;
+	return @found_set_defs;
+}
+
+## Try to make reading of set defs more flexible.  Additional strategies
+## for fixing a path can be added here.
+
+sub munge_pg_file_path {
+	my $self = shift;
+	my $pg_path = shift;
+	my $path_to_set_def = shift;
+	my $end_path = $pg_path;
+	# if the path is ok, don't fix it
+	return($pg_path) if(-e $self->r->ce->{courseDirs}{templates}."/$pg_path");
+	# if we have followed a link into a self contained course to get
+	# to the set.def file, we need to insert the start of the path to
+	# the set.def file
+	$end_path = "$path_to_set_def/$pg_path";
+	return($end_path) if(-e $self->r->ce->{courseDirs}{templates}."/$end_path");
+	# if we got this far, this path is bad, but we let it produce
+	# an error so the user knows there is a troublesome path in the
+	# set.def file.
+	return($pg_path);
+}
+
+## Read a set definition file.  This could be abstracted since it happens
+## elsewhere.  Here we don't have to process so much of the file.
+
+sub read_set_def {
+	my $self = shift;
+	my $r = $self->r;
+	my $filePathOrig = shift;
+	my $filePath = $r->ce->{courseDirs}{templates}."/$filePathOrig";
+	$filePathOrig =~ s/set.*\.def$//;
+	$filePathOrig =~ s|/$||;
+	$filePathOrig = "." if ($filePathOrig !~ /\S/);
+	my @pg_files = ();
+	my ($line, $got_to_pgs, $name, @rest) = ("", 0, "");
+	if ( open (SETFILENAME, "$filePath") )    {
+		while($line = <SETFILENAME>) {
+			chomp($line);
+			$line =~ s|(#.*)||; # don't read past comments
+			if($got_to_pgs) {
+				unless ($line =~ /\S/) {next;} # skip blank lines
+				($name,@rest) = split (/\s*,\s*/,$line);
+				$name =~ s/\s*//g;
+				push @pg_files, $name;
+			} else {
+				$got_to_pgs = 1 if ($line =~ /problemList\s*=/);
+			}
+		}
+	} else {
+		$self->addbadmessage("Cannot open $filePath");
+	}
+	# This is where we would potentially munge the pg file paths
+	# One possibility
+	@pg_files = map { $self->munge_pg_file_path($_, $filePathOrig) } @pg_files;
+	return(@pg_files);
+}
+
 ## go through past page getting a list of identifiers for the problems
 ## and whether or not they are selected, and whether or not they should
 ## be hidden
@@ -363,22 +441,51 @@
 		));
 }
 
+#####	 Version 4 is the set definition file panel
+
+sub browse_setdef_panel {
+	my $self = shift;
+	my $r = $self->r;
+	my $ce = $r->ce;
+	my $library_selected = shift;
+	my $default_value = "Select a Set Definition File";
+	my @list_of_set_defs = get_set_defs($ce->{courseDirs}{templates});
+	if(scalar(@list_of_set_defs) == 0) {
+		@list_of_set_defs = (NO_LOCAL_SET_STRING);
+	} elsif (not $library_selected or $library_selected eq $default_value) { 
+		unshift @list_of_set_defs, $default_value; 
+		$library_selected = $default_value; 
+	}
+	my $view_problem_line = view_problems_line('view_setdef_set', 'View Problems', $self->r);
+	my $popupetc = CGI::popup_menu(-name=> 'library_sets',
+                                -values=>\@list_of_set_defs,
+                                -default=> $library_selected).
+		CGI::br().  $view_problem_line;
+	if($list_of_set_defs[0] eq NO_LOCAL_SET_STRING) {
+		$popupetc = "there are no set definition files in this course to look at."
+	}
+	print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"left"}, "Browse from: ",
+		$popupetc
+	));
+}
+
 sub make_top_row {
 	my $self = shift;
 	my $r = $self->r;
 	my $ce = $r->ce;
 	my %data = @_;
 
-	my $list_of_local_sets = $data{all_set_defs};
+	my $list_of_local_sets = $data{all_db_sets};
 	my $have_local_sets = scalar(@$list_of_local_sets);
 	my $browse_which = $data{browse_which};
 	my $library_selected = $r->param('library_sets');
 	my $set_selected = $r->param('local_sets');
 
-	my ($dis1, $dis2, $dis3) = ("","","");
+	my ($dis1, $dis2, $dis3, $dis4) = ("","","", "");
 	$dis1 =	 '-disabled' if($browse_which eq 'browse_library');	 
 	$dis2 =	 '-disabled' if($browse_which eq 'browse_local');
 	$dis3 =	 '-disabled' if($browse_which eq 'browse_mysets');
+	$dis4 =	 '-disabled' if($browse_which eq 'browse_setdefs');
 
 	##	Make buttons for additional problem libraries
 	my $libs = '';
@@ -394,9 +501,6 @@
 	if($have_local_sets ==0) {
 		$list_of_local_sets = [NO_LOCAL_SET_STRING];
 	} elsif (not $set_selected or $set_selected eq SELECT_SET_STRING) {
-		if ($list_of_local_sets->[0] eq "Select a Homework Set") {
-			shift @{$list_of_local_sets};
-		}
 		unshift @{$list_of_local_sets}, SELECT_SET_STRING;
 		$set_selected = SELECT_SET_STRING;
 	}
@@ -422,11 +526,17 @@
 
 	print CGI::Tr(CGI::td({-bgcolor=>"black"}));
 
+	# Tidy this list up since it is used in two different places
+	if ($list_of_local_sets->[0] eq SELECT_SET_STRING) {
+		shift @{$list_of_local_sets};
+	}
+
 	print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"center"},
 		"Browse ",
 		CGI::submit(-name=>"browse_library", -value=>"Problem Library", -style=>$these_widths, $dis1),
 		CGI::submit(-name=>"browse_local", -value=>"Local Problems", -style=>$these_widths, $dis2),
 		CGI::submit(-name=>"browse_mysets", -value=>"From This Course", -style=>$these_widths, $dis3),
+		CGI::submit(-name=>"browse_setdefs", -value=>"Set Definition Files", -style=>$these_widths, $dis4),
 		$libs,
 	));
 
@@ -438,6 +548,8 @@
 		$self->browse_mysets_panel($library_selected, $list_of_local_sets);
 	} elsif ($browse_which eq 'browse_library') {
 		$self->browse_library_panel();
+	} elsif ($browse_which eq 'browse_setdefs') {
+		$self->browse_setdef_panel($library_selected);
 	} else { ## handle other problem libraries
 		$self->browse_local_panel($library_selected,$browse_which);
 	}
@@ -622,6 +734,10 @@
 		$browse_which = 'browse_mysets';
 		$r->param('library_sets', "");
 		$use_previous_problems = 0; @pg_files = (); ## clear old problems
+	} elsif ($r->param('browse_setdefs')) {
+		$browse_which = 'browse_setdefs';
+		$r->param('library_sets', "");
+		$use_previous_problems = 0; @pg_files = (); ## clear old problems
 
 		##### Change the seed value
 
@@ -666,10 +782,10 @@
 			my $problem;
 			@pg_files=();
 			for $problem (@problemList) {
-	my $problemRecord = $db->getGlobalProblem($set_to_display, $problem); # checked
-	die "global $problem for set $set_to_display not found." unless
-		$problemRecord;
-	push @pg_files, $problemRecord->source_file;
+				my $problemRecord = $db->getGlobalProblem($set_to_display, $problem); # checked
+				die "global $problem for set $set_to_display not found." unless
+					$problemRecord;
+				push @pg_files, $problemRecord->source_file;
 
 			}
 			$use_previous_problems=0;
@@ -695,6 +811,20 @@
 		}
 		$use_previous_problems=0; 
 
+		##### View a set from a set*.def
+
+	} elsif ($r->param('view_setdef_set')) {
+
+		my $set_to_display = $r->param('library_sets');
+		if (not defined($set_to_display) 
+				or $set_to_display eq "Select a Set Definition File"
+				or $set_to_display eq NO_LOCAL_SET_STRING) {
+			$self->addbadmessage("You need to select a set from this course to view.");
+		} else {
+			@pg_files= $self->read_set_def($set_to_display);
+		}
+		$use_previous_problems=0; 
+
 		##### Edit the current local problem set
 
 	} elsif ($r->param('edit_local')) { ## Jump to set edit page
@@ -812,8 +942,8 @@
 
 	############# List of local sets
 
-	my @all_set_defs = $db->listGlobalSets;
-	@all_set_defs = sortByName(undef, @all_set_defs);
+	my @all_db_sets = $db->listGlobalSets;
+	@all_db_sets = sortByName(undef, @all_db_sets);
 
 	if ($use_previous_problems) {
 		@pg_files = @all_past_list;
@@ -830,7 +960,7 @@
 	$self->{problem_seed} = $problem_seed;
 	$self->{pg_files} = \@pg_files;
 	$self->{past_marks} = \@past_marks;
-	$self->{all_set_defs} = \@all_set_defs;
+	$self->{all_db_sets} = \@all_db_sets;
 
 }
 
@@ -870,7 +1000,7 @@
 	my $browse_which = $self->{browse_which};
 	my $problem_seed = $self->{problem_seed};
 	my @pg_files = @{$self->{pg_files}};
-	my @all_set_defs = @{$self->{all_set_defs}};
+	my @all_db_sets = @{$self->{all_db_sets}};
 
 	my @pg_html=($last_shown>=$first_shown) ?
 		renderProblems(r=> $r,
@@ -883,7 +1013,7 @@
 		$self->hidden_authen_fields,
 			'<div align="center">',
 	CGI::start_table({-border=>2});
-	$self->make_top_row('all_set_defs'=>\@all_set_defs, 
+	$self->make_top_row('all_db_sets'=>\@all_db_sets, 
 				 'browse_which'=> $browse_which);
 	print CGI::hidden(-name=>'browse_which', -default=>[$browse_which]),
 		CGI::hidden(-name=>'problem_seed', -default=>[$problem_seed]);

[WWcvs] webwork-modperl: Adding experimental modules which support Preflight

[Mike G. v. a. <we...@ma...>]

Log Message:
-----------
Adding experimental modules which support Preflight

Added Files:
-----------
    webwork-modperl/lib/WeBWorK/HTML:
        DropdownList.pm
        OptionList.pm

Revision Data
-------------
--- /dev/null
+++ lib/WeBWorK/HTML/OptionList.pm
@@ -0,0 +1,106 @@
+########################################################################=
########
+# WeBWorK Online Homework Delivery System
+# Copyright =A9 2000-2003 The WeBWorK Project, http://openwebwork.sf.net=
/
+# $CVSHeader:=20
+#=20
+# This program is free software; you can redistribute it and/or modify i=
t under
+# the terms of either: (a) the GNU General Public License as published b=
y the
+# Free Software Foundation; either version 2, or (at your option) any la=
ter
+# version, or (b) the "Artistic License" which comes with this package.
+#=20
+# This program is distributed in the hope that it will be useful, but WI=
THOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or =
FITNESS
+# FOR A PARTICULAR PURPOSE.  See either the GNU General Public License o=
r the
+# Artistic License for more details.
+########################################################################=
########
+
+package WeBWorK::HTML::OptionList;
+use base qw(Exporter);
+
+=3Dhead1 NAME
+
+WeBWorK::HTML::ScrollingRecordList - HTML widget for a textfield with a =
dropdown list
+
+=3Dcut
+
+use strict;
+use warnings;
+use Carp;
+
+our @EXPORT    =3D ();
+our @EXPORT_OK =3D qw(
+	optionList
+);
+
+
+
+sub optionList {
+	my ($options, @Records) =3D @_;
+=09
+	my %options =3D (%$options);
+	# %options must contain:
+	#  name - name of option list -- use $r->param("$name")
+	#  request - the WeBWorK::Request object for the current request
+	# may contain:
+	#  default - default selection from pop_up list
+	#  size - number of rows shown in option list
+	#  multiple - are multiple selections allowed?
+=09
+	croak "name not found in options" unless exists $options{name};
+	croak "request not found in options" unless exists $options{request};
+	my $name =3D $options{name};
+	my $r =3D $options{request};
+=09
+	my $default =3D $options{default};
+	my $size =3D $options{size};
+	$size =3D 1 unless defined $size;
+	my $multiple =3D $options{multiple};
+	$multiple =3D 0 unless defined $multiple;
+
+	my $value =3D $r->param($name) || "";
+=09
+	my @values =3D ref $options{values} eq "ARRAY" ? @{ $options{values} } =
: ();
+	my %labels =3D ref $options{labels} eq "HASH" ? %{ $options{labels} } :=
 map { $_ =3D> $_ } @values;
+=09
+	# if someone just sends in the labels parameter, use all of them as val=
ues
+	@values =3D keys %labels if (%labels and not @values);
+
+
+	map { $size =3D 4 + length if (length) > $size } @values;
+
+	my %textfield_options =3D (
+			name =3D> $name,
+			value =3D> $value,
+			size =3D> $size,		# we need to calculate this to be the same as the p=
opup_menu
+	);
+=09
+	my %popup_options =3D (
+			-name =3D> $name,
+			-values =3D> \@values,
+			-labels =3D> \%labels,
+			-default =3D> $default || $r->param($name) || 0,
+	);=09
+
+	return CGI::span({-class=3D>"OptionList"},
+		CGI::table({cellpadding =3D> 0, cellspacing =3D> 0, border =3D> 0},=20
+			CGI::Tr({}, CGI::td({}, CGI::textfield({%textfield_options}))),
+			CGI::Tr({}, CGI::td({}, CGI::popup_menu({%popup_options}))),
+		)
+	);
+
+	return CGI::span({-class=3D>"OptionList"},
+		CGI::textfield({
+			name =3D> $name,
+			value =3D> $value,
+			size =3D> $size,		# we need to calculate this to be the same as the p=
opup_menu
+		}), CGI::br(),
+		CGI::popup_menu(
+			-name =3D> $name,
+			-values =3D> \@values,
+			-labels =3D> \%labels,
+			-default =3D> $r->param($name),
+		),
+	);
+}
+
+1;
--- /dev/null
+++ lib/WeBWorK/HTML/DropdownList.pm
@@ -0,0 +1,180 @@
+########################################################################=
########
+# WeBWorK Online Homework Delivery System
+# Copyright =A9 2000-2003 The WeBWorK Project, http://openwebwork.sf.net=
/
+# $CVSHeader:=20
+#=20
+# This program is free software; you can redistribute it and/or modify i=
t under
+# the terms of either: (a) the GNU General Public License as published b=
y the
+# Free Software Foundation; either version 2, or (at your option) any la=
ter
+# version, or (b) the "Artistic License" which comes with this package.
+#=20
+# This program is distributed in the hope that it will be useful, but WI=
THOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or =
FITNESS
+# FOR A PARTICULAR PURPOSE.  See either the GNU General Public License o=
r the
+# Artistic License for more details.
+########################################################################=
########
+
+package WeBWorK::HTML::DropdownRecordList;
+use base qw(Exporter);
+
+=3Dhead1 NAME
+
+WeBWorK::HTML::DropdownList - HTML widget for a scrolling list of
+records.
+
+=3Dcut
+
+use strict;
+use warnings;
+use Carp;
+use WeBWorK::Utils::FormatRecords qw/getFormatsForClass formatRecords/;
+use WeBWorK::Utils::SortRecords qw/getSortsForClass sortRecords/;
+use WeBWorK::Utils::FilterRecords qw/getFiltersForClass filterRecords/;
+
+our @EXPORT    =3D ();
+our @EXPORT_OK =3D qw(
+	dropdownRecordList
+);
+
+
+
+sub dropdownRecordList {
+	my ($options, @Records) =3D @_;
+=09
+	my %options =3D (default_filters=3D>[],default_sort=3D>"",default_forma=
t=3D>"",%$options);
+	# %options must contain:
+	#  name - name of scrolling list -- use $r->param("$name")
+	#  request - the WeBWorK::Request object for the current request
+	# may contain:
+	#  default_sort - name of sort to use by default
+	#  default_format - name of format to use by default
+	#  default_filter - listref, names of filters to apply by default (unim=
pl.)
+	#  allowed_filters - hashref, mapping field name to list of allowed val=
ues (unimpl.)
+	#  size - number of rows shown in scrolling list
+	#  multiple - are multiple selections allowed?
+=09
+	croak "name not found in options" unless exists $options{name};
+	croak "request not found in options" unless exists $options{request};
+	my $name =3D $options{name};
+	my $r =3D $options{request};
+=09
+	my $default_sort =3D $options{default_sort} || "";
+	my $default_format =3D $options{default_format} || "";
+
+	my @default_filters =3D @{$options{default_filters}} ;
+
+	my $size =3D $options{size};
+	my $multiple =3D $options{multiple};
+=09
+	my $sorts =3D [];
+	my $sort_labels =3D {};
+	my $selected_sort =3D "";
+=09
+	my $formats =3D [];
+	my $format_labels =3D {};
+	my $selected_format =3D "";
+=09
+	my $filters =3D [];
+	my $filter_labels =3D {};
+	my @selected_filters=3D ();
+=09
+	my @ids =3D ();
+	my %labels =3D ();
+=09
+	my @selected_records =3D $r->param("$name");
+
+	if (@Records) {
+		my $class =3D ref $Records[0];
+
+		($filters, $filter_labels) =3D getFiltersForClass(@Records);
+		if (defined $r->param("$name!filter")){
+			@selected_filters =3D $r->param("$name!filter");
+			@selected_filters =3D ("all") unless @selected_filters;
+		}
+		else {
+			@selected_filters =3D @default_filters;
+		}
+=09
+		($sorts, $sort_labels) =3D getSortsForClass($class);
+		$selected_sort =3D $r->param("$name!sort")
+			|| $default_sort
+			|| (@$sorts ? $sorts->[0] : "");
+	=09
+		($formats, $format_labels) =3D getFormatsForClass($class);
+		$selected_format =3D $r->param("$name!format")
+			|| $default_format
+			|| (@$formats ? $formats->[0] : "");
+	=09
+		@Records =3D filterRecords({filter=3D>\@selected_filters},@Records);
+	=09
+		@Records =3D sortRecords({preset=3D>$selected_sort}, @Records);
+	=09
+		# generate IDs from keyfields
+		my @keyfields =3D $class->KEYFIELDS;
+		foreach my $Record (@Records) {
+			push @ids, join("!", map { $Record->$_ } @keyfields);
+		}
+	=09
+		# generate labels hash
+		@labels{@ids} =3D @Records;
+		%labels =3D formatRecords({preset=3D>$selected_format}, %labels);
+	}
+=09
+	my %sort_popup_options =3D (
+		-name =3D> "$name!sort",
+		-values =3D> $sorts,
+		-default =3D> $selected_sort,
+		-labels =3D> $sort_labels,
+	);
+=09
+	my %format_popup_options =3D (
+		-name =3D> "$name!format",
+		-values =3D> $formats,
+		-default =3D> $selected_format,
+		-labels =3D> $format_labels,
+	);
+
+	my %filter_options =3D (
+		-name =3D> "$name!filter",
+		-values =3D> $filters,
+		-default =3D> \@selected_filters,
+		-labels =3D> $filter_labels,
+		-size =3D> 3,
+		-multiple =3D> 1,
+	);
+
+	my %list_options =3D (
+		-class=3D>"ScrollingRecordList",
+		-name =3D> "$name",
+		-values =3D> \@ids,
+		-default =3D> \@selected_records,
+		-labels =3D> \%labels,
+	);
+	$list_options{-size} =3D $size if $size;
+	$list_options{-multiple} =3D $multiple if $multiple;
+=09
+	my $value =3D $r->param($name) || "";
+=09
+	map { $size =3D 4 + length if length > $size } values %{ $options{value=
s} };
+
+	my %textfield_options =3D (
+			name =3D> $name,
+			value =3D> $value,
+			size =3D> $size,		# we need to calculate this to be the same as the p=
opup_menu
+	);=09
+=09
+	return CGI::div({-class=3D>"ScrollingRecordList"},
+		CGI::textfield(%textfield_options),
+		CGI::scrolling_list(%list_options)
+	);
+=09
+	return CGI::div({-class=3D>"ScrollingRecordList"},
+		"Sort: ", CGI::popup_menu(%sort_popup_options), CGI::br(),
+		"Format: ", CGI::popup_menu(%format_popup_options), CGI::br(),
+		"Filter: ", CGI::scrolling_list(%filter_options), CGI::br(),
+		CGI::submit("$name!refresh", "Change Display Settings"), CGI::br(),
+		CGI::scrolling_list(%list_options)
+	);
+}
+
+1;

[WWcvs] pg: Made listVariables and listFormVariables synonyms for listing all

[Mike G. v. a. <we...@ma...>]

Log Message:
-----------
Made listVariables and listFormVariables synonyms for listing all variables available to 
the problem.

Modified Files:
--------------
    pg/macros:
        PGsequentialmacros.pl

Revision Data
-------------
Index: PGsequentialmacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGsequentialmacros.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lmacros/PGsequentialmacros.pl -Lmacros/PGsequentialmacros.pl -u -r1.2 -r1.3
--- macros/PGsequentialmacros.pl
+++ macros/PGsequentialmacros.pl
@@ -56,16 +56,23 @@
 =head2  listFormVariables
 
 	listFormVariables();
+	listVariables();
 
-Lists all variables submitted in the problem form.  This is used for debugging.
+Lists all variables submitted in the problem form and all variables in the 
+the Problem environment.  This is used for debugging.
 
 =cut
 
+sub listVariables {
+	listFormVariables(@_);
+}
+
 sub listFormVariables {
     # Lists all of the variables filled out on the input form
 	# Useful for debugging
     TEXT($HR,"Form variables", );
     TEXT(pretty_print($inputs_ref));
+    # list the environment variables
     TEXT("Environment",$BR);
    TEXT(pretty_print(\%envir));
    TEXT($HR);

[WWcvs] webwork-modperl: Say something useful if there is an error when creating

[jj v. a. <we...@ma...>]

Log Message:
-----------
Say something useful if there is an error when creating a new set.  Also
fixed some indentation.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
        SetMaker.pm

Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.38
retrieving revision 1.39
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.38 -r1.39
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -705,30 +705,35 @@
 		##### Make a new local problem set
 
 	} elsif ($r->param('new_local_set')) {
-		if ($r->param('new_set_name') !~ /^[\w.-]*$/) {
+		if ($r->param('new_set_name') !~ /^[\w .-]*$/) {
 			$self->addbadmessage("The name ".$r->param('new_set_name')." is not a valid set name.  Use only letters, digits, -, _, and .");
 		} else {
 			my $newSetName = $r->param('new_set_name');
 			# if we want to munge the input set name, do it here
+			$newSetName =~ s/\s/_/g;
 			$r->param('local_sets',$newSetName);
 			my $newSetRecord	 = $db->getGlobalSet($newSetName);
 			if (defined($newSetRecord)) {
 	$self->addbadmessage("The set name $newSetName is already in use.  Pick a different name if you would like to start a new set.");
 			} else {			# Do it!
-	$newSetRecord = $db->{set}->{record}->new();
-	$newSetRecord->set_id($newSetName);
-	$newSetRecord->set_header("");
-	$newSetRecord->hardcopy_header("");
-	$newSetRecord->open_date(time()+60*60*24*7); # in one week
-	$newSetRecord->due_date(time()+60*60*24*7*2); # in two weeks
-	$newSetRecord->answer_date(time()+60*60*24*7*3); # in three weeks
-	eval {$db->addGlobalSet($newSetRecord)};
-	$self->addgoodmessage("Set $newSetName has been created.");
-	my $selfassign = $r->param('selfassign') || "";
-	$selfassign = "" if($selfassign =~ /false/i); # deal with javascript false
-	if($selfassign) {
-		$self->assignSetToUser($userName, $newSetRecord);
-		$self->addgoodmessage("Set $newSetName was assigned to $userName.");
+				$newSetRecord = $db->{set}->{record}->new();
+				$newSetRecord->set_id($newSetName);
+				$newSetRecord->set_header("");
+				$newSetRecord->hardcopy_header("");
+				$newSetRecord->open_date(time()+60*60*24*7); # in one week
+				$newSetRecord->due_date(time()+60*60*24*7*2); # in two weeks
+				$newSetRecord->answer_date(time()+60*60*24*7*3); # in three weeks
+				eval {$db->addGlobalSet($newSetRecord)};
+				if ($@) {
+					$self->addbadmessage("Problem creating set $newSetName<br> $@");
+				} else {
+					$self->addgoodmessage("Set $newSetName has been created.");
+					my $selfassign = $r->param('selfassign') || "";
+					$selfassign = "" if($selfassign =~ /false/i); # deal with javascript false
+					if($selfassign) {
+						$self->assignSetToUser($userName, $newSetRecord);
+						$self->addgoodmessage("Set $newSetName was assigned to $userName.");
+					}
 				}
 			}
 		}

[WWcvs] webwork-modperl: Redo change allowing .

[jj v. a. <we...@ma...>]

Log Message:
-----------
Redo change allowing . in set names.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK:
        DB.pm

Revision Data
-------------
Index: DB.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/DB.pm,v
retrieving revision 1.64
retrieving revision 1.65
diff -Llib/WeBWorK/DB.pm -Llib/WeBWorK/DB.pm -u -r1.64 -r1.65
--- lib/WeBWorK/DB.pm
+++ lib/WeBWorK/DB.pm
@@ -2386,7 +2386,7 @@
 		} else {
 			croak "checkKeyfields: invalid characters in $keyfield field: $value (valid characters are [A-Za-z0-9_.])"
 #				unless $value =~ m/^[.\w\-]*$/;
-				unless ( $value =~ m/^[\w-]*$/ ||
+				unless ( $value =~ m/^[.\w-]*$/ ||
 					 ( $value =~ m/^[\w,-]*$/ &&
 					   (defined($versioned) && $versioned) 
 					   &&

[WWcvs] webwork-modperl: Rearrange top panels (change really from Bill Z.) plus

[jj v. a. <we...@ma...>]

Log Message:
-----------
Rearrange top panels (change really from Bill Z.) plus some tiny cosmetic
changes.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
        SetMaker.pm

Revision Data
-------------
Index: SetMaker.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm,v
retrieving revision 1.37
retrieving revision 1.38
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -Llib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm -u -r1.37 -r1.38
--- lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetMaker.pm
@@ -35,11 +35,12 @@
 require WeBWorK::Utils::ListingDB;
 
 use constant MAX_SHOW_DEFAULT => 20;
-use constant NO_LOCAL_SET_STRING => 'There are no local sets yet';
+use constant NO_LOCAL_SET_STRING => 'No sets in this course yet';
 use constant SELECT_SET_STRING => 'Select a Set for This Course';
 use constant SELECT_LOCAL_STRING => 'Select a Problem Collection';
 use constant MY_PROBLEMS => '  My Problems  ';
 use constant MAIN_PROBLEMS => '  Main Problems  ';
+use constant CREATE_SET_BUTTON => 'Create New Set';
 
 ## Flags for operations on files
 
@@ -388,28 +389,7 @@
 	}
 	$libs = CGI::br()."or Problems from".$libs if $libs ne '';
 
-	my $these_widths = "width: 20ex";
-	print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"center"},
-		"Browse ",
-		CGI::submit(-name=>"browse_library", -value=>"Problem Library", -style=>$these_widths, $dis1),
-		CGI::submit(-name=>"browse_local", -value=>"Local Problems", -style=>$these_widths, $dis2),
-		CGI::submit(-name=>"browse_mysets", -value=>"From This Course", -style=>$these_widths, $dis3),
-		$libs,
-	));
-
-	print CGI::Tr(CGI::td({-bgcolor=>"black"}));
-
-	if ($browse_which eq 'browse_local') {
-		$self->browse_local_panel($library_selected);
-	} elsif ($browse_which eq 'browse_mysets') {
-		$self->browse_mysets_panel($library_selected, $list_of_local_sets);
-	} elsif ($browse_which eq 'browse_library') {
-		$self->browse_library_panel();
-	} else { ## handle other problem libraries
-		$self->browse_local_panel($library_selected,$browse_which);
-	}
-
-	print CGI::Tr(CGI::td({-bgcolor=>"black"}));
+	my $these_widths = "width: 23ex";
 
 	if($have_local_sets ==0) {
 		$list_of_local_sets = [NO_LOCAL_SET_STRING];
@@ -422,7 +402,7 @@
 	}
 	my $myjs = 'document.mainform.selfassign.value=confirm("Should I assign the new set to you now?\nUse OK for yes and Cancel for no.");true;';
 
-	print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"left"}, "Adding Problems to ",
+	print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"left"}, "Add problems to ",
 		CGI::b("Target Set: "),
 		CGI::popup_menu(-name=> 'local_sets', 
 						-values=>$list_of_local_sets, 
@@ -438,12 +418,33 @@
 		CGI::textfield(-name=>"new_set_name", 
 					   -default=>"Name for new set here",
 					   -override=>1, -size=>30),
-		CGI::br(),
 	));
 
 	print CGI::Tr(CGI::td({-bgcolor=>"black"}));
 
 	print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"center"},
+		"Browse ",
+		CGI::submit(-name=>"browse_library", -value=>"Problem Library", -style=>$these_widths, $dis1),
+		CGI::submit(-name=>"browse_local", -value=>"Local Problems", -style=>$these_widths, $dis2),
+		CGI::submit(-name=>"browse_mysets", -value=>"From This Course", -style=>$these_widths, $dis3),
+		$libs,
+	));
+
+	print CGI::Tr(CGI::td({-bgcolor=>"black"}));
+
+	if ($browse_which eq 'browse_local') {
+		$self->browse_local_panel($library_selected);
+	} elsif ($browse_which eq 'browse_mysets') {
+		$self->browse_mysets_panel($library_selected, $list_of_local_sets);
+	} elsif ($browse_which eq 'browse_library') {
+		$self->browse_library_panel();
+	} else { ## handle other problem libraries
+		$self->browse_local_panel($library_selected,$browse_which);
+	}
+
+	print CGI::Tr(CGI::td({-bgcolor=>"black"}));
+
+	print CGI::Tr(CGI::td({-class=>"InfoPanel", -align=>"center"},
 		CGI::start_table({-border=>"0"}),
 		CGI::Tr( CGI::td({ -align=>"center"},
 			CGI::submit(-name=>"select_all", -style=>$these_widths,
@@ -453,7 +454,7 @@
 		)), 
 		CGI::Tr(CGI::td(
 			CGI::submit(-name=>"update", -style=>$these_widths. "; font-weight:bold",
-			            -value=>"Update"),
+			            -value=>"Update Set"),
 		CGI::submit(-name=>"rerandomize", 
 		            -style=>$these_widths,
 		            -value=>"Rerandomize"),
@@ -830,7 +831,7 @@
 
 
 sub title {
-	return "Homework Set Maker";
+	return "Library Browser";
 }
 
 sub body {

[WWcvs] webwork-modperl: Made comparison safer when turning blank fields

[jj v. a. <we...@ma...>]

Log Message:
-----------
Made comparison safer when turning blank fields undefined (some are already
undefined).

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/DB/Schema:
        SQL.pm

Revision Data
-------------
Index: SQL.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/DB/Schema/SQL.pm,v
retrieving revision 1.26
retrieving revision 1.27
diff -Llib/WeBWorK/DB/Schema/SQL.pm -Llib/WeBWorK/DB/Schema/SQL.pm -u -r1.26 -r1.27
--- lib/WeBWorK/DB/Schema/SQL.pm
+++ lib/WeBWorK/DB/Schema/SQL.pm
@@ -297,7 +297,7 @@
 	
 	my @realFieldnames = $self->{record}->FIELDS();
 	my @fieldvalues = map { $Record->$_() } @realFieldnames;
-	@fieldvalues = map { $_ eq "" ? undef : $_ } @fieldvalues;
+	@fieldvalues = map { (defined($_) and $_ eq "") ? undef : $_ } @fieldvalues;
 	
 	my ($where, @where_args) = $self->makeWhereClause(map { $Record->$_() } @realKeynames);
 	

[WWcvs] webwork-modperl: Fixed bug #781 and #783.

[Mike G. v. a. <we...@ma...>]

Log Message:
-----------
Fixed bug #781 and #783.  Mostly involves editing the message
given instructors on the Grades.pm page.

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator:
        Grades.pm

Revision Data
-------------
Index: Grades.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Grades.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -Llib/WeBWorK/ContentGenerator/Grades.pm -Llib/WeBWorK/ContentGenerator/Grades.pm -u -r1.13 -r1.14
--- lib/WeBWorK/ContentGenerator/Grades.pm
+++ lib/WeBWorK/ContentGenerator/Grades.pm
@@ -127,6 +127,7 @@
 	my $ce = $r->ce;
 	
 	my $userName          = $r->param('effectiveUser') || $r->param('user');
+	my $userID              = $r->param('user');
     my $ur                = $db->getUser($userName);
 	my $emailDirectory    = $ce->{courseDirs}->{email};
 	my $filePath          = "$emailDirectory/report_grades.msg";
@@ -173,7 +174,7 @@
  	$msg =~ s/\$EMAIL/$EMAIL/ge;
  	$msg =~ s/\$LOGIN/$LOGIN/ge;
 	if (defined($COL[1])) {		# prevents extraneous error messages.  
-		$msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1]/ge
+		$msg =~ s/\$COL\[(\-?\d+)\]/$COL[$1] if defined($COL[$1])/ge
 	}
 	else {						# prevents extraneous $COL's in email message 
 		$msg =~ s/\$COL\[(\-?\d+)\]//g
@@ -192,10 +193,12 @@
 #  	$msg =~ s/(\$COL\[.*?\])/eval($1)/ge;
  	
  	$msg =~ s/\r//g;
+ 	$msg = "<pre>$msg</pre>";
+ 	$msg = qq!More scoring information goes here in [TMPL]/email/report_grades.msg. It
+		is merged with the file [Scoring]/report_grades_data.csv. <br>These files can be edited 
+		using the "Email" link and the "Scoring Tools" link in the left margin.<p>!.$msg if ($r->authz->hasPermissions($userID, "access_instructor_tools"));
 	return CGI::div(
-		{style =>"background-color:#DDDDDD"}, "More scoring information goes here in \$emailDirectory/report_grades.msg. It
-		is merged with the file \$scoringDirectory/report_grades_data.csv. <p>
-		<pre>$msg</pre>"
+		{style =>"background-color:#DDDDDD"}, $msg
 	);
 }
 

[WWcvs] webwork-modperl: Add a check box that determines whether the csv entries

[Mike G. v. a. <we...@ma...>]

Log Message:
-----------
Add a check box that determines whether the csv entries are padded
with spaces.  Padding with spaces makes the text easier to read
but it interfers with some spread sheets which expect the csv entries
to contain no extraneous spaces.

We are still not using the CPAN standard CVS input/output mechanisms.
The code is in this module but it is not being used.

-- Mike

Modified Files:
--------------
    webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
        Scoring.pm

Revision Data
-------------
Index: Scoring.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm,v
retrieving revision 1.46
retrieving revision 1.47
diff -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -u -r1.46 -r1.47
--- lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
@@ -44,13 +44,19 @@
 	my $scoringDir = $ce->{courseDirs}->{scoring};
 	my $courseName = $urlpath->arg("courseID");
 	my $user       = $r->param('user');
-
+    
 	# Check permission
 	return unless $authz->hasPermissions($user, "access_instructor_tools");
 	return unless $authz->hasPermissions($user, "score_sets");
 	
 	my @selected = $r->param('selectedSet');
 	my $scoreSelected = $r->param('scoreSelected');
+	my $scoringFileName = $r->param('scoringFileName') || "${courseName}_totals";
+	$scoringFileName =~ s/\.csv\s*$//; $scoringFileName .='.csv';  # must end in .csv
+	$self->{scoringFileName}=$scoringFileName;
+	
+	$self->{padFields}  = defined($r->param('padFields') ) ? 1 : 0; 
+	
 	if (defined $scoreSelected && @selected) {
 
 		my @totals                 = ();
@@ -80,7 +86,8 @@
 		my (@everything, @normal,@full,@info,@totalsColumn);
 		@info             = $self->scoreSet($selected[0], "info", undef, \%Users, \@sortedUserIDs) if defined($selected[0]);
 		@totals           = @info;
-		my $showIndex     = defined($r->param('includeIndex')) ? defined($r->param('includeIndex')) : 0;  
+		my $showIndex     = defined($r->param('includeIndex')) ? defined($r->param('includeIndex')) : 0; 
+		
      
 		foreach my $setID (@selected) {
 		    next unless defined $setID;
@@ -100,7 +107,7 @@
 		}
 		my @sum_scores  = $self->sumScores(\@totals, $showIndex, \%Users, \@sortedUserIDs);
 		$self->appendColumns( \@totals,\@sum_scores);
-		$self->writeCSV("$scoringDir/${courseName}_totals.csv", @totals);
+		$self->writeCSV("$scoringDir/$scoringFileName", @totals);
 
 	} elsif (defined $scoreSelected) {
 		$self->addbadmessage("You must select one or more sets for scoring");
@@ -139,6 +146,8 @@
 	                                      courseID => $courseName
 	);
 	
+	my $scoringFileName = $self->{scoringFileName};
+	
 	# Check permissions
 	return CGI::div({class=>"ResultsWithError"}, "You are not authorized to access the Instructor tools.")
 		unless $authz->hasPermissions($user, "access_instructor_tools");
@@ -182,10 +191,19 @@
 									  },
 									 'Record Scores for Single Sets'
 						),
+						CGI::br(),
+						CGI::checkbox({ -name=>'padFields',
+										-value=>1,
+										-label=>'Pad Fields',
+										-checked=>1,
+									  },
+									 'Pad Fields'
+						),
 					),
 				),
 				CGI::Tr(CGI::td({colspan =>2,align=>'center'},
-					CGI::input({type=>'submit',value=>'Score selected set(s)...',name=>'score-sets'}),
+					CGI::input({type=>'submit',value=>'Score selected set(s) and save to: ',name=>'score-sets'}),
+					CGI::input({type=>'text', name=>'scoringFileName', size=>'40',value=>"$scoringFileName"})
 				)),
 			
 		   CGI::end_table(),
@@ -216,13 +234,13 @@
 				print CGI::hr();
 			}
 		}
-		if (-f "$scoringDir/${courseName}_totals.csv") {
+		if (-f "$scoringDir/$scoringFileName") {
 			print CGI::h2("Totals");
 			#print CGI::a({href=>"../scoringDownload/?getFile=${courseName}_totals.csv&".$self->url_authen_args}, "${courseName}_totals.csv");
 			print CGI::a({href=>$self->systemLink($scoringDownloadPage,
-					               params=>{getFile => "${courseName}_totals.csv" } )}, "${courseName}_totals.csv");
+					               params=>{getFile => "$scoringFileName" } )}, "$scoringFileName");
 			print CGI::hr();
-			print CGI::pre({style=>'font-size:smaller'},WeBWorK::Utils::readFile("$scoringDir/${courseName}_totals.csv"));
+			print CGI::pre({style=>'font-size:smaller'},WeBWorK::Utils::readFile("$scoringDir/$scoringFileName"));
 		}
 	}
 	
@@ -466,8 +484,8 @@
 			$scoringData[6][$totalsColumn+1]  = "index" ;
 		}
 		for (my $user = 0; $user < @sortedUserIDs; $user++) {
-
-			$scoringData[7+$user][$totalsColumn] = sprintf("%.1f",$userStatusTotals{$user});
+            $userStatusTotals{$user} =$userStatusTotals{$user} ||0;
+			$scoringData[7+$user][$totalsColumn] = sprintf("%.1f",$userStatusTotals{$user}) if $scoringItems->{setTotals};
 			$scoringData[7+$user][$totalsColumn+1] = sprintf("%.0f",100*$userSuccessIndex{$user}) if $scoringItems->{successIndex};
 
 		}
@@ -707,6 +725,7 @@
 sub pad {
 	my ($self, $string, $padTo) = @_;
 	$string = '' unless defined $string;
+	return $string unless $self->{padFields}==1;
 	my $spaces = $padTo - length $string;
 
 #	return " "x$spaces.$string;

[WWcvs] pg: Added a modification of the grades that shows where the

[Mike G. v. a. <we...@ma...>]

Log Message:
-----------
Added a modification of the grades that shows where the 
state_summary_msg can be added.  This message is 
printed at the bottom of each problem page.  The current default
is a blank message, which means that the default message 
defined in Problem.pm is printed.

There is currently no way to turn the message off entirely.  Perhaps 
on the next revision.

Modified Files:
--------------
    pg/macros:
        PGanswermacros.pl

Revision Data
-------------
Index: PGanswermacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGanswermacros.pl,v
retrieving revision 1.33
retrieving revision 1.34
diff -Lmacros/PGanswermacros.pl -Lmacros/PGanswermacros.pl -u -r1.33 -r1.34
--- macros/PGanswermacros.pl
+++ macros/PGanswermacros.pl
@@ -4312,6 +4312,9 @@
 
 	$problem_state{num_of_correct_ans}++ if	$allAnswersCorrectQ	== 1;
 	$problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0;
+	
+	$problem_state{state_summary_msg} = '';  # an HTML formatted message printed at the bottom of the problem page
+	
 	(\%problem_result, \%problem_state);
 }
 
@@ -4411,6 +4414,8 @@
 	if ($record_problem_attempt	== 1) {
 		$problem_state{num_of_correct_ans}++ if	$allAnswersCorrectQ	== 1;
 		$problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0;
+		$problem_state{state_summary_msg} = '';  # an HTML formatted message printed at the bottom of the problem page
+	
 	}
 	else {
 		$problem_result{show_partial_correct_answers} =	0 ;	 # prevent partial correct answers from	being shown	for	syntax errors.
@@ -4484,6 +4489,9 @@
 
 	$problem_state{num_of_correct_ans}++ if	$total == $count;
 	$problem_state{num_of_incorrect_ans}++ if $total < $count ;
+	
+	$problem_state{state_summary_msg} = '';  # an HTML formatted message printed at the bottom of the problem page
+	
 	warn "Error	in grading this	problem	the	total $total is	larger than	$count"	if $total >	$count;
 	(\%problem_result, \%problem_state);
 }

[WWcvs] webwork-modperl: Fixed error that kept the script from working on

[Mike G. v. a. <we...@ma...>]

Log Message:
-----------
Fixed error that kept the script from working on courses whose
names contained an underscore.

Added `   ` around course names to handle courses whose names
have hyphens in them (and other weird characters)

Added print comments so that you see a running commentary of what
is being changed.  Once this script is debugged we might want
to turn these off.

Modified Files:
--------------
    webwork-modperl/bin:
        wwdb_addgw

Revision Data
-------------
Index: wwdb_addgw
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/bin/wwdb_addgw,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lbin/wwdb_addgw -Lbin/wwdb_addgw -u -r1.1 -r1.2
--- bin/wwdb_addgw
+++ bin/wwdb_addgw
@@ -171,7 +171,8 @@
 	my $rowRef = $st->fetchall_arrayref();
 	foreach my $r ( @$rowRef ) {
 	    $_ = $r->[0];
-	    my ($crs, $tbl) = ( /^([^_]+)_(.*)$/ );
+	    #my ($crs, $tbl) = ( /^([^_]+)_(.*)$/ );  # this fails on courses with underscores in their names
+	    my  ($crs) = (/^(.*)_key$/);  # match the key table
 	    $courses{$crs} = 1 if ( defined( $crs ) );
 	}
 	die("Error: found now sql_single WeBWorK courses\n") if ( ! %courses );
@@ -252,13 +253,13 @@
 
 # give some sense of progress
     select STDOUT; $| = 1;    # unbuffer output
-    print "doing update.";
+    print "doing update for $dbtype databases.\n";
 
 # list of added fields to check for classes that don't need updating
     my @newFields = keys( %addFields );
 
     foreach my $crs ( @$crsRef ) {
-	print ".";
+	print "updating $crs.\n";
 	my $colRef;
 
 	if ( $dbtype eq 'sql' ) {
@@ -276,7 +277,8 @@
 	} else {
     # for sql_single we already have a database handle; get the set table
     # columns and proceed
-	    my $cmd = "show columns from ${crs}_set";
+	    my $cmd = "show columns from `${crs}_set`";
+	    print "$cmd\n";
 	    my $st = $dbh->prepare( $cmd ) or die( $dbh->errstr() );
 	    $st->execute();
 	    $colRef = $st->fetchall_arrayref();
@@ -301,17 +303,19 @@
 		$cmd1 = 'alter table set_not_a_keyword add column';
 		$cmd2 = 'alter table set_user add column';
 	    } else {
-		$cmd1 = "alter table ${crs}_set add column";
-		$cmd2 = "alter table ${crs}_set_user add column";
+		$cmd1 = "alter table `${crs}_set` add column";
+		$cmd2 = "alter table `${crs}_set_user` add column";
 	    }
 
 	    foreach my $f ( keys %addFields ) {
+	    print "$cmd1 $f $addFields{$f}\n";
 		my $st = $dbh->prepare( "$cmd1 $f $addFields{$f}" ) or 
                     die( $dbh->errstr() );
 		$st->execute() or die( $st->errstr() );
 	    }
 
 	    foreach my $f ( keys %addFields ) {
+	    print "$cmd2 $f $addFields{$f}\n";
 		my $st = $dbh->prepare( "$cmd2 $f $addFields{$f}" ) or 
 		    die( $dbh->errstr() );
 		$st->execute() or die( $st->errstr() );