Menu
▾
▴
openwebwork-cvs — WeBWorK CVS activity
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(58) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(53) |
Feb
(56) |
Mar
|
Apr
|
May
(30) |
Jun
(78) |
Jul
(121) |
Aug
(155) |
Sep
(77) |
Oct
(61) |
Nov
(45) |
Dec
(94) |
| 2006 |
Jan
(116) |
Feb
(33) |
Mar
(11) |
Apr
(23) |
May
(60) |
Jun
(89) |
Jul
(130) |
Aug
(109) |
Sep
(124) |
Oct
(63) |
Nov
(82) |
Dec
(45) |
| 2007 |
Jan
(31) |
Feb
(35) |
Mar
(123) |
Apr
(36) |
May
(18) |
Jun
(134) |
Jul
(133) |
Aug
(241) |
Sep
(126) |
Oct
(31) |
Nov
(15) |
Dec
(5) |
| 2008 |
Jan
(11) |
Feb
(6) |
Mar
(16) |
Apr
(29) |
May
(43) |
Jun
(149) |
Jul
(27) |
Aug
(29) |
Sep
(37) |
Oct
(20) |
Nov
(4) |
Dec
(6) |
| 2009 |
Jan
(34) |
Feb
(30) |
Mar
(16) |
Apr
(6) |
May
(1) |
Jun
(32) |
Jul
(22) |
Aug
(7) |
Sep
(18) |
Oct
(50) |
Nov
(22) |
Dec
(8) |
| 2010 |
Jan
(17) |
Feb
(15) |
Mar
(10) |
Apr
(9) |
May
(67) |
Jun
(30) |
Jul
|
Aug
|
Sep
(2) |
Oct
|
Nov
(1) |
Dec
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 19:17:48
|
Log Message:
-----------
New files for rel-2-1-3
Tags:
----
rel-2-1-patches
Modified Files:
--------------
webwork2:
LICENSE
README
Revision Data
-------------
Index: README
===================================================================
RCS file: /webwork/cvs/system/webwork2/README,v
retrieving revision 1.10.2.4
retrieving revision 1.10.2.5
diff -LREADME -LREADME -u -r1.10.2.4 -r1.10.2.5
--- README
+++ README
@@ -1,37 +1,52 @@
-this is a test
+
WeBWorK
Online Homework Delivery System
- Version 2.1.2
+ Version 2.1.3
Copyright 2000-2005, The WeBWorK Project
All rights reserved.
- * [1]Introduction
- * [2]Availability
- * [3]Installation
- * [4]Help
- * [5]Bug Reports & Feature Requests
- * [6]Patches
+ * [1]Introduction
+ * [2]Availability
+ * [3]Installation
+ * [4]Help
+ * [5]Bug Reports & Feature Requests
+ * [6]Patches
Introduction
- This release builds on WeBWorK 2.1.1 by adding an improved PG Problem
- Editor module and enabling a function to add a blank problem to an
- existing problem set.
+ This release builds on WeBWorK 2.1.2 by adding a number of incremental
+ improvements.
+ * Site wide message on login page (in webwork2/htdocs/site_info.txt)
+ * New sorting options on Instructor pages. All sorts are now case insensitive.
+ * Ability to change password on "Classlist editor" page as well a "Instructor Tools" page
+ * Reformatted scoring files
+ * Minor changes in navigation links
+ * import/export of courses is now made to gzipped files in the templates directory
+ rather than being downloaded directly to the administrators machine. This is
+ still very slow, but it avoids the problem of browser timeouts.
+ * Answer strings are base64 encoded to protect against problems of illegal characters
+ in answers.
+ * There is a big speed increase on using the "Set Assigner" page
+ * Hosted courses can be renamed
+ * Davide Cervone has contributed a number of additions to the PG capabilities. One related
+ to the =webwork2= code base allows macro files to be located in directories specified
+ in =global.conf=. It is also possible to specify subdirectories: e.g.
+ ="context/LimitedVector.pl"=
Availability
- WeBWorK 2.1.2 is available from our CVS repository. Read
+ WeBWorK 2.1.3 is available from our CVS repository. Read
[7]WeBWorKCVSReadOnly for more information on how to set up a CVS
connection. For those who already have a CVS connection, this update
can be obtained by updating to the tag rel-2-1-patches.
- WeBWorK 2.1.2 is also available as a tarball from our SourceForge
+ WeBWorK 2.1.3 is also available as a tarball from our SourceForge
project page:
[8]http://sourceforge.net/project/showfiles.php?group_id=93112
- We recommend you also install [9]PGLanguageRelease2pt1pt1 at the same
- time you install WeBWorK 2.1.2.
+ We recommend you also install [9]PGLanguageRelease2pt1pt3 at the same
+ time you install WeBWorK 2.1.3.
Installation
@@ -39,7 +54,7 @@
Help
- If you need help installing or using WeBWorK 2.1.2, visit the
+ If you need help installing or using WeBWorK 2.1.3, visit the
[11]WeBWorK discussion group and post your question there. The
developers monitor this forum.
@@ -57,12 +72,5 @@
code. Check out the latest development version from CVS and patch
against that. Consult the [13]WeBWorKCVS topic for more information.
- -- [14]SamHathaway - 21 Feb 2005
- 7. http://devel.webwork.rochester.edu/twiki/bin/view/Webwork/WeBWorKCVSReadOnly
- 8. http://sourceforge.net/project/showfiles.php?group_id=93112
- 9. http://devel.webwork.rochester.edu/twiki/bin/view/Webwork/PGLanguageRelease2pt1pt1
- 10. http://devel.webwork.rochester.edu/twiki/bin/view/Webwork/InstallationManualV2pt1#Upgrading_WeBWorK
- 11. http://webhost.math.rochester.edu/webworkdocs/discuss/
- 12. http://bugs.webwork.rochester.edu/
- 13. http://devel.webwork.rochester.edu/twiki/bin/view/Webwork/WeBWorKCVS
- 14. http://devel.webwork.rochester.edu/twiki/bin/view/Main/SamHathaway
+ -- MichaelGage - 10 Jun 2005
+
\ No newline at end of file
Index: LICENSE
===================================================================
RCS file: /webwork/cvs/system/webwork2/LICENSE,v
retrieving revision 1.5.2.3
retrieving revision 1.5.2.4
diff -LLICENSE -LLICENSE -u -r1.5.2.3 -r1.5.2.4
--- LICENSE
+++ LICENSE
@@ -1,7 +1,7 @@
WeBWorK
Online Homework Delivery System
- Version 2.1.2
+ Version 2.1.3
Copyright 2000-2005, The WeBWorK Project
All rights reserved.
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 18:22:21
|
Log Message:
-----------
Bringing HEAD and rel-2-1-3 in line with each other. This is file that
Arnie has just committed.
Tags:
----
rel-2-1-patches
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
UserList.pm
Revision Data
-------------
Index: UserList.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm,v
retrieving revision 1.60.2.2
retrieving revision 1.60.2.3
diff -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -u -r1.60.2.2 -r1.60.2.3
--- lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
@@ -36,6 +36,11 @@
- showing selected users
Switch from edit mode to view and save changes
Switch from edit mode to view and abandon changes
+Switch from view mode to password mode:
+ - showing visible users
+ - showing selected users
+Switch from password mode to view and save changes
+Switch from password mode to view and abandon changes
Delete users:
- visible
- selected
@@ -68,12 +73,15 @@
use Apache::Constants qw(:common REDIRECT DONE); #FIXME -- this should be called higher up in the object tree.
use constant HIDE_USERS_THRESHHOLD => 50;
use constant EDIT_FORMS => [qw(cancelEdit saveEdit)];
-use constant VIEW_FORMS => [qw(filter sort edit import export add delete)];
+use constant PASSWORD_FORMS => [qw(cancelPassword savePassword)];
+use constant VIEW_FORMS => [qw(filter sort edit password import export add delete)];
# permissions needed to perform a given action
use constant FORM_PERMS => {
saveEdit => "modify_student_data",
edit => "modify_student_data",
+ savePassword => "change_password",
+ password => "change_password",
import => "modify_student_data",
export => "modify_classlist_files",
add => "modify_student_data",
@@ -86,7 +94,7 @@
sets => "assign_problem_sets",
};
-use constant STATE_PARAMS => [qw(user effectiveUser key visible_users no_visible_users prev_visible_users no_prev_visible_users editMode primarySortField secondarySortField)];
+use constant STATE_PARAMS => [qw(user effectiveUser key visible_users no_visible_users prev_visible_users no_prev_visible_users editMode passwordMode primarySortField secondarySortField ternarySortField)];
use constant SORT_SUBS => {
user_id => \&byUserID,
@@ -98,6 +106,7 @@
section => \&bySection,
recitation => \&byRecitation,
comment => \&byComment,
+# permission => \&byPermission,
};
use constant FIELD_PROPERTIES => {
@@ -283,7 +292,7 @@
comment
permission
)} = (
- "User ID",
+ "Login Name",
"First Name",
"Last Name",
"E-mail",
@@ -327,9 +336,17 @@
return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify student data"))
if $self->{editMode} and not $authz->hasPermissions($user, "modify_student_data");
+
+ $self->{passwordMode} = $r->param("passwordMode") || 0;
+
+ return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify student data"))
+ if $self->{passwordMode} and not $authz->hasPermissions($user, "modify_student_data");
+
+
$self->{primarySortField} = $r->param("primarySortField") || "last_name";
$self->{secondarySortField} = $r->param("secondarySortField") || "first_name";
+ $self->{ternarySortField} = $r->param("ternarySortField") || "student_id";
my @allUsers = $db->getUsers(@allUserIDs);
my (%sections, %recitations);
@@ -344,7 +361,7 @@
my $actionID = $r->param("action");
if ($actionID) {
- unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }) {
+ unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ PASSWORD_FORMS() } ) {
die "Action $actionID not found";
}
# Check permissions
@@ -375,13 +392,17 @@
my @prevVisibleUserIDs = @{ $self->{prevVisibleUserIDs} };
my @selectedUserIDs = @{ $self->{selectedUserIDs} };
my $editMode = $self->{editMode};
+
+ my $passwordMode = $self->{passwordMode};
my $primarySortField = $self->{primarySortField};
my $secondarySortField = $self->{secondarySortField};
+ my $ternarySortField = $self->{ternarySortField};
#warn "visibleUserIDs=@visibleUserIDs\n";
#warn "prevVisibleUserIDs=@prevVisibleUserIDs\n";
#warn "selectedUserIDs=@selectedUserIDs\n";
#warn "editMode=$editMode\n";
+ #warn "passwordMode=$passwordMode\n";
########## get required users
@@ -389,12 +410,31 @@
my %sortSubs = %{ SORT_SUBS() };
my $primarySortSub = $sortSubs{$primarySortField};
- my $secondarySortSub = $sortSubs{$secondarySortField};
+ my $secondarySortSub = $sortSubs{$secondarySortField};
+ my $ternarySortSub = $sortSubs{$ternarySortField};
+
- # don't forget to sort in opposite order of importance
- @Users = sort $secondarySortSub @Users;
- @Users = sort $primarySortSub @Users;
- #@Users = sort byLnFnUid @Users;
+# # don't forget to sort in opposite order of importance
+# @Users = sort $secondarySortSub @Users;
+# @Users = sort $primarySortSub @Users;
+# #@Users = sort byLnFnUid @Users;
+
+# Always have a definite sort order even if first three sorts don't determine things
+ @Users = sort {
+ &$primarySortSub
+ ||
+ &$secondarySortSub
+ ||
+ &$ternarySortSub
+ ||
+ byLastName
+ ||
+ byFirstName
+ ||
+ byUserID
+ }
+ @Users;
+
my @PermissionLevels;
@@ -441,8 +481,13 @@
print CGI::hidden(-name=>"editMode", -value=>$editMode);
+
+ print CGI::hidden(-name=>"passwordMode", -value=>$passwordMode);
+
print CGI::hidden(-name=>"primarySortField", -value=>$primarySortField);
- print CGI::hidden(-name=>"secondarySortField", -value=>$secondarySortField);
+ print CGI::hidden(-name=>"secondarySortField", -value=>$secondarySortField);
+ print CGI::hidden(-name=>"ternarySortField", -value=>$ternarySortField);
+
print "\n<!-- state data here -->\n";
@@ -454,6 +499,8 @@
my @formsToShow;
if ($editMode) {
@formsToShow = @{ EDIT_FORMS() };
+ }elsif ($passwordMode) {
+ @formsToShow = @{ PASSWORD_FORMS() };
} else {
@formsToShow = @{ VIEW_FORMS() };
}
@@ -483,8 +530,11 @@
print CGI::p("Showing ", scalar @Users, " out of ", scalar @allUserIDs, " users.");
+ print CGI::p("If a password field is left blank, the student's current password will be maintained.") if $passwordMode;
+
$self->printTableHTML(\@Users, \@PermissionLevels, \%prettyFieldNames,
editMode => $editMode,
+ passwordMode => $passwordMode,
selectedUserIDs => \@selectedUserIDs,
);
@@ -645,13 +695,15 @@
return $result;
}
+
sub sort_form {
my ($self, $onChange, %actionParams) = @_;
return join ("",
- "Primary sort: ",
+ "Sort by ",
CGI::popup_menu(
-name => "action.sort.primary",
- -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)],
+# -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)], ## This isn't defined and I don't have time to fix it right now AKP
+ -values => [qw(user_id first_name last_name email_address student_id status section recitation comment)],
-default => $actionParams{"action.sort.primary"}->[0] || "last_name",
-labels => {
user_id => "Login Name",
@@ -663,14 +715,15 @@
section => "Section",
recitation => "Recitation",
comment => "Comment",
- permission => "Perm. Level"
+# permission => "Perm. Level" ## This isn't defined and I don't have time to fix it right now AKP
},
-onchange => $onChange,
),
- " Secondary sort: ",
+ ", then by ",
CGI::popup_menu(
-name => "action.sort.secondary",
- -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)],
+# -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)], ## This isn't defined and I don't have time to fix it right now AKP
+ -values => [qw(user_id first_name last_name email_address student_id status section recitation comment)],
-default => $actionParams{"action.sort.secondary"}->[0] || "first_name",
-labels => {
user_id => "Login Name",
@@ -682,10 +735,31 @@
section => "Section",
recitation => "Recitation",
comment => "Comment",
- permission => "Perm. Level"
+# permission => "Perm. Level"
+ },
+ -onchange => $onChange,
+ ),
+ ", then by ",
+ CGI::popup_menu(
+ -name => "action.sort.ternary",
+# -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)], ## This isn't defined and I don't have time to fix it right now AKP
+ -values => [qw(user_id first_name last_name email_address student_id status section recitation comment)],
+ -default => $actionParams{"action.sort.ternary"}->[0] || "user_id",
+ -labels => {
+ user_id => "Login Name",
+ first_name => "First Name",
+ last_name => "Last Name",
+ email_address => "Email address",
+ student_id => "Student ID",
+ status => "Enrollment Status",
+ section => "Section",
+ recitation => "Recitation",
+ comment => "Comment",
+# permission => "Perm. Level"
},
-onchange => $onChange,
),
+
".",
);
}
@@ -695,9 +769,11 @@
my $primary = $actionParams->{"action.sort.primary"}->[0];
my $secondary = $actionParams->{"action.sort.secondary"}->[0];
+ my $ternary = $actionParams->{"action.sort.ternary"}->[0];
$self->{primarySortField} = $primary;
$self->{secondarySortField} = $secondary;
+ $self->{ternarySortField} = $ternary;
my %names = (
user_id => "Login Name",
@@ -712,9 +788,10 @@
permission => "Perm. Level"
);
- return "Users sorted by $names{$primary} and then by $names{$secondary}.";
+ return "Users sorted by $names{$primary}, then by $names{$secondary}, then by $names{$ternary}.";
}
+
sub edit_form {
my ($self, $onChange, %actionParams) = @_;
@@ -755,6 +832,47 @@
return $result;
}
+
+sub password_form {
+ my ($self, $onChange, %actionParams) = @_;
+
+ return join("",
+ "Give new password to ",
+ CGI::popup_menu(
+ -name => "action.password.scope",
+ -values => [qw(all visible selected)],
+ -default => $actionParams{"action.password.scope"}->[0] || "selected",
+ -labels => {
+ all => "all users",
+ visible => "visible users",
+ selected => "selected users"
+ },
+ -onchange => $onChange,
+ ),
+ );
+}
+
+sub password_handler {
+ my ($self, $genericParams, $actionParams, $tableParams) = @_;
+
+ my $result;
+
+ my $scope = $actionParams->{"action.password.scope"}->[0];
+ if ($scope eq "all") {
+ $result = "giving new passwords to all users";
+ $self->{visibleUserIDs} = $self->{allUserIDs};
+ } elsif ($scope eq "visible") {
+ $result = "giving new passwords to visible users";
+ # leave visibleUserIDs alone
+ } elsif ($scope eq "selected") {
+ $result = "giving new passwords to selected users";
+ $self->{visibleUserIDs} = $genericParams->{selected_users}; # an arrayref
+ }
+ $self->{passwordMode} = 1;
+
+ return $result;
+}
+
sub delete_form {
my ($self, $onChange, %actionParams) = @_;
@@ -1039,6 +1157,67 @@
return "changes saved";
}
+sub cancelPassword_form {
+ my ($self, $onChange, %actionParams) = @_;
+ return "Abandon changes";
+}
+
+sub cancelPassword_handler {
+ my ($self, $genericParams, $actionParams, $tableParams) = @_;
+ my $r = $self->r;
+
+ #$self->{selectedUserIDs} = $self->{visibleUserIDs};
+ # only do the above if we arrived here via "edit selected users"
+ if (defined $r->param("prev_visible_users")) {
+ $self->{visibleUserIDs} = [ $r->param("prev_visible_users") ];
+ } elsif (defined $r->param("no_prev_visible_users")) {
+ $self->{visibleUserIDs} = [];
+ } else {
+ # leave it alone
+ }
+ $self->{passwordMode} = 0;
+
+ return "changes abandoned";
+}
+
+sub savePassword_form {
+ my ($self, $onChange, %actionParams) = @_;
+ return "Save changes";
+}
+
+sub savePassword_handler {
+ my ($self, $genericParams, $actionParams, $tableParams) = @_;
+ my $r = $self->r;
+ my $db = $r->db;
+
+ my @visibleUserIDs = @{ $self->{visibleUserIDs} };
+ foreach my $userID (@visibleUserIDs) {
+ my $User = $db->getUser($userID); # checked
+ die "record for visible user $userID not found" unless $User;
+ my $param = "user.${userID}.new_password";
+ if ((defined $tableParams->{$param}->[0]) and ($tableParams->{$param}->[0])) {
+ my $newP = $tableParams->{$param}->[0];
+ my $Password = eval {$db->getPassword($User->user_id)}; # checked
+ my $cryptPassword = cryptPassword($newP);
+ $Password->password(cryptPassword($newP));
+ eval { $db->putPassword($Password) };
+ }
+ }
+
+ if (defined $r->param("prev_visible_users")) {
+ $self->{visibleUserIDs} = [ $r->param("prev_visible_users") ];
+ } elsif (defined $r->param("no_prev_visible_users")) {
+ $self->{visibleUserIDs} = [];
+ } else {
+ # leave it alone
+ }
+
+ $self->{passwordMode} = 0;
+
+ return "new passwords saved";
+}
+
+
################################################################################
# sorts
################################################################################
@@ -1052,8 +1231,9 @@
sub bySection { lc $a->section cmp lc $b->section }
sub byRecitation { lc $a->recitation cmp lc $b->recitation }
sub byComment { lc $a->comment cmp lc $b->comment }
+#sub byPermission { $a->permission <=> $b->permission }
-sub byLnFnUid { &byLastName || &byFirstName || &byUserID }
+# sub byLnFnUid { &byLastName || &byFirstName || &byUserID }
################################################################################
# utilities
@@ -1234,6 +1414,7 @@
my $courseName = $urlpath->arg("courseID");
my $editMode = $options{editMode};
+ my $passwordMode = $options{passwordMode};
my $userSelected = $options{userSelected};
my $statusClass = $ce->{siteDefaults}->{status}->{$User->{status}};
@@ -1260,7 +1441,7 @@
my @tableCells;
# Select
- if ($editMode) {
+ if ($editMode or $passwordMode) {
# column not there
} else {
# selection checkbox
@@ -1273,7 +1454,7 @@
}
# Act As
- if ($editMode) {
+ if ($editMode or $passwordMode) {
# column not there
} else {
# selection checkbox
@@ -1285,7 +1466,7 @@
}
# Login Status
- if ($editMode) {
+ if ($editMode or $passwordMode) {
# column not there
} else {
# check to see if a user is currently logged in
@@ -1293,8 +1474,18 @@
push @tableCells, ($Key and WeBWorK::Authen::checkKey($self, $User->user_id, $Key->key)) ? CGI::b("active") : CGI::em("inactive");
}
+ # change password (only in password mode)
+ if ($passwordMode) {
+ if ($User->user_id eq $user) {
+ push @tableCells, '' # don't allow a professor to change their own password from this form
+ }
+ else {
+ my $fieldName = 'user.' . $User->user_id . '.' . 'new_password';
+ push @tableCells, CGI::input({type=>"text", name=>$fieldName, size=>14});;
+ }
+ }
# User ID (edit mode) or Assigned Sets (otherwise)
- if ($editMode) {
+ if ($editMode or $passwordMode) {
# straight user ID
push @tableCells, CGI::div({class=>$statusClass}, $User->user_id);
} else {
@@ -1340,6 +1531,7 @@
my %fieldNames = %$fieldNamesRef;
my $editMode = $options{editMode};
+ my $passwordMode = $options{passwordMode};
my %selectedUserIDs = map { $_ => 1 } @{ $options{selectedUserIDs} };
my $currentSort = $options{currentSort};
@@ -1360,13 +1552,16 @@
};
# prepend selection checkbox? only if we're NOT editing!
- if(not $editMode) {
- shift @tableHeadings; # Remove user id
+ unless($editMode or $passwordMode) {
+ shift @tableHeadings; # Remove user id
unshift @tableHeadings, "Select", "Act As", "Login Status", "Assigned Sets";
}
-
+ if($passwordMode) {
+ unshift @tableHeadings, "New Password";
+ }
+
# print the table
- if ($editMode) {
+ if ($editMode or $passwordMode) {
print CGI::start_table({});
} else {
print CGI::start_table({-border=>1, -nowrap=>1});
@@ -1381,6 +1576,7 @@
print $self->recordEditHTML($User, $PermissionLevel,
editMode => $editMode,
+ passwordMode => $passwordMode,
userSelected => exists $selectedUserIDs{$User->user_id}
);
}
|
|
From: Arnie P. v. a. <we...@ma...> - 2005-06-10 18:04:33
|
Log Message:
-----------
Added the ability to change passwords on the classlist page and fixed up sorting a bit.
For example commented out sorting by permission which didn't work. I'll work on sorting
next fixing the above and allowing profs to sort by clicking on heading as on the
Student Progress page.
Arnie
Modified Files:
--------------
webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor:
UserList.pm
Revision Data
-------------
Index: UserList.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/UserList.pm,v
retrieving revision 1.62
retrieving revision 1.63
diff -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -Llib/WeBWorK/ContentGenerator/Instructor/UserList.pm -u -r1.62 -r1.63
--- lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UserList.pm
@@ -36,6 +36,11 @@
- showing selected users
Switch from edit mode to view and save changes
Switch from edit mode to view and abandon changes
+Switch from view mode to password mode:
+ - showing visible users
+ - showing selected users
+Switch from password mode to view and save changes
+Switch from password mode to view and abandon changes
Delete users:
- visible
- selected
@@ -68,12 +73,15 @@
use Apache::Constants qw(:common REDIRECT DONE); #FIXME -- this should be called higher up in the object tree.
use constant HIDE_USERS_THRESHHOLD => 50;
use constant EDIT_FORMS => [qw(cancelEdit saveEdit)];
-use constant VIEW_FORMS => [qw(filter sort edit import export add delete)];
+use constant PASSWORD_FORMS => [qw(cancelPassword savePassword)];
+use constant VIEW_FORMS => [qw(filter sort edit password import export add delete)];
# permissions needed to perform a given action
use constant FORM_PERMS => {
saveEdit => "modify_student_data",
edit => "modify_student_data",
+ savePassword => "change_password",
+ password => "change_password",
import => "modify_student_data",
export => "modify_classlist_files",
add => "modify_student_data",
@@ -86,7 +94,7 @@
sets => "assign_problem_sets",
};
-use constant STATE_PARAMS => [qw(user effectiveUser key visible_users no_visible_users prev_visible_users no_prev_visible_users editMode primarySortField secondarySortField)];
+use constant STATE_PARAMS => [qw(user effectiveUser key visible_users no_visible_users prev_visible_users no_prev_visible_users editMode passwordMode primarySortField secondarySortField ternarySortField)];
use constant SORT_SUBS => {
user_id => \&byUserID,
@@ -98,6 +106,7 @@
section => \&bySection,
recitation => \&byRecitation,
comment => \&byComment,
+# permission => \&byPermission,
};
use constant FIELD_PROPERTIES => {
@@ -283,7 +292,7 @@
comment
permission
)} = (
- "User ID",
+ "Login Name",
"First Name",
"Last Name",
"E-mail",
@@ -327,9 +336,16 @@
return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify student data"))
if $self->{editMode} and not $authz->hasPermissions($user, "modify_student_data");
+
+ $self->{passwordMode} = $r->param("passwordMode") || 0;
+
+ return CGI::div({class=>"ResultsWithError"}, CGI::p("You are not authorized to modify student data"))
+ if $self->{passwordMode} and not $authz->hasPermissions($user, "modify_student_data");
+
$self->{primarySortField} = $r->param("primarySortField") || "last_name";
$self->{secondarySortField} = $r->param("secondarySortField") || "first_name";
+ $self->{ternarySortField} = $r->param("ternarySortField") || "student_id";
my @allUsers = $db->getUsers(@allUserIDs);
my (%sections, %recitations);
@@ -344,7 +360,7 @@
my $actionID = $r->param("action");
if ($actionID) {
- unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }) {
+ unless (grep { $_ eq $actionID } @{ VIEW_FORMS() }, @{ EDIT_FORMS() }, @{ PASSWORD_FORMS() } ) {
die "Action $actionID not found";
}
# Check permissions
@@ -375,13 +391,16 @@
my @prevVisibleUserIDs = @{ $self->{prevVisibleUserIDs} };
my @selectedUserIDs = @{ $self->{selectedUserIDs} };
my $editMode = $self->{editMode};
+ my $passwordMode = $self->{passwordMode};
my $primarySortField = $self->{primarySortField};
my $secondarySortField = $self->{secondarySortField};
+ my $ternarySortField = $self->{ternarySortField};
#warn "visibleUserIDs=@visibleUserIDs\n";
#warn "prevVisibleUserIDs=@prevVisibleUserIDs\n";
#warn "selectedUserIDs=@selectedUserIDs\n";
#warn "editMode=$editMode\n";
+ #warn "passwordMode=$passwordMode\n";
########## get required users
@@ -389,12 +408,30 @@
my %sortSubs = %{ SORT_SUBS() };
my $primarySortSub = $sortSubs{$primarySortField};
- my $secondarySortSub = $sortSubs{$secondarySortField};
+ my $secondarySortSub = $sortSubs{$secondarySortField};
+ my $ternarySortSub = $sortSubs{$ternarySortField};
+
- # don't forget to sort in opposite order of importance
- @Users = sort $secondarySortSub @Users;
- @Users = sort $primarySortSub @Users;
- #@Users = sort byLnFnUid @Users;
+# # don't forget to sort in opposite order of importance
+# @Users = sort $secondarySortSub @Users;
+# @Users = sort $primarySortSub @Users;
+# #@Users = sort byLnFnUid @Users;
+
+# Always have a definite sort order even if first three sorts don't determine things
+ @Users = sort {
+ &$primarySortSub
+ ||
+ &$secondarySortSub
+ ||
+ &$ternarySortSub
+ ||
+ byLastName
+ ||
+ byFirstName
+ ||
+ byUserID
+ }
+ @Users;
my @PermissionLevels;
@@ -441,8 +478,11 @@
print CGI::hidden(-name=>"editMode", -value=>$editMode);
+ print CGI::hidden(-name=>"passwordMode", -value=>$passwordMode);
+
print CGI::hidden(-name=>"primarySortField", -value=>$primarySortField);
- print CGI::hidden(-name=>"secondarySortField", -value=>$secondarySortField);
+ print CGI::hidden(-name=>"secondarySortField", -value=>$secondarySortField);
+ print CGI::hidden(-name=>"ternarySortField", -value=>$ternarySortField);
print "\n<!-- state data here -->\n";
@@ -454,6 +494,8 @@
my @formsToShow;
if ($editMode) {
@formsToShow = @{ EDIT_FORMS() };
+ }elsif ($passwordMode) {
+ @formsToShow = @{ PASSWORD_FORMS() };
} else {
@formsToShow = @{ VIEW_FORMS() };
}
@@ -483,8 +525,11 @@
print CGI::p("Showing ", scalar @Users, " out of ", scalar @allUserIDs, " users.");
+ print CGI::p("If a password field is left blank, the student's current password will be maintained.") if $passwordMode;
+
$self->printTableHTML(\@Users, \@PermissionLevels, \%prettyFieldNames,
editMode => $editMode,
+ passwordMode => $passwordMode,
selectedUserIDs => \@selectedUserIDs,
);
@@ -648,10 +693,11 @@
sub sort_form {
my ($self, $onChange, %actionParams) = @_;
return join ("",
- "Primary sort: ",
+ "Sort by ",
CGI::popup_menu(
-name => "action.sort.primary",
- -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)],
+# -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)], ## This isn't defined and I don't have time to fix it right now AKP
+ -values => [qw(user_id first_name last_name email_address student_id status section recitation comment)],
-default => $actionParams{"action.sort.primary"}->[0] || "last_name",
-labels => {
user_id => "Login Name",
@@ -663,14 +709,15 @@
section => "Section",
recitation => "Recitation",
comment => "Comment",
- permission => "Perm. Level"
+# permission => "Perm. Level" ## This isn't defined and I don't have time to fix it right now AKP
},
-onchange => $onChange,
),
- " Secondary sort: ",
+ ", then by ",
CGI::popup_menu(
-name => "action.sort.secondary",
- -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)],
+# -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)], ## This isn't defined and I don't have time to fix it right now AKP
+ -values => [qw(user_id first_name last_name email_address student_id status section recitation comment)],
-default => $actionParams{"action.sort.secondary"}->[0] || "first_name",
-labels => {
user_id => "Login Name",
@@ -682,10 +729,31 @@
section => "Section",
recitation => "Recitation",
comment => "Comment",
- permission => "Perm. Level"
+# permission => "Perm. Level"
+ },
+ -onchange => $onChange,
+ ),
+ ", then by ",
+ CGI::popup_menu(
+ -name => "action.sort.ternary",
+# -values => [qw(user_id first_name last_name email_address student_id status section recitation comment permission)], ## This isn't defined and I don't have time to fix it right now AKP
+ -values => [qw(user_id first_name last_name email_address student_id status section recitation comment)],
+ -default => $actionParams{"action.sort.ternary"}->[0] || "user_id",
+ -labels => {
+ user_id => "Login Name",
+ first_name => "First Name",
+ last_name => "Last Name",
+ email_address => "Email address",
+ student_id => "Student ID",
+ status => "Enrollment Status",
+ section => "Section",
+ recitation => "Recitation",
+ comment => "Comment",
+# permission => "Perm. Level"
},
-onchange => $onChange,
),
+
".",
);
}
@@ -695,9 +763,11 @@
my $primary = $actionParams->{"action.sort.primary"}->[0];
my $secondary = $actionParams->{"action.sort.secondary"}->[0];
+ my $ternary = $actionParams->{"action.sort.ternary"}->[0];
$self->{primarySortField} = $primary;
$self->{secondarySortField} = $secondary;
+ $self->{ternarySortField} = $ternary;
my %names = (
user_id => "Login Name",
@@ -712,7 +782,7 @@
permission => "Perm. Level"
);
- return "Users sorted by $names{$primary} and then by $names{$secondary}.";
+ return "Users sorted by $names{$primary}, then by $names{$secondary}, then by $names{$ternary}.";
}
sub edit_form {
@@ -755,6 +825,47 @@
return $result;
}
+
+sub password_form {
+ my ($self, $onChange, %actionParams) = @_;
+
+ return join("",
+ "Give new password to ",
+ CGI::popup_menu(
+ -name => "action.password.scope",
+ -values => [qw(all visible selected)],
+ -default => $actionParams{"action.password.scope"}->[0] || "selected",
+ -labels => {
+ all => "all users",
+ visible => "visible users",
+ selected => "selected users"
+ },
+ -onchange => $onChange,
+ ),
+ );
+}
+
+sub password_handler {
+ my ($self, $genericParams, $actionParams, $tableParams) = @_;
+
+ my $result;
+
+ my $scope = $actionParams->{"action.password.scope"}->[0];
+ if ($scope eq "all") {
+ $result = "giving new passwords to all users";
+ $self->{visibleUserIDs} = $self->{allUserIDs};
+ } elsif ($scope eq "visible") {
+ $result = "giving new passwords to visible users";
+ # leave visibleUserIDs alone
+ } elsif ($scope eq "selected") {
+ $result = "giving new passwords to selected users";
+ $self->{visibleUserIDs} = $genericParams->{selected_users}; # an arrayref
+ }
+ $self->{passwordMode} = 1;
+
+ return $result;
+}
+
sub delete_form {
my ($self, $onChange, %actionParams) = @_;
@@ -1039,6 +1150,67 @@
return "changes saved";
}
+sub cancelPassword_form {
+ my ($self, $onChange, %actionParams) = @_;
+ return "Abandon changes";
+}
+
+sub cancelPassword_handler {
+ my ($self, $genericParams, $actionParams, $tableParams) = @_;
+ my $r = $self->r;
+
+ #$self->{selectedUserIDs} = $self->{visibleUserIDs};
+ # only do the above if we arrived here via "edit selected users"
+ if (defined $r->param("prev_visible_users")) {
+ $self->{visibleUserIDs} = [ $r->param("prev_visible_users") ];
+ } elsif (defined $r->param("no_prev_visible_users")) {
+ $self->{visibleUserIDs} = [];
+ } else {
+ # leave it alone
+ }
+ $self->{passwordMode} = 0;
+
+ return "changes abandoned";
+}
+
+sub savePassword_form {
+ my ($self, $onChange, %actionParams) = @_;
+ return "Save changes";
+}
+
+sub savePassword_handler {
+ my ($self, $genericParams, $actionParams, $tableParams) = @_;
+ my $r = $self->r;
+ my $db = $r->db;
+
+ my @visibleUserIDs = @{ $self->{visibleUserIDs} };
+ foreach my $userID (@visibleUserIDs) {
+ my $User = $db->getUser($userID); # checked
+ die "record for visible user $userID not found" unless $User;
+ my $param = "user.${userID}.new_password";
+ if ((defined $tableParams->{$param}->[0]) and ($tableParams->{$param}->[0])) {
+ my $newP = $tableParams->{$param}->[0];
+ my $Password = eval {$db->getPassword($User->user_id)}; # checked
+ my $cryptPassword = cryptPassword($newP);
+ $Password->password(cryptPassword($newP));
+ eval { $db->putPassword($Password) };
+ }
+ }
+
+ if (defined $r->param("prev_visible_users")) {
+ $self->{visibleUserIDs} = [ $r->param("prev_visible_users") ];
+ } elsif (defined $r->param("no_prev_visible_users")) {
+ $self->{visibleUserIDs} = [];
+ } else {
+ # leave it alone
+ }
+
+ $self->{passwordMode} = 0;
+
+ return "new passwords saved";
+}
+
+
################################################################################
# sorts
################################################################################
@@ -1052,8 +1224,9 @@
sub bySection { lc $a->section cmp lc $b->section }
sub byRecitation { lc $a->recitation cmp lc $b->recitation }
sub byComment { lc $a->comment cmp lc $b->comment }
+#sub byPermission { $a->permission <=> $b->permission }
-sub byLnFnUid { &byLastName || &byFirstName || &byUserID }
+# sub byLnFnUid { &byLastName || &byFirstName || &byUserID }
################################################################################
# utilities
@@ -1234,6 +1407,7 @@
my $courseName = $urlpath->arg("courseID");
my $editMode = $options{editMode};
+ my $passwordMode = $options{passwordMode};
my $userSelected = $options{userSelected};
my $statusClass = $ce->{siteDefaults}->{status}->{$User->{status}};
@@ -1260,7 +1434,7 @@
my @tableCells;
# Select
- if ($editMode) {
+ if ($editMode or $passwordMode) {
# column not there
} else {
# selection checkbox
@@ -1273,7 +1447,7 @@
}
# Act As
- if ($editMode) {
+ if ($editMode or $passwordMode) {
# column not there
} else {
# selection checkbox
@@ -1285,7 +1459,7 @@
}
# Login Status
- if ($editMode) {
+ if ($editMode or $passwordMode) {
# column not there
} else {
# check to see if a user is currently logged in
@@ -1293,8 +1467,18 @@
push @tableCells, ($Key and WeBWorK::Authen::checkKey($self, $User->user_id, $Key->key)) ? CGI::b("active") : CGI::em("inactive");
}
+ # change password (only in password mode)
+ if ($passwordMode) {
+ if ($User->user_id eq $user) {
+ push @tableCells, '' # don't allow a professor to change their own password from this form
+ }
+ else {
+ my $fieldName = 'user.' . $User->user_id . '.' . 'new_password';
+ push @tableCells, CGI::input({type=>"text", name=>$fieldName, size=>14});;
+ }
+ }
# User ID (edit mode) or Assigned Sets (otherwise)
- if ($editMode) {
+ if ($editMode or $passwordMode) {
# straight user ID
push @tableCells, CGI::div({class=>$statusClass}, $User->user_id);
} else {
@@ -1340,6 +1524,7 @@
my %fieldNames = %$fieldNamesRef;
my $editMode = $options{editMode};
+ my $passwordMode = $options{passwordMode};
my %selectedUserIDs = map { $_ => 1 } @{ $options{selectedUserIDs} };
my $currentSort = $options{currentSort};
@@ -1360,13 +1545,16 @@
};
# prepend selection checkbox? only if we're NOT editing!
- if(not $editMode) {
- shift @tableHeadings; # Remove user id
+ unless($editMode or $passwordMode) {
+ shift @tableHeadings; # Remove user id
unshift @tableHeadings, "Select", "Act As", "Login Status", "Assigned Sets";
}
-
+ if($passwordMode) {
+ unshift @tableHeadings, "New Password";
+ }
+
# print the table
- if ($editMode) {
+ if ($editMode or $passwordMode) {
print CGI::start_table({});
} else {
print CGI::start_table({-border=>1, -nowrap=>1});
@@ -1381,6 +1569,7 @@
print $self->recordEditHTML($User, $PermissionLevel,
editMode => $editMode,
+ passwordMode => $passwordMode,
userSelected => exists $selectedUserIDs{$User->user_id}
);
}
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 16:36:23
|
Log Message:
-----------
Bringing HEAD and rel-2-1-patches in line
Tags:
----
rel-2-1-patches
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.36.2.5
retrieving revision 1.36.2.6
diff -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -u -r1.36.2.5 -r1.36.2.6
--- lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
@@ -520,7 +520,7 @@
return @scoringData;
}
-}
+
# Often it's more efficient to just get everything out of the database
# and then pick out what you want later. Hence, these "everything2*" functions
sub everything2info {
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 16:09:08
|
Log Message:
-----------
Bringing HEAD and rel-2-1-patches in line
Modified Files:
--------------
webwork2/lib/WeBWorK:
Constants.pm
ContentGenerator.pm
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
Scoring.pm
Revision Data
-------------
Index: ContentGenerator.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator.pm,v
retrieving revision 1.135
retrieving revision 1.136
diff -Llib/WeBWorK/ContentGenerator.pm -Llib/WeBWorK/ContentGenerator.pm -u -r1.135 -r1.136
--- lib/WeBWorK/ContentGenerator.pm
+++ lib/WeBWorK/ContentGenerator.pm
@@ -495,6 +495,7 @@
if ($authz->hasPermissions($user, "report_bugs")) {
print CGI::p(CGI::a({style=>"font-size:larger", href=>$ce->{webworkURLs}{bugReporter}}, "Report bugs")),CGI::hr();
}
+
my %displayOptions = (displayMode => $self->{displayMode},
showOldAnswers => $self->{will}->{showOldAnswers}
);
@@ -528,6 +529,7 @@
}
print CGI::end_li();
+
if ($authz->hasPermissions($user, "change_password") or $authz->hasPermissions($user, "change_email_address")) {
print CGI::li(CGI::a({href=>$self->systemLink($options,
@@ -545,7 +547,9 @@
if ($authz->hasPermissions($user, "access_instructor_tools")) {
my $ipfx = "${pfx}Instructor::";
+
# instructor tools link
+
my $instr = $urlpath->newFromModule("${ipfx}Index", %args);
# Class list editor
my $userList = $urlpath->newFromModule("${ipfx}UserList", %args);
@@ -598,6 +602,7 @@
print CGI::end_ul();
}
print CGI::end_li();
+
## Library browser
print CGI::li(CGI::a({href=>$self->systemLink($maker,params=>{ %displayOptions,})}, sp2nbsp($maker->name))) if $authz->hasPermissions($user, "modify_problem_sets");
print CGI::li(CGI::a({href=>$self->systemLink($assigner,params=>{ %displayOptions,})}, sp2nbsp($assigner->name))) if $authz->hasPermissions($user, "assign_problem_sets");
@@ -615,13 +620,17 @@
print CGI::end_li();
## Student Progress
print CGI::li(CGI::a({href=>$self->systemLink($progress,params=>{ %displayOptions,})}, sp2nbsp($progress->name)));
+
print CGI::start_li();
print CGI::start_ul();
if (defined $userID and $userID ne "") {
print CGI::li(CGI::a({href=>$self->systemLink($userProgress,params=>{ %displayOptions,})}, $userID));
+
}
if (defined $setID and $setID ne "") {
+
print CGI::li(CGI::a({href=>$self->systemLink($setProgress,params=>{ %displayOptions,})}, sp2nbsp($setID)));
+
}
print CGI::end_ul();
print CGI::end_li();
Index: Constants.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Constants.pm,v
retrieving revision 1.23
retrieving revision 1.24
diff -Llib/WeBWorK/Constants.pm -Llib/WeBWorK/Constants.pm -u -r1.23 -r1.24
--- lib/WeBWorK/Constants.pm
+++ lib/WeBWorK/Constants.pm
@@ -54,7 +54,7 @@
# If non-empty, timing data will be sent to the file named rather than STDERR.
#
-$WeBWorK::Timing::Logfile = "/home/gage/webwork2/logs/timing.log";
+$WeBWorK::Timing::Logfile = "";
################################################################################
# WeBWorK::ContentGenerator::Hardcopy
Index: Scoring.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm,v
retrieving revision 1.44
retrieving revision 1.45
diff -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -u -r1.44 -r1.45
--- lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
@@ -518,8 +518,9 @@
return @scoringData;
-
}
+
+
# Often it's more efficient to just get everything out of the database
# and then pick out what you want later. Hence, these "everything2*" functions
sub everything2info {
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 16:03:40
|
Log Message:
-----------
Bring HEAD and rel-2-1-patches in line with each other.
Tags:
----
rel-2-1-patches
Modified Files:
--------------
webwork2/clients:
webwork_xmlrpc_client.pl
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
Scoring.pm
Revision Data
-------------
Index: webwork_xmlrpc_client.pl
===================================================================
RCS file: /webwork/cvs/system/webwork2/clients/webwork_xmlrpc_client.pl,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -Lclients/webwork_xmlrpc_client.pl -Lclients/webwork_xmlrpc_client.pl -u -r1.1.2.1 -r1.1.2.2
--- clients/webwork_xmlrpc_client.pl
+++ clients/webwork_xmlrpc_client.pl
@@ -36,9 +36,9 @@
} else {
- print STDERR "Useage: .xmlrpc_client4.pl command file_name\n";
- print STDERR "For example: .xmlrpc_client4.pl renderProblem input.txt\n";
- print STDERR "For example: .xmlrpc_client4.pl listLibraries \n";
+ print STDERR "Useage: ./webwork_xmlrpc_client.pl command [file_name]\n";
+ print STDERR "For example: ./webwork_xmlrpc_client.pl renderProblem input.txt\n";
+ print STDERR "For example: ./webwork_xmlrpc_client.pl listLibraries \n";
print STDERR "Commands are: ", join(" ", @COMMANDS), "\n";
}
Index: Scoring.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm,v
retrieving revision 1.36.2.4
retrieving revision 1.36.2.5
diff -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -u -r1.36.2.4 -r1.36.2.5
--- lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
@@ -520,6 +520,7 @@
return @scoringData;
}
+}
# Often it's more efficient to just get everything out of the database
# and then pick out what you want later. Hence, these "everything2*" functions
sub everything2info {
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 16:02:06
|
Log Message:
-----------
Bring HEAD and rel-2-1-patches in line with each other.
Modified Files:
--------------
webwork2/htdocs/css:
ur.css
webwork2/lib/WeBWorK:
DB.pm
webwork2/lib/WeBWorK/ContentGenerator:
CourseAdmin.pm
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
Scoring.pm
Stats.pm
Revision Data
-------------
Index: ur.css
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/htdocs/css/ur.css,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lhtdocs/css/ur.css -Lhtdocs/css/ur.css -u -r1.2 -r1.3
--- htdocs/css/ur.css
+++ htdocs/css/ur.css
@@ -135,6 +135,7 @@
padding: 2px 5px 2px 5px;
width: auto;
}
-div.problemHeader { float: left; }
+# div.problemHeader { float: left; } # suspected of causing MSIE peekabo=
o bug
+div.problemHeader {}
div.problem { clear: both; background-color: #E0E0E0; color: black; }
.parsehilight { background-color:yellow; }
Index: DB.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB.pm,v
retrieving revision 1.62
retrieving revision 1.63
diff -Llib/WeBWorK/DB.pm -Llib/WeBWorK/DB.pm -u -r1.62 -r1.63
--- lib/WeBWorK/DB.pm
+++ lib/WeBWorK/DB.pm
@@ -343,6 +343,7 @@
$self->{set_user}->{driver}->connect("ro")
or return 0, @results, "Failed to connect to set_user database.";
=09
+
# get PSVNs for global user (=EFN)
# this reads from "login<>global_user"
my @globalUserPSVNs =3D $self->{set_user}->getPSVNsForUser($globalUser=
ID);
@@ -358,6 +359,7 @@
#warn "got setID '$setID'\n";
}
=09
+
# get PSVNs for each setID (=EFN*M)
# this reads from "set<>$_"
my @okPSVNs =3D map { $self->{set_user}->getPSVNsForSet($_) } @globalU=
serSetIDs;
Index: CourseAdmin.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Cours=
eAdmin.pm,v
retrieving revision 1.34
retrieving revision 1.35
diff -Llib/WeBWorK/ContentGenerator/CourseAdmin.pm -Llib/WeBWorK/ContentG=
enerator/CourseAdmin.pm -u -r1.34 -r1.35
--- lib/WeBWorK/ContentGenerator/CourseAdmin.pm
+++ lib/WeBWorK/ContentGenerator/CourseAdmin.pm
@@ -58,6 +58,10 @@
return;
}
=09
+ # get result and send to message
+ my $status_message =3D $r->param("status_message");
+ $self->addmessage(CGI::p("$status_message")) if $status_message;
+
## if the user is asking for the downloaded database...
#if (defined $r->param("download_exported_database")) {
# my $courseID =3D $r->param("export_courseID");
@@ -688,7 +692,7 @@
if ($add_admin_users ne "") {
foreach my $userID ($db->listUsers) {
if ($userID eq $add_initial_userID) {
- warn "User '$userID' will not be copied from admin course as it is t=
he initial instructor.";
+ $self->addbadmessage( "User '$userID' will not be copied from admin =
course as it is the initial instructor.");
next;
}
my $User =3D $db->getUser($userID);
Index: Stats.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instr=
uctor/Stats.pm,v
retrieving revision 1.52
retrieving revision 1.53
diff -Llib/WeBWorK/ContentGenerator/Instructor/Stats.pm -Llib/WeBWorK/Con=
tentGenerator/Instructor/Stats.pm -u -r1.52 -r1.53
--- lib/WeBWorK/ContentGenerator/Instructor/Stats.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Stats.pm
@@ -363,6 +363,7 @@
=20
foreach my $problemRecord (@problemRecords) {
next unless ref($problemRecord);
+
# warn "Can't find record for problem $prob in set $setName for $stu=
dent";
# FIXME check the legitimate reasons why a student record might not =
be defined
####################################################################
@@ -476,9 +477,11 @@
foreach my $probID (@problemIDs) {
$attempts_percentiles_for_problem{$probID} =3D {
determine_percentiles([@brackets2], @{$attempts_list_for_problem{$=
probID}})
+
};=20
$problemPage{$probID} =3D $urlpath->newFromModule("WeBWorK::Content=
Generator::Problem",
courseID =3D> $courseName, setID =3D> $setName, problemID =3D> $probI=
D);
+
}
=20
########################################################################=
#############
Index: Scoring.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instr=
uctor/Scoring.pm,v
retrieving revision 1.43
retrieving revision 1.44
diff -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -Llib/WeBWorK/C=
ontentGenerator/Instructor/Scoring.pm -u -r1.43 -r1.44
--- lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
@@ -71,6 +71,7 @@
||
lc($Users{$a}->user_id) cmp lc($Users{$b}->user_id)
}
+
keys %Users;
#my @userInfo =3D (\%Users, \@sortedUserIDs);
$WeBWorK::timer->continue("done pre-fetching users") if defined($WeBWo=
rK::timer);
@@ -465,13 +466,16 @@
$scoringData[6][$totalsColumn+1] =3D "index" ;
}
for (my $user =3D 0; $user < @sortedUserIDs; $user++) {
+
$scoringData[7+$user][$totalsColumn] =3D sprintf("%.1f",$userStatusTo=
tals{$user});
$scoringData[7+$user][$totalsColumn+1] =3D sprintf("%.0f",100*$userSu=
ccessIndex{$user}) if $scoringItems->{successIndex};
+
}
}
$WeBWorK::timer->continue("End set $setID") if defined($WeBWorK::timer=
);
return @scoringData;
}
+
sub sumScores { # Create a totals column for each student
my $self =3D shift;
my $r_totals =3D shift;
@@ -703,6 +707,7 @@
my ($self, $string, $padTo) =3D @_;
$string =3D '' unless defined $string;
my $spaces =3D $padTo - length $string;
+
# return " "x$spaces.$string;
return $string." "x$spaces;
}
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 04:17:04
|
Log Message:
-----------
This file can contain a system wide message. It is displayed on each
login page. It's location and name are specified in global.conf
Added Files:
-----------
webwork-modperl/htdocs:
site_info.txt
Revision Data
-------------
--- /dev/null
+++ htdocs/site_info.txt
@@ -0,0 +1,3 @@
+System wide message in file .... webwork2/htdocs/site_info.txt
+
+The file name and location can be customized in global.conf.
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 03:10:10
|
Log Message:
-----------
Fixed missing right brace.
Tags:
----
rel-2-1-patches
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.36.2.3
retrieving revision 1.36.2.4
diff -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -u -r1.36.2.3 -r1.36.2.4
--- lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
@@ -518,6 +518,7 @@
return @scoringData;
+}
# Often it's more efficient to just get everything out of the database
# and then pick out what you want later. Hence, these "everything2*" functions
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 02:40:08
|
Log Message:
-----------
Merging changes made for rel-2-1-3 back into rel-2-1-patches
Tags:
----
rel-2-1-patches
Modified Files:
--------------
pg/lib:
Value.pm
pg/lib/Parser:
BOP.pm
Context.pm
Differentiation.pm
Function.pm
List.pm
UOP.pm
pg/lib/Parser/Context:
Default.pm
Functions.pm
pg/lib/Parser/List:
Vector.pm
pg/lib/Value:
AnswerChecker.pm
Complex.pm
Formula.pm
Infinity.pm
Interval.pm
List.pm
Matrix.pm
Point.pm
Real.pm
String.pm
Union.pm
Vector.pm
pg/lib/WeBWorK/PG:
IO.pm
Translator.pm
pg/macros:
PGbasicmacros.pl
PGchoicemacros.pl
PGcommonFunctions.pl
Parser.pl
Value.pl
dangerousMacros.pl
parserImplicitPlane.pl
parserParametricLine.pl
Added Files:
-----------
pg/macros:
answerCustom.pl
parserImplicitEquation.pl
parserMultiPart.pl
parserSolutionFor.pl
Revision Data
-------------
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value.pm,v
retrieving revision 1.30
retrieving revision 1.30.2.1
diff -Llib/Value.pm -Llib/Value.pm -u -r1.30 -r1.30.2.1
--- lib/Value.pm
+++ lib/Value.pm
@@ -42,6 +42,8 @@
granularity => 1000,
resolution => undef,
max_adapt => 1E8,
+ checkUndefinedPoints => 0,
+ max_undefined => undef,
},
);
@@ -80,7 +82,7 @@
'.' => '_dot', # see _dot below
'x' => 'cross',
'<=>' => 'compare',
- 'cmp' => 'cmp',
+ 'cmp' => 'compare_string',
};
$$context->{pattern}{infinite} = '[-+]?inf(?:inity)?';
@@ -134,23 +136,29 @@
# Convert non-Value objects to Values, if possible
#
sub makeValue {
- my $x = shift;
- return $x if ref($x);
+ my $x = shift; my %params = (showError => 0, makeFormula => 1, @_);
+ return $x if ref($x) || $x eq '';
return Value::Real->make($x) if matchNumber($x);
if (matchInfinite($x)) {
my $I = Value::Infinity->new();
$I = $I->neg if $x =~ m/^$$Value::context->{pattern}{-infinity}$/;
return $I;
}
- if ($Parser::installed) {return $x unless $$Value::context->{strings}{$x}}
- return Value::String->make($x);
+ return Value::String->make($x)
+ if (!$Parser::installed || $$Value::context->{strings}{$x});
+ return $x if !$params{makeFormula};
+ Value::Error("String constant '$x' is not defined in this context")
+ if $params{showError};
+ $x = Value::Formula->new($x);
+ $x = $x->eval if $x->isConstant;
+ return $x;
}
#
# Get a printable version of the class of an object
#
sub showClass {
- my $value = makeValue(shift);
+ my $value = makeValue(shift,makeFormula=>0);
return "'".$value."'" unless Value::isValue($value);
my $class = class($value);
return showType($value) if ($class eq 'List');
@@ -255,7 +263,7 @@
#
# Convert a list of values (and open and close parens)
# to a formula whose type is the list type associated with
-# the parens. If the formula is constant, evaluate it.
+# the parens.
#
sub formula {
my $self = shift; my $values = shift;
@@ -269,7 +277,6 @@
$formula->{tree} = $formula->{context}{parser}{List}->new($formula,[@coords],0,
$formula->{context}{parens}{$paren},$coords[0]->typeRef,$open,$close);
$formula->{autoFormula} = 1; # mark that this was generated automatically
-# return $formula->eval if scalar(%{$formula->{variables}}) == 0;
return $formula;
}
@@ -284,6 +291,15 @@
}
#
+# Easy method for setting parameters of an object
+#
+sub with {
+ my $self = shift; my %hash = @_;
+ foreach my $id (keys(%hash)) {$self->{$id} = $hash{$id}}
+ return $self;
+}
+
+#
# Return a type structure for the item
# (includes name, length of vectors, and so on)
#
@@ -310,7 +326,7 @@
#
sub value {return @{(shift)->{data}}} # the value of the object (as an array)
sub data {return (shift)->{data}} # the reference to the value
-sub length {return (shift)->typeRef->{length}} # the number of coordinates
+sub length {return scalar(@{(shift)->{data}})} # the number of coordinates
sub type {return (shift)->typeRef->{name}} # the object type
sub entryType {return (shift)->typeRef->{entryType}} # the coordinate type
#
@@ -325,7 +341,7 @@
#
sub class {
my $self = shift; my $class = ref($self) || $self;
- $class =~ s/Value:://;
+ $class =~ s/.*:://;
return $class;
}
@@ -354,8 +370,7 @@
return 0 unless Value::isValue($other);
my $sprec = $$context->{precedence}{class($self)};
my $oprec = $$context->{precedence}{class($other)};
- return (defined($oprec) && $sprec < $oprec) ||
- ($sprec > $oprec && $sprec >= $$context->{precedence}{special});
+ return (defined($oprec) && $sprec < $oprec);
}
sub promote {shift}
@@ -426,9 +441,9 @@
#
# Compare the values as strings
#
-sub cmp {
+sub compare_string {
my ($l,$r,$flag) = @_;
- if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
+ if ($l->promotePrecedence($r)) {return $r->compare_string($l,!$flag)}
$l = $l->stringify; $r = $r->stringify if Value::isValue($r);
if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
return $l cmp $r;
@@ -450,14 +465,16 @@
#
sub perl {
my $self = shift; my $parens = shift; my $matrix = shift;
- my $class = $self->class; my $mtype = $class eq 'Matrix';
+ my $class = $self->class;
+ my $mtype = $class eq 'Matrix'; $mtype = -1 if $mtype & !$matrix;
my $perl; my @p = ();
foreach my $x (@{$self->data}) {
if (Value::isValue($x)) {push(@p,$x->perl(0,$mtype))} else {push(@p,$x)}
}
@p = ("'".$self->{open}."'",@p,"'".$self->{close}."'") if $class eq 'Interval';
if ($matrix) {
- $perl = '['.join(',',@p).']';
+ $perl = join(',',@p);
+ $perl = '['.$perl.']' if $mtype > 0;
} else {
$perl = $class.'('.join(',',@p).')';
$perl = '('.$perl.')' if $parens == 1;
@@ -502,7 +519,7 @@
# For debugging
#
sub traceback {
- my $frame = 2;
+ my $frame = shift; $frame = 2 unless defined($frame);
my $trace = '';
while (my ($pkg,$file,$line,$subname) = caller($frame++))
{$trace .= " in $subname at line $line of $file\n"}
Index: BOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP.pm,v
retrieving revision 1.9
retrieving revision 1.9.2.1
diff -Llib/Parser/BOP.pm -Llib/Parser/BOP.pm -u -r1.9 -r1.9.2.1
--- lib/Parser/BOP.pm
+++ lib/Parser/BOP.pm
@@ -276,7 +276,7 @@
my $extraParens = $self->{equation}{context}->flag('showExtraParens');
my $addparens =
defined($precedence) &&
- ((($showparens eq 'all' || $bop->{fullparens}) && $extraParens) ||
+ ($showparens eq 'all' || (($showparens eq 'extra' || $bop->{fullparens}) && $extraParens) ||
$precedence > $bop->{precedence} || ($precedence == $bop->{precedence} &&
($bop->{associativity} eq 'right' || $showparens eq 'same')));
my $outerRight = !$addparens && ($outerRight || $position eq 'right');
Index: List.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/List.pm,v
retrieving revision 1.11
retrieving revision 1.11.2.1
diff -Llib/Parser/List.pm -Llib/Parser/List.pm -u -r1.11 -r1.11.2.1
--- lib/Parser/List.pm
+++ lib/Parser/List.pm
@@ -216,7 +216,8 @@
$open = '\left' .$open if $open ne '';
$close = '\right'.$close if $close ne '';
foreach my $x (@{$self->{coords}}) {push(@coords,$x->TeX)}
- return $open.join(',',@coords).$close;
+ return $open.join(',',@coords).$close unless $self->{ColumnVector};
+ '\left[\begin{array}{c}'.join('\cr'."\n",@coords).'\cr\end{array}\right]';
}
#
Index: Context.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context.pm,v
retrieving revision 1.11
retrieving revision 1.11.2.1
diff -Llib/Parser/Context.pm -Llib/Parser/Context.pm -u -r1.11 -r1.11.2.1
--- lib/Parser/Context.pm
+++ lib/Parser/Context.pm
@@ -157,7 +157,7 @@
last;
};
- Value::Error("Precedence type should be one of 'Standard' or 'Non-standard'");
+ Value::Error("Precedence type should be one of 'Standard' or 'Non-Standard'");
}
}
Index: Function.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function.pm,v
retrieving revision 1.10
retrieving revision 1.10.2.1
diff -Llib/Parser/Function.pm -Llib/Parser/Function.pm -u -r1.10 -r1.10.2.1
--- lib/Parser/Function.pm
+++ lib/Parser/Function.pm
@@ -109,6 +109,7 @@
my $class = $fn->{class};
my $result = eval {$class->_call($name,@_)};
return $result unless $@;
+ Value::Error($context->{error}{message}) if $context->{error}{message};
Value::Error("Can't take $name of ".join(',',@_));
}
#
@@ -126,7 +127,6 @@
my $formula = Value::Formula->blank;
my @args = Value::toFormula($formula,@_);
$formula->{tree} = $formula->{context}{parser}{Function}->new($formula,$name,[@args]);
-# return $formula->eval if scalar(%{$formula->{variables}}) == 0;
return $formula;
}
Index: Differentiation.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Differentiation.pm,v
retrieving revision 1.3
retrieving revision 1.3.2.1
diff -Llib/Parser/Differentiation.pm -Llib/Parser/Differentiation.pm -u -r1.3 -r1.3.2.1
--- lib/Parser/Differentiation.pm
+++ lib/Parser/Differentiation.pm
@@ -103,11 +103,11 @@
$self =
$parser->{Function}->new($equation,'exp',
[$parser->{BOP}->new($equation,'*',$self->{rop}->copy($equation),
- $parser->{Function}->new($equation,'log',[$self->{lop}->copy($equation)],0))]);
+ $parser->{Function}->new($equation,'ln',[$self->{lop}->copy($equation)],0))]);
return $self->D($x);
}
$self = $parser->{BOP}->new($equation,'*',
- $parser->{Function}->new($equation,'log',[$self->{lop}->copy($equation)],0),
+ $parser->{Function}->new($equation,'ln',[$self->{lop}->copy($equation)],0),
$parser->{BOP}->new($equation,'*',
$self->copy($equation),$self->{rop}->D($x))
);
@@ -534,13 +534,19 @@
sub Parser::Function::numeric::D {Parser::Function::D_chain(@_)}
-sub Parser::Function::numeric::D_log {
+sub Parser::Function::numeric::D_ln {
my $self = shift; my $x = shift;
my $equation = $self->{equation};
my $parser = $equation->{context}{parser};
return $parser->{BOP}->new($equation,'/',$parser->{Number}->new($equation,1),$x);
}
+sub Parser::Function::numeric::D_log {
+ my $self = $_[0];
+ my $base10 = $self->{equation}{context}{flags}{useBaseTenLog};
+ if ($base10) {return D_log10(@_)} else {return D_ln(@_)}
+}
+
sub Parser::Function::numeric::D_log10 {
my $self = shift; my $x = shift;
my $equation = $self->{equation};
@@ -555,12 +561,12 @@
}
sub Parser::Function::numeric::D_exp {
- my $self = shift; my $x = shift;
+ my $self = shift;
return $self->copy();
}
sub Parser::Function::numeric::D_sqrt {
- my $self = shift; my $x = shift;
+ my $self = shift;
my $equation = $self->{equation};
my $parser = $equation->{context}{parser};
return
@@ -573,7 +579,13 @@
);
}
-sub Parser::Function::numeric::D_abs {Parser::Function::D(@_)}
+sub Parser::Function::numeric::D_abs {
+ my $self = shift; my $x = shift;
+ my $equation = $self->{equation};
+ my $parser = $equation->{context}{parser};
+ return $parser->{BOP}->new($equation,'/',$x,$self->copy);
+}
+
sub Parser::Function::numeric::D_int {Parser::Function::D(@_)}
sub Parser::Function::numeric::D_sgn {Parser::Function::D(@_)}
@@ -593,8 +605,10 @@
}
sub Parser::List::AbsoluteValue::D {
- my $self = shift;
- $self->Error("Can't differentiate absolute values");
+ my $self = shift; my $x = $self->{coords}[0]->copy;
+ my $equation = $self->{equation};
+ my $parser = $equation->{context}{parser};
+ return $parser->{BOP}->new($equation,'/', $x, $self->copy);
}
Index: UOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/UOP.pm,v
retrieving revision 1.11
retrieving revision 1.11.2.1
diff -Llib/Parser/UOP.pm -Llib/Parser/UOP.pm -u -r1.11 -r1.11.2.1
--- lib/Parser/UOP.pm
+++ lib/Parser/UOP.pm
@@ -20,7 +20,8 @@
$UOP->_check;
$UOP->{isConstant} = 1 if $op->{isConstant};
$UOP = $context->{parser}{Value}->new($equation,[$UOP->eval])
- if $op->{isConstant} && (!$UOP->isNeg || $op->isNeg) && $context->flag('reduceConstants');
+ if $op->{isConstant} && (!$UOP->isNeg || $op->isNeg) &&
+ ($context->flag('reduceConstants') || $op->{isInfinity});
return $UOP;
}
Index: Vector.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/List/Vector.pm,v
retrieving revision 1.3
retrieving revision 1.3.2.1
diff -Llib/Parser/List/Vector.pm -Llib/Parser/List/Vector.pm -u -r1.3 -r1.3.2.1
--- lib/Parser/List/Vector.pm
+++ lib/Parser/List/Vector.pm
@@ -7,10 +7,20 @@
@ISA = qw(Parser::List);
#
-# The basic List class does nearly everything. We only need this class
-# for its name.
+# The basic List class does nearly everything.
#
+#
+# Check that the coordinates are numbers (avoid <i+j+k>)
+#
+sub _check {
+ my $self = shift;
+ foreach my $x (@{$self->{coords}}) {
+ $self->{equation}->Error("Coordinates of Vector must be Numbers")
+ unless $x->isNumber;
+ }
+}
+
my $ijk_string = ['i','j','k','0'];
my $ijk_TeX = ['\boldsymbol{i}','\boldsymbol{j}','\boldsymbol{k}','\boldsymbol(0)'];
Index: Real.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Real.pm,v
retrieving revision 1.10
retrieving revision 1.10.2.1
diff -Llib/Value/Real.pm -Llib/Value/Real.pm -u -r1.10 -r1.10.2.1
--- lib/Value/Real.pm
+++ lib/Value/Real.pm
@@ -11,41 +11,44 @@
@ISA = qw(Value);
use overload
- '+' => \&add,
- '-' => \&sub,
- '*' => \&mult,
- '/' => \&div,
- '**' => \&power,
+ '+' => sub {shift->add(@_)},
+ '-' => sub {shift->sub(@_)},
+ '*' => sub {shift->mult(@_)},
+ '/' => sub {shift->div(@_)},
+ '**' => sub {shift->power(@_)},
'.' => \&Value::_dot,
- 'x' => \&Value::cross,
- '<=>' => \&compare,
- 'cmp' => \&Value::cmp,
- 'neg' => sub {$_[0]->neg},
- 'abs' => sub {$_[0]->abs},
- 'sqrt'=> sub {$_[0]->sqrt},
- 'exp' => sub {$_[0]->exp},
- 'log' => sub {$_[0]->log},
- 'sin' => sub {$_[0]->sin},
- 'cos' => sub {$_[0]->cos},
- 'atan2' => \&atan2,
- 'nomethod' => \&Value::nomethod,
- '""' => \&Value::stringify;
+ 'x' => sub {shift->cross(@_)},
+ '<=>' => sub {shift->compare(@_)},
+ 'cmp' => sub {shift->compare_string(@_)},
+ 'neg' => sub {shift->neg},
+ 'abs' => sub {shift->abs},
+ 'sqrt'=> sub {shift->sqrt},
+ 'exp' => sub {shift->exp},
+ 'log' => sub {shift->log},
+ 'sin' => sub {shift->sin},
+ 'cos' => sub {shift->cos},
+ 'atan2' => sub {shift->atan2(@_)},
+ 'nomethod' => sub {shift->nomethod(@_)},
+ '""' => sub {shift->stringify(@_)};
#
# Check that the input is a real number or a formula
-# Make a formula if either part is a formula
+# or a string that evaluates to a number
#
sub new {
my $self = shift; my $class = ref($self) || $self;
my $x = shift; $x = [$x,@_] if scalar(@_) > 0;
- $x = $x->data if ref($x) eq $pkg;
+ return $x if ref($x) eq $pkg;
$x = [$x] unless ref($x) eq 'ARRAY';
- Value::Error("Can't convert ARRAY of length ".scalar(@{$x})." to a Real Number")
+ Value::Error("Can't convert ARRAY of length ".scalar(@{$x})." to ".Value::showClass($class))
unless (scalar(@{$x}) == 1);
- Value::Error("Real Number can't be ".Value::showClass($x->[0]))
- unless (Value::isRealNumber($x->[0]));
- return $self->formula($x->[0]) if Value::isFormula($x->[0]);
- bless {data => $x}, $class;
+ if (Value::isRealNumber($x->[0])) {
+ return $self->formula($x->[0]) if Value::isFormula($x->[0]);
+ return (bless {data => $x}, $class);
+ }
+ $x = Value::makeValue($x->[0]);
+ return $x if Value::isRealNumber($x);
+ Value::Error("Can't convert ".Value::showClass($x)." to ".Value::showClass($class));
}
#
@@ -69,6 +72,7 @@
# Return the real number type
#
sub typeRef {return $Value::Type{number}}
+sub length {1}
#
# return the real number
Index: Complex.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Complex.pm,v
retrieving revision 1.11
retrieving revision 1.11.2.1
diff -Llib/Value/Complex.pm -Llib/Value/Complex.pm -u -r1.11 -r1.11.2.1
--- lib/Value/Complex.pm
+++ lib/Value/Complex.pm
@@ -8,32 +8,33 @@
@ISA = qw(Value);
use overload
- '+' => \&add,
- '-' => \&sub,
- '*' => \&mult,
- '/' => \&div,
- '**' => \&power,
+ '+' => sub {shift->add(@_)},
+ '-' => sub {shift->sub(@_)},
+ '*' => sub {shift->mult(@_)},
+ '/' => sub {shift->div(@_)},
+ '**' => sub {shift->power(@_)},
'.' => \&Value::_dot,
- 'x' => \&Value::cross,
- '<=>' => \&compare,
- 'cmp' => \&Value::cmp,
- '~' => sub {$_[0]->conj},
- 'neg' => sub {$_[0]->neg},
- 'abs' => sub {$_[0]->norm},
- 'sqrt'=> sub {$_[0]->sqrt},
- 'exp' => sub {$_[0]->exp},
- 'log' => sub {$_[0]->log},
- 'sin' => sub {$_[0]->sin},
- 'cos' => sub {$_[0]->cos},
- 'atan2' => \&atan2,
- 'nomethod' => \&Value::nomethod,
- '""' => \&Value::stringify;
+ 'x' => sub {shift->cross(@_)},
+ '<=>' => sub {shift->compare(@_)},
+ 'cmp' => sub {shift->compare_string(@_)},
+ '~' => sub {shift->conj},
+ 'neg' => sub {shift->neg},
+ 'abs' => sub {shift->norm},
+ 'sqrt'=> sub {shift->sqrt},
+ 'exp' => sub {shift->exp},
+ 'log' => sub {shift->log},
+ 'sin' => sub {shift->sin},
+ 'cos' => sub {shift->cos},
+ 'atan2' => sub {shift->atan2(@_)},
+ 'nomethod' => sub {shift->nomethod(@_)},
+ '""' => sub {shift->stringify(@_)};
#
# Check that the inputs are:
# one or two real numbers, or
# an array ref of one or two reals, or
# a Value::Complex object
+# a formula returning a real or complex
# Make a formula if either part is a formula
#
sub new {
@@ -44,6 +45,7 @@
Value::Error("Can't convert ARRAY of length ".scalar(@{$x})." to a Complex Number")
unless (scalar(@{$x}) == 2);
$x->[0] = Value::makeValue($x->[0]); $x->[1] = Value::makeValue($x->[1]);
+ return $x->[0] if Value::isComplex($x->[0]) && scalar(@_) == 0;
Value::Error("Real part can't be ".Value::showClass($x->[0]))
unless (Value::isRealNumber($x->[0]));
Value::Error("Imaginary part can't be ".Value::showClass($x->[1]))
@@ -71,6 +73,7 @@
# Return the complex type
#
sub typeRef {return $Value::Type{complex}}
+sub length {2}
sub isZero {shift eq "0"}
sub isOne {shift eq "1"}
@@ -156,7 +159,7 @@
sub compare {
my ($l,$r,$flag) = @_;
- if ($l->promotePrecedence($r)) {return $r->power($l,!$flag)}
+ if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
$r = promote($r);
if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
my ($a,$b) = (@{$l->data});
Index: List.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/List.pm,v
retrieving revision 1.13
retrieving revision 1.13.2.1
diff -Llib/Value/List.pm -Llib/Value/List.pm -u -r1.13 -r1.13.2.1
--- lib/Value/List.pm
+++ lib/Value/List.pm
@@ -10,13 +10,13 @@
@ISA = qw(Value);
use overload
- '+' => \&add,
+ '+' => sub {shift->add(@_)},
'.' => \&Value::_dot,
- 'x' => \&Value::cross,
- '<=>' => \&compare,
- 'cmp' => \&Value::cmp,
- 'nomethod' => \&Value::nomethod,
- '""' => \&stringify;
+ 'x' => sub {shift->cross(@_)},
+ '<=>' => sub {shift->compare(@_)},
+ 'cmp' => sub {shift->compare_string(@_)},
+ 'nomethod' => sub {shift->nomethod(@_)},
+ '""' => sub {shift->stringify(@_)};
#
# Make a List out of a list of entries or a
@@ -43,7 +43,6 @@
#
# Return the proper data
#
-sub length {return scalar(@{shift->{data}})}
sub typeRef {
my $self = shift;
return Value::Type($self->class, $self->length, Value::Type($self->{type},1));
Index: String.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/String.pm,v
retrieving revision 1.3
retrieving revision 1.3.2.1
diff -Llib/Value/String.pm -Llib/Value/String.pm -u -r1.3 -r1.3.2.1
--- lib/Value/String.pm
+++ lib/Value/String.pm
@@ -9,10 +9,10 @@
use overload
'.' => \&Value::_dot,
- '<=>' => \&compare,
- 'cmp' => \&compare,
- 'nomethod' => \&Value::nomethod,
- '""' => \&Value::stringify;
+ '<=>' => sub {shift->compare(@_)},
+ 'cmp' => sub {shift->compare(@_)},
+ 'nomethod' => sub {shift->nomethod(@_)},
+ '""' => sub {shift->stringify(@_)};
#
# Create a string object
@@ -21,7 +21,7 @@
my $self = shift; my $class = ref($self) || $self;
my $x = join('',@_);
if ($Parser::installed) {
- Value::Error("Unrecognized string '$x'")
+ Value::Error("String constant '$x' is not defined in this context")
unless $$Value::context->{strings}{$x};
}
bless {data => [$x]}, $class;
@@ -44,7 +44,7 @@
#
sub promote {
my $x = shift; $x = [$x,@_] if scalar(@_) > 0;
- $x = Value::makeValue($x); $x = join('',@{$x}) if ref($x) eq 'ARRAY';
+ $x = Value::makeValue($x,showError=>1); $x = join('',@{$x}) if ref($x) eq 'ARRAY';
$x = $pkg->make($x) unless Value::isValue($x);
return $x;
}
Index: Union.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Union.pm,v
retrieving revision 1.11
retrieving revision 1.11.2.1
diff -Llib/Value/Union.pm -Llib/Value/Union.pm -u -r1.11 -r1.11.2.1
--- lib/Value/Union.pm
+++ lib/Value/Union.pm
@@ -8,13 +8,13 @@
@ISA = qw(Value);
use overload
- '+' => \&add,
+ '+' => sub {shift->add(@_)},
'.' => \&Value::_dot,
- 'x' => \&Value::cross,
- '<=>' => \&compare,
- 'cmp' => \&Value::cmp,
- 'nomethod' => \&Value::nomethod,
- '""' => \&Value::stringify;
+ 'x' => sub {shift->cross(@_)},
+ '<=>' => sub {shift->compare(@_)},
+ 'cmp' => sub {shift->compare_string(@_)},
+ 'nomethod' => sub {shift->nomethod(@_)},
+ '""' => sub {shift->stringify(@_)};
#
# Convert a value to a union of intervals. The value must be
@@ -51,7 +51,6 @@
#
# Return the appropriate data.
#
-sub length {return scalar(@{shift->{data}})}
sub typeRef {
my $self = shift;
return Value::Type($self->class, $self->length, $self->data->[0]->typeRef);
Index: Infinity.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Infinity.pm,v
retrieving revision 1.6
retrieving revision 1.6.2.1
diff -Llib/Value/Infinity.pm -Llib/Value/Infinity.pm -u -r1.6 -r1.6.2.1
--- lib/Value/Infinity.pm
+++ lib/Value/Infinity.pm
@@ -9,11 +9,11 @@
use overload
'.' => \&Value::_dot,
- '<=>' => \&compare,
- 'cmp' => \&Value::cmp,
- 'neg' => \&neg,
- 'nomethod' => \&Value::nomethod,
- '""' => \&Value::stringify;
+ '<=>' => sub {shift->compare(@_)},
+ 'cmp' => sub {shift->compare_string(@_)},
+ 'neg' => sub {shift->neg(@_)},
+ 'nomethod' => sub {shift->nomethod(@_)},
+ '""' => sub {shift->stringify(@_)};
#
# Create an infinity object
Index: Vector.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Vector.pm,v
retrieving revision 1.11
retrieving revision 1.11.2.1
diff -Llib/Value/Vector.pm -Llib/Value/Vector.pm -u -r1.11 -r1.11.2.1
--- lib/Value/Vector.pm
+++ lib/Value/Vector.pm
@@ -10,29 +10,32 @@
@ISA = qw(Value);
use overload
- '+' => \&add,
- '-' => \&sub,
- '*' => \&mult,
- '/' => \&div,
- '**' => \&power,
+ '+' => sub {shift->add(@_)},
+ '-' => sub {shift->sub(@_)},
+ '*' => sub {shift->mult(@_)},
+ '/' => sub {shift->div(@_)},
+ '**' => sub {shift->power(@_)},
'.' => \&Value::_dot,
- 'x' => \&cross,
- '<=>' => \&compare,
- 'cmp' => \&Value::cmp,
- 'neg' => sub {$_[0]->neg},
- 'abs' => sub {$_[0]->abs},
- 'nomethod' => \&Value::nomethod,
- '""' => \&stringify;
+ 'x' => sub {shift->cross(@_)},
+ '<=>' => sub {shift->compare(@_)},
+ 'cmp' => sub {shift->compare_string(@_)},
+ 'neg' => sub {shift->neg},
+ 'abs' => sub {shift->abs},
+ 'nomethod' => sub {shift->nomethod(@_)},
+ '""' => sub {shift->stringify(@_)};
#
# Convert a value to a Vector. The value can be
# a list of numbers, or an reference to an array of numbers
# a point or vector object (demote a vector)
# a matrix if it is n x 1 or 1 x n
+# a string that parses to a vector
#
sub new {
my $self = shift; my $class = ref($self) || $self;
my $p = shift; $p = [$p,@_] if (scalar(@_) > 0);
+ $p = Value::makeValue($p) if (defined($p) && !ref($p));
+ return $p if (Value::isFormula($p) && $p->type eq Value::class($self));
my $pclass = Value::class($p); my $isFormula = 0;
my @d; @d = $p->dimensions if $pclass eq 'Matrix';
if ($pclass =~ m/Point|Vector/) {$p = $p->data}
@@ -43,22 +46,26 @@
$p = [$p] if (defined($p) && ref($p) ne 'ARRAY');
Value::Error("Vectors must have at least one coordinate") unless defined($p) && scalar(@{$p}) > 0;
foreach my $x (@{$p}) {
+ $x = Value::makeValue($x);
$isFormula = 1 if Value::isFormula($x);
Value::Error("Coordinate of Vector can't be ".Value::showClass($x))
unless Value::isNumber($x);
- $x = Value::Real->make($x) unless ref($x);
}
}
- return $self->formula($p) if $isFormula;
- bless {data => $p}, $class;
+ if ($isFormula) {
+ my $v = $self->formula($p);
+ if (ref($self) && $self->{ColumnVector}) {
+ $v->{tree}{ColumnVector} = 1;
+ $v->{tree}{open} = $v->{tree}{close} = undef;
+ }
+ return $v;
+ }
+ my $v = bless {data => $p}, $class;
+ $v->{ColumnVector} = 1 if ref($self) && $self->{ColumnVector};
+ return $v;
}
#
-# The number of coordinates
-#
-sub length {return scalar(@{shift->{data}})}
-
-#
# Try to promote arbitary data to a vector
#
sub promote {
@@ -138,7 +145,7 @@
sub cross {
my ($l,$r,$flag) = @_;
- if ($l->promotePrecedence($r)) {return $r->dot($l,!$flag)}
+ if ($l->promotePrecedence($r)) {return $r->cross($l,!$flag)}
($l,$r) = (promote($l)->data,promote($r)->data);
Value::Error("Vector must be in 3-space for cross product")
unless scalar(@{$l}) == 3 && scalar(@{$r}) == 3;
@@ -241,8 +248,8 @@
sub stringify {
my $self = shift;
- return $self->TeX(undef,$self->{open},$self->{close}) if $$Value::context->flag('StringifyAsTeX');
- return $self->string(undef,$self->{open},$self->{close})
+ return $self->TeX if $$Value::context->flag('StringifyAsTeX');
+ return $self->string(undef,$self->{open},$self->{close});
};
sub string {
@@ -250,7 +257,7 @@
return $self->ijk($ijk_string)
if ($self->{ijk} || $equation->{ijk} || $$Value::context->flag("ijk"));
my $def = ($equation->{context} || $$Value::context)->lists->get('Vector');
- my $open = shift || $def->{open}; my $close = shift || $def->{close};
+ my $open = shift || $def->{open}; my $close = shift || $def->{close};
my @coords = ();
foreach my $x (@{$self->data}) {
if (Value::isValue($x)) {push(@coords,$x->string($equation))} else {push(@coords,$x)}
@@ -262,12 +269,17 @@
my $self = shift; my $equation = shift;
return $self->ijk if ($self->{ijk} || $equation->{ijk} || $$Value::context->flag("ijk"));
my $def = ($equation->{context} || $$Value::context)->lists->get('Vector');
- my $open = shift || $def->{open}; my $close = shift || $def->{close};
+ my $open = shift || $self->{open} || $def->{open};
+ my $close = shift || $self->{close} || $def->{close};
my @coords = ();
foreach my $x (@{$self->data}) {
if (Value::isValue($x)) {push(@coords,$x->TeX($equation))} else {push(@coords,$x)}
}
- return '\left'.$open.join(',',@coords).'\right'.$close;
+ return '\left'.$open.join(',',@coords).'\right'.$close unless $self->{ColumnVector};
+ $def = ($equation->{context} || $$Value::context)->lists->get('Matrix');
+ $open = shift || $self->{open} || $def->{open};
+ $close = shift || $self->{close} || $def->{close};
+ return '\left'.$open.'\begin{array}{c}'.join('\\\\',@coords).'\\\\\end{array}\right'.$close;
}
sub ijk {
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.38
retrieving revision 1.38.2.1
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.38 -r1.38.2.1
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -26,18 +26,23 @@
sub cmp {
my $self = shift;
my $ans = new AnswerEvaluator;
+ my $correct = protectHTML($self->{correct_ans});
+ $correct = $self->correct_ans unless defined($correct);
$ans->ans_hash(
type => "Value (".$self->class.")",
- correct_ans => protectHTML($self->string),
+ correct_ans => $correct,
correct_value => $self,
- $self->cmp_defaults,
+ $self->cmp_defaults(@_),
@_
);
$ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)});
+ $ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array
$self->{context} = $$Value::context unless defined($self->{context});
return $ans;
}
+sub correct_ans {protectHTML(shift->string)}
+
#
# Parse the student answer and compute its value,
# produce the preview strings, and then compare the
@@ -81,10 +86,13 @@
$ans->{preview_latex_string} = $ans->{student_formula}->TeX;
$ans->{preview_text_string} = protectHTML($ans->{student_formula}->string);
$ans->{student_ans} = $ans->{preview_text_string};
- $self->cmp_equal($ans);
- $self->cmp_postprocess($ans) if !$ans->{error_message};
+ if ($self->cmp_collect($ans)) {
+ $self->cmp_equal($ans);
+ $self->cmp_postprocess($ans) if !$ans->{error_message};
+ }
} else {
$self->cmp_error($ans);
+ $self->cmp_collect($ans);
}
contextSet($context,%{$flags}); # restore context values
Parser::Context->current(undef,$current); # put back the old context
@@ -92,6 +100,37 @@
}
#
+# Check if the object has an answer array and collect the results
+# Build the combined student answer and set the preview values
+#
+sub cmp_collect {
+ my $self = shift; my $ans = shift;
+ return 1 unless $self->{ans_name};
+ $ans->{preview_latex_string} = $ans->{preview_text_string} = "";
+ my $OK = $self->ans_collect($ans);
+ $ans->{student_ans} = $self->format_matrix($ans->{student_formula},@{$self->{format_options}},tth_delims=>1);
+ return 0 unless $OK;
+ my $array = $ans->{student_formula};
+ if ($self->{ColumnVector}) {
+ my @V = (); foreach my $x (@{$array}) {push(@V,$x->[0])}
+ $array = [@V];
+ } elsif (scalar(@{$array}) == 1) {$array = $array->[0]}
+ my $type = $self;
+ $type = "Value::".$self->{tree}->type if $self->class eq 'Formula';
+ $ans->{student_formula} = eval {$type->new($array)->with(ColumnVector=>$self->{ColumnVector})};
+ if (!defined($ans->{student_formula}) || $$Value::context->{error}{flag})
+ {Parser::reportEvalError($@); return 0}
+ $ans->{student_value} = $ans->{student_formula};
+ $ans->{preview_text_string} = $ans->{student_ans};
+ $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
+ if (Value::isFormula($ans->{student_formula}) && $ans->{student_formula}->isConstant) {
+ $ans->{student_value} = Parser::Evaluate($ans->{student_formula});
+ return 0 unless $ans->{student_value};
+ }
+ return 1;
+}
+
+#
# Check if the parsed student answer equals the professor's answer
#
sub cmp_equal {
@@ -99,19 +138,41 @@
my $correct = $ans->{correct_value};
my $student = $ans->{student_value};
if ($correct->typeMatch($student,$ans)) {
- my $equal = eval {$correct == $student};
+ my $equal = $correct->cmp_compare($student,$ans);
if (defined($equal) || !$ans->{showEqualErrors}) {$ans->score(1) if $equal; return}
$self->cmp_error($ans);
} else {
return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
$ans->{ans_message} = $ans->{error_message} =
- "Your answer isn't ".lc($ans->{cmp_class}).
- " (it looks like ".lc($student->showClass).")"
+ "Your answer isn't ".lc($ans->{cmp_class}).'<BR>'.
+ "(it looks like ".lc($student->showClass).")"
if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
}
}
#
+# Perform the comparison, either using the checker supplied
+# by the answer evaluator, or the overloaded == operator.
+#
+
+our $CMP_ERROR = 2; # a fatal error was detected
+
+sub cmp_compare {
+ my $self = shift; my $other = shift; my $ans = shift;
+ return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE';
+ my $equal = eval {&{$ans->{checker}}($self,$other,$ans)};
+ if (!defined($equal) && $@ ne '' && !$$Value::context->{error}{flag}) {
+ $$Value::context->setError("<I>An error occurred while checking your answer:</I>\n".
+ '<DIV STYLE="margin-left:1em">'.$@.'</DIV>','');
+ $$Value::context->{error}{flag} = $CMP_ERROR;
+ warn "Please inform your instructor that an error occurred while checking your answer";
+ }
+ return $equal;
+}
+
+sub cmp_list_compare {Value::List::cmp_list_compare(@_)}
+
+#
# Check if types are compatible for equality check
#
sub typeMatch {
@@ -137,11 +198,11 @@
#
sub cmp_error {
my $self = shift; my $ans = shift;
- my $context = $$Value::context;
- my $message = $context->{error}{message};
- if ($context->{error}{pos}) {
- my $string = $context->{error}{string};
- my ($s,$e) = @{$context->{error}{pos}};
+ my $error = $$Value::context->{error};
+ my $message = $error->{message};
+ if ($error->{pos}) {
+ my $string = $error->{string};
+ my ($s,$e) = @{$error->{pos}};
$message =~ s/; see.*//; # remove the position from the message
$ans->{student_ans} =
protectHTML(substr($string,0,$s)) .
@@ -169,6 +230,239 @@
sub cmp_postprocess {}
#
+# create answer rules of various types
+#
+sub ans_rule {shift; pgCall('ans_rule',@_)}
+sub named_ans_rule {shift; pgCall('NAMED_ANS_RULE',@_)}
+sub named_ans_rule_extension {shift; pgCall('NAMED_ANS_RULE_EXTENSION',@_)}
+sub ans_array {shift->ans_rule(@_)};
+sub named_ans_array {shift->named_ans_rule(@_)};
+sub named_ans_array_extension {shift->named_ans_rule_extension(@_)};
+
+sub pgCall {my $call = shift; &{WeBWorK::PG::Translator::PG_restricted_eval('\&'.$call)}(@_)}
+sub pgRef {WeBWorK::PG::Translator::PG_restricted_eval('\&'.shift)}
+
+our $answerPrefix = "MaTrIx";
+
+#
+# Lay out a matrix of answer rules
+#
+sub ans_matrix {
+ my $self = shift;
+ my ($extend,$name,$rows,$cols,$size,$open,$close,$sep) = @_;
+ my $named_extension = pgRef('NAMED_ANS_RULE_EXTENSION');
+ my $new_name = pgRef('RECORD_FORM_LABEL');
+ my $HTML = ""; my $ename = $name;
+ if ($name eq '') {
+ my $n = pgCall('inc_ans_rule_count');
+ $name = pgCall('NEW_ANS_NAME',$n);
+ $ename = $answerPrefix.$n;
+ }
+ $self->{ans_name} = $ename;
+ $self->{ans_rows} = $rows;
+ $self->{ans_cols} = $cols;
+ my @array = ();
+ foreach my $i (0..$rows-1) {
+ my @row = ();
+ foreach my $j (0..$cols-1) {
+ if ($i == 0 && $j == 0) {
+ if ($extend) {push(@row,&$named_extension(&$new_name($name),$size))}
+ else {push(@row,pgCall('NAMED_ANS_RULE',$name,$size))}
+ } else {
+ push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size));
+ }
+ }
+ push(@array,[@row]);
+ }
+ $self->format_matrix([@array],open=>$open,close=>$close,sep=>$sep);
+}
+
+sub ANS_NAME {
+ my ($name,$i,$j) = @_;
+ $name.'_'.$i.'_'.$j;
+}
+
+
+#
+# Lay out an arbitrary matrix
+#
+sub format_matrix {
+ my $self = shift;
+ my $displayMode = $self->getPG('$displayMode');
+ return $self->format_matrix_tex(@_) if ($displayMode eq 'TeX');
+ return $self->format_matrix_HTML(@_);
+}
+
+sub format_matrix_tex {
+ my $self = shift; my $array = shift;
+ my %options = (open=>'.',close=>'.',sep=>'',@_);
+ $self->{format_options} = [%options] unless $self->{format_options};
+ my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
+ my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
+ my $tex = "";
+ $open = '\\'.$open if $open =~ m/[{}]/; $close = '\\'.$close if $close =~ m/[{}]/;
+ $tex .= '\(\left'.$open;
+ $tex .= '\setlength{\arraycolsep}{2pt}', $sep = '\,'.$sep if $sep;
+ $tex .= '\begin{array}{'.('c'x$cols).'}';
+ foreach my $i (0..$rows-1) {$tex .= join($sep.'&',@{$array->[$i]}).'\cr'."\n"}
+ $tex .= '\end{array}\right'.$close.'\)';
+ return $tex;
+}
+
+sub format_matrix_HTML {
+ my $self = shift; my $array = shift;
+ my %options = (open=>'',close=>'',sep=>'',tth_delims=>0,@_);
+ $self->{format_options} = [%options] unless $self->{format_options};
+ my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
+ my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
+ my $HTML = "";
+ if ($sep) {$sep = '</TD><TD STYLE="padding: 0px 1px">'.$sep.'</TD><TD>'}
+ else {$sep = '</TD><TD WIDTH="8px"></TD><TD>'}
+ foreach my $i (0..$rows-1) {
+ $HTML .= '<TR><TD HEIGHT="6px"></TD></TR>' if $i;
+ $HTML .= '<TR ALIGN="MIDDLE"><TD>'.join($sep,@{$array->[$i]}).'</TD></TR>'."\n";
+ }
+ $open = $self->format_delimiter($open,$rows,$options{tth_delims});
+ $close = $self->format_delimiter($close,$rows,$options{tth_delims});
+ if ($open ne '' || $close ne '') {
+ $HTML = '<TR ALIGN="MIDDLE">'
+ . '<TD>'.$open.'</TD>'
+ . '<TD WIDTH="2"></TD>'
+ . '<TD><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">'
+ . $HTML
+ . '</TABLE></TD>'
+ . '<TD WIDTH="4"></TD>'
+ . '<TD>'.$close.'</TD>'
+ . '</TR>'."\n";
+ }
+ return '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout"'
+ . ' STYLE="display:inline;vertical-align:-'.(1.1*$rows-.6).'em">'
+ . $HTML
+ . '</TABLE>';
+}
+
+sub VERBATIM {
+ my $string = shift;
+ my $displayMode = Value->getPG('$displayMode');
+ $string = '\end{verbatim}'.$string.'\begin{verbatim}' if $displayMode eq 'TeX';
+ return $string;
+}
+
+#
+# Create a tall delimiter to match the line height
+#
+sub format_delimiter {
+ my $self = shift; my $delim = shift; my $rows = shift; my $tth = shift;
+ return '' if $delim eq '' || $delim eq '.';
+ my $displayMode = $self->getPG('$displayMode');
+ return $self->format_delimiter_tth($delim,$rows,$tth)
+ if $tth || $displayMode eq 'HTML_tth' || $displayMode !~ m/^HTML_/;
+ my $rule = '\vrule width 0pt height '.(.8*$rows).'em depth 0pt';
+ $rule = '\rule 0pt '.(.8*$rows).'em 0pt' if $displayMode eq 'HTML_jsMath';
+ $delim = '\\'.$delim if $delim eq '{' || $delim eq '}';
+ return '\(\left'.$delim.$rule.'\right.\)';
+}
+
+#
+# Data for tth delimiters [top,mid,bot,rep]
+#
+my %tth_delim = (
+ '[' => ['','','',''],
+ ']' => ['','','',''],
+ '(' => ['','','',''],
+ ')' => ['','','',''],
+ '{' => ['','','',''],
+ '}' => ['','','',''],
+ '|' => ['|','','|','|'],
+ '<' => ['<'],
+ '>' => ['>'],
+ '\lgroup' => ['','','',''],
+ '\rgroup' => ['','','',''],
+);
+
+#
+# Make delimiters as stacks of characters
+#
+sub format_delimiter_tth {
+ my $self = shift;
+ my $delim = shift; my $rows = shift; my $tth = shift;
+ return '' if $delim eq '' || !defined($tth_delim{$delim});
+ my $c = $delim; $delim = $tth_delim{$delim};
+ $c = $delim->[0] if scalar(@{$delim}) == 1;
+ my $size = ($tth? "": "font-size:175%; ");
+ return '<SPAN STYLE="'.$size.'margin:0px 2px">'.$c.'</SPAN>'
+ if $rows == 1 || scalar(@{$delim}) == 1;
+ my $HTML = "";
+ if ($delim->[1] eq '') {
+ $HTML = join('<BR>',$delim->[0],($delim->[3])x(2*($rows-1)),$delim->[2]);
+ } else {
+ $HTML = join('<BR>',$delim->[0],($delim->[3])x($rows-1),
+ $delim->[1],($delim->[3])x($rows-1),
+ $delim->[2]);
+ }
+ return '<DIV STYLE="line-height:90%; margin: 0px 2px">'.$HTML.'</DIV>';
+}
+
+
+#
+# Look up the values of the answer array entries, and check them
+# for syntax and other errors. Build the student answer
+# based on these, and keep track of error messages.
+#
+
+my @ans_defaults = (showCoodinateHints => 0, checker => sub {0});
+
+sub ans_collect {
+ my $self = shift; my $ans = shift;
+ my $inputs = $self->getPG('$inputs_ref');
+ my $blank = ($self->getPG('$displayMode') eq 'TeX') ? '\_\_' : '__';
+ my ($rows,$cols) = ($self->{ans_rows},$self->{ans_cols});
+ my @array = (); my $data = [$self->value]; my $errors = []; my $OK = 1;
+ if ($self->{ColumnVector}) {foreach my $x (@{$data}) {$x = [$x]}}
+ $data = [$data] unless ref($data->[0]) eq 'ARRAY';
+ foreach my $i (0..$rows-1) {
+ my @row = ();
+ foreach my $j (0..$cols-1) {
+ if ($i || $j) {
+ my $entry = $inputs->{ANS_NAME($self->{ans_name},$i,$j)};
+ my $result = $data->[$i][$j]->cmp(@ans_cmp_defaults)->evaluate($entry);
+ $OK &= entryCheck($result,$blank);
+ push(@row,$result->{student_formula});
+ entryMessage($result->{ans_message},$errors,$i,$j,$rows);
+ } else {
+ $ans->{student_formula} = $ans->{student_value} = undef unless $ans->{student_ans} =~ m/\S/;
+ $OK &= entryCheck($ans,$blank);
+ push(@row,$ans->{student_formula});
+ entryMessage($ans->{ans_message},$errors,$i,$j,$rows);
+ }
+ }
+ push(@array,[@row]);
+ }
+ $ans->{student_formula} = [@array];
+ $ans->{ans_message} = $ans->{error_message} = join("<BR>",@{$errors});
+ return $OK && scalar(@{$errors}) == 0;
+}
+
+sub entryMessage {
+ my $message = shift; return unless $message;
+ my ($errors,$i,$j,$rows) = @_; $i++; $j++;
+ if ($rows == 1) {$message = "Coordinate $j: $message"}
+ else {$message = "Entry ($i,$j): $message"}
+ push(@{$errors},$message);
+}
+
+sub entryCheck {
+ my $ans = shift; my $blank = shift;
+ return 1 if defined($ans->{student_value});
+ if (!defined($ans->{student_formula})) {
+ $ans->{student_formula} = $ans->{student_ans};
+ $ans->{student_formula} = $blank unless $ans->{student_formula};
+ }
+ return 0
+}
+
+
+#
# Get and Set values in context
#
sub contextSet {
@@ -216,7 +510,7 @@
package Value::Real;
sub cmp_defaults {(
- shift->SUPER::cmp_defaults,
+ shift->SUPER::cmp_defaults(@_),
ignoreInfinity => 1,
)}
@@ -247,7 +541,7 @@
package Value::String;
sub cmp_defaults {(
- Value::Real->cmp_defaults,
+ Value::Real->cmp_defaults(@_),
typeMatch => 'Value::Real',
)}
@@ -271,7 +565,7 @@
package Value::Point;
sub cmp_defaults {(
- shift->SUPER::cmp_defaults,
+ shift->SUPER::cmp_defaults(@_),
showDimensionHints => 1,
showCoordinateHints => 1,
)}
@@ -287,26 +581,46 @@
sub cmp_postprocess {
my $self = shift; my $ans = shift;
return unless $ans->{score} == 0 && !$ans->{isPreview};
- if ($ans->{showDimensionHints} &&
- $self->length != $ans->{student_value}->length) {
- $self->cmp_Error($ans,"The dimension of your result is incorrect"); return;
+ my $student = $ans->{student_value};
+ return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
+ if ($ans->{showDimensionHints} && $self->length != $student->length) {
+ $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
}
if ($ans->{showCoordinateHints}) {
my @errors;
foreach my $i (1..$self->length) {
push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
- if ($self->{data}[$i-1] != $ans->{student_value}{data}[$i-1]);
+ if ($self->{data}[$i-1] != $student->{data}[$i-1]);
}
$self->cmp_Error($ans,@errors); return;
}
}
+sub correct_ans {
+ my $self = shift;
+ return $self->SUPER::correct_ans unless $self->{ans_name};
+ Value::VERBATIM($self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1));
+}
+
+sub ANS_MATRIX {
+ my $self = shift;
+ my $extend = shift; my $name = shift;
+ my $size = shift || 5;
+ my $def = ($self->{context} || $$Value::context)->lists->get('Point');
+ my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
+ $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
+}
+
+sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
+sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
+sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
+
#############################################################
package Value::Vector;
sub cmp_defaults {(
- shift->SUPER::cmp_defaults,
+ shift->SUPER::cmp_defaults(@_),
showDimensionHints => 1,
showCoordinateHints => 1,
promotePoints => 0,
@@ -329,24 +643,51 @@
sub cmp_postprocess {
my $self = shift; my $ans = shift;
return unless $ans->{score} == 0;
+ my $student = $ans->{student_value};
+ return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
if (!$ans->{isPreview} && $ans->{showDimensionHints} &&
- $self->length != $ans->{student_value}->length) {
- $self->cmp_Error($ans,"The dimension of your result is incorrect"); return;
+ $self->length != $student->length) {
+ $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
}
if ($ans->{parallel} &&
- $self->isParallel($ans->{student_value},$ans->{sameDirection})) {
+ $self->isParallel($student,$ans->{sameDirection})) {
$ans->score(1); return;
}
if (!$ans->{isPreview} && $ans->{showCoordinateHints} && !$ans->{parallel}) {
my @errors;
foreach my $i (1..$self->length) {
push(@errors,"The ".$self->NameForNumber($i)." coordinate is incorrect")
- if ($self->{data}[$i-1] != $ans->{student_value}{data}[$i-1]);
+ if ($self->{data}[$i-1] != $student->{data}[$i-1]);
}
$self->cmp_Error($ans,@errors); return;
}
}
+sub correct_ans {
+ my $self = shift;
+ return $self->SUPER::correct_ans unless $self->{ans_name};
+ return Value::VERBATIM($self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1))
+ unless $self->{ColumnVector};
+ my @array = (); foreach my $x ($self->value) {push(@array,[$x])}
+ return Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
+}
+
+sub ANS_MATRIX {
+ my $self = shift;
+ my $extend = shift; my $name = shift;
+ my $size = shift || 5; my ($def,$open,$close);
+ $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
+ $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
+ return $self->ans_matrix($extend,$name,$self->length,1,$size,$open,$close)
+ if ($self->{ColumnVector});
+ $def = ($self->{context} || $$Value::context)->lists->get('Vector');
+ $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
+ $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
+}
+
+sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
+sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
+sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
#############################################################
@@ -354,7 +695,7 @@
package Value::Matrix;
sub cmp_defaults {(
- shift->SUPER::cmp_defaults,
+ shift->SUPER::cmp_defaults(@_),
showDimensionHints => 1,
showEqualErrors => 0,
)}
@@ -371,7 +712,9 @@
my $self = shift; my $ans = shift;
return unless $ans->{score} == 0 &&
!$ans->{isPreview} && $ans->{showDimensionHints};
- my @d1 = $self->dimensions; my @d2 = $ans->{student_value}->dimensions;
+ my $student = $ans->{student_value};
+ return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
+ my @d1 = $self->dimensions; my @d2 = $student->dimensions;
if (scalar(@d1) != scalar(@d2)) {
$self->cmp_Error($ans,"Matrix dimension is not correct");
return;
@@ -385,12 +728,36 @@
}
}
+sub correct_ans {
+ my $self = shift;
+ return $self->SUPER::correct_ans unless $self->{ans_name};
+ my @array = $self->value; @array = ([@array]) if $self->isRow;
+ Value::VERBATIM($self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1));
+}
+
+sub ANS_MATRIX {
+ my $self = shift;
+ my $extend = shift; my $name = shift;
+ my $size = shift || 5;
+ my $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
+ my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
+ my @d = $self->dimensions;
+ Value::Error("Can't create ans_array for ".scalar(@d)."-dimensional matrix")
+ if (scalar(@d) > 2);
+ @d = (1,@d) if (scalar(@d) == 1);
+ $self->ans_matrix($extend,$name,@d,$size,$open,$close,'');
+}
+
+sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
+sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
+sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
+
#############################################################
package Value::Interval;
sub cmp_defaults {(
- shift->SUPER::cmp_defaults,
+ shift->SUPER::cmp_defaults(@_),
showEndpointHints => 1,
showEndTypeHints => 1,
)}
@@ -412,6 +779,7 @@
my $self = shift; my $ans = shift;
return unless $ans->{score} == 0 && !$ans->{isPreview};
my $other = $ans->{student_value};
+ return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
return unless $other->class eq 'Interval';
my @errors;
if ($ans->{showEndpointHints}) {
@@ -461,16 +829,21 @@
sub cmp_defaults {
my $self = shift;
+ my %options = (@_);
+ my $element = Value::makeValue($self->{data}[0]);
+ $element = Value::Formula->new($element) unless Value::isValue($element);
return (
- Value::Real->cmp_defaults,
+ Value::Real->cmp_defaults(@_),
showHints => undef,
showLengthHints => undef,
showParenHints => undef,
partialCredit => undef,
ordered => 0,
+ showEqualErrors => $options{ordered},
entry_type => undef,
list_type => undef,
- typeMatch => Value::makeValue($self->{data}[0]),
+ typeMatch => $element,
+ extra => $element,
requireParenMatch => 1,
removeParens => 1,
);
@@ -489,7 +862,8 @@
my $cmp = $self->SUPER::cmp(@_);
if ($cmp->{rh_ans}{removeParens}) {
$self->{open} = $self->{close} = '';
- $cmp->ans_hash(correct_ans => $self->stringify);
+ $cmp->ans_hash(correct_ans => $self->stringify)
+ unless defined($self->{correct_ans});
}
return $cmp;
}
@@ -501,23 +875,21 @@
#
# get the paramaters
#
- my $showTypeWarnings = $ans->{showTypeWarnings};
- my $showHints = getOption($ans,'showHints');
- my $showLengthHints = getOption($ans,'showLengthHints');
- my $showParenHints = getOption($ans,'showLengthHints');
- my $partialCredit = getOption($ans,'partialCredit');
- my $ordered = $ans->{ordered};
+ my $showHints = getOption($ans,'showHints');
+ my $showLengthHints = getOption($ans,'showLengthHints');
+ my $showParenHints = getOption($ans,'showLengthHints');
+ my $partialCredit = getOption($ans,'partialCredit');
my $requireParenMatch = $ans->{requireParenMatch};
- my $typeMatch = $ans->{typeMatch};
- my $value = $ans->{entry_type};
- my $ltype = $ans->{list_type} || lc($self->type);
+ my $typeMatch = $ans->{typeMatch};
+ my $value = $ans->{entry_type};
+ my $ltype = $ans->{list_type} || lc($self->type);
$value = (Value::isValue($typeMatch)? lc($typeMatch->cmp_class): 'value')
unless defined($value);
$value =~ s/(real|complex) //; $ans->{cmp_class} = $value;
$value =~ s/^an? //; $value = 'formula' if $value =~ m/formula/;
$ltype =~ s/^an? //;
- $showTypeWarnings = $showHints = $showLengthHints = 0 if $ans->{isPreview};
+ $showHints = $showLengthHints = 0 if $ans->{isPreview};
#
# Get the lists of correct and student answers
@@ -555,34 +927,92 @@
}
return;
}
- #
- # Check for empty lists
- #
- if (scalar(@correct) == 0 && scalar(@student) == 0) {$ans->score(1); return}
#
- # Initialize the score
+ # Determine the maximum score
#
my $M = scalar(@correct);
my $m = scalar(@student);
my $maxscore = ($m > $M)? $m : $M;
+
+ #
+ # Compare the two lists
+ # (Handle errors in user-supplied functions)
+ #
+ my ($score,@errors);
+ if (ref($ans->{list_checker}) eq 'CODE') {
+ eval {($score,@errors) = &{$ans->{list_checker}}([@correct],[@student],$ans,$value)};
+ if (!defined($score)) {
+ die $@ if $@ ne '' && $self->{context}{error}{flag} == 0;
+ $self->cmp_error($ans) if $self->{context}{error}{flag};
+ }
+ } else {
+ ($score,@errors) = $self->cmp_list_compare([@correct],[@student],$ans,$value);
+ }
+ return unless defined($score);
+
+ #
+ # Give hints about extra or missing answers
+ #
+ if ($showLengthHints) {
+ $value =~ s/ or /s or /; # fix "interval or union"
+ push(@errors,"There should be more ${value}s in your $ltype")
+ if ($score < $maxscore && $score == $m);
+ push(@errors,"There should be fewer ${value}s in your $ltype")
+ if ($score < $maxscore && $score == $M && !$showHints);
+ }
+
+ #
+ # Finalize the score
+ #
+ $score = 0 if ($score != $maxscore && !$partialCredit);
+ $ans->score($score/$maxscore);
+ push(@errors,"Score = $ans->{score}") if $ans->{debug};
+ my $error = join("\n",@errors); $error =~ s!</DIV>\n!</DIV>!g;
+ $ans->{error_message} = $ans->{ans_message} = $error;
+}
+
+#
+# Compare the contents of the list to see of they are equal
+#
+sub cmp_list_compare {
+ my $self = shift;
+ my $correct = shift; my $student = shift; my $ans = shift; my $value = shift;
+ my @correct = @{$correct}; my @student = @{$student}; my $m = scalar(@student);
+ my $ordered = $ans->{ordered};
+ my $showTypeWarnings = $ans->{showTypeWarnings} && !$ans->{isPreview};
+ my $typeMatch = $ans->{typeMatch};
+ my $extra = $ans->{extra};
+ my $showHints = getOption($ans,'showHints') && !$ans->{isPreview};
+ my $error = $$Value::context->{error};
my $score = 0; my @errors; my $i = 0;
#
+ # Check for empty lists
+ #
+ if (scalar(@correct) == 0) {$ans->score($m == 0); return}
+
+ #
# Loop through student answers looking for correct ones
#
ENTRY: foreach my $entry (@student) {
- $i++;
+ $i++; $$Value::context->clearError;
$entry = Value::makeValue($entry);
$entry = Value::Formula->new($entry) if !Value::isValue($entry);
if ($ordered) {
- if (eval {shift(@correct) == $entry}) {$score++; next ENTRY}
+ if (scalar(@correct)) {
+ if (shift(@correct)->cmp_compare($entry,$ans)) {$score++; next ENTRY}
+ } else {
+ $extra->cmp_compare($entry,$ans); # do syntax check
+ }
+ if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
} else {
foreach my $k (0..$#correct) {
- if (eval {$correct[$k] == $entry}) {
+ if ($correct[$k]->cmp_compare($entry,$ans)) {
splice(@correct,$k,1);
$score++; next ENTRY;
}
+ if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
}
}
#
@@ -590,13 +1020,17 @@
#
my $nth = ''; my $answer = 'answer';
my $class = $ans->{list_type} || $self->cmp_class;
- if (scalar(@student) > 1) {
+ if ($m > 1) {
$nth = ' '.$self->NameForNumber($i);
$class = $ans->{cmp_class};
$answer = 'value';
}
- if ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) &&
- !($ans->{ignoreStrings} && $entry->class eq 'String')) {
+ if ($error->{flag} && $ans->{showEqualErrors}) {
+ my $message = $error->{message}; $message =~ s/\s+$//;
+ push(@errors,"<SMALL>There is a problem with your$nth $value:</SMALL>",
+ '<DIV STYLE="margin-left:1em">'.$message.'</DIV>');
+ } elsif ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) &&
+ !($ans->{ignoreStrings} && $entry->class eq 'String')) {
push(@errors,"Your$nth $answer isn't ".lc($class).
" (it looks like ".lc($entry->showClass).")");
} elsif ($showHints && $m > 1) {
@@ -605,23 +1039,9 @@
}
#
- # Give hints about extra or missing answsers
+ # Return the score and errors
#
- if ($showLengthHints) {
- $value =~ s/ or /s or /; # fix "interval or union"
- push(@errors,"There should be more ${value}s in your $ltype")
- if ($score == $m && scalar(@correct) > 0);
- push(@errors,"There should be fewer ${value}s in your $ltype")
- if ($score < $maxscore && $score == $M && !$showHints);
- }
-
- #
- # Finalize the score
- #
- $score = 0 if ($score != $maxscore && !$partialCredit);
- $ans->score($score/$maxscore);
- push(@errors,"Score = $ans->{score}") if $ans->{debug};
- $ans->{error_message} = $ans->{ans_message} = join("\n",@errors);
+ return ($score,@errors);
}
#
@@ -666,19 +1086,24 @@
return (
Value::Union::cmp_defaults($self,@_),
typeMatch => Value::Formula->new("(1,2]"),
+ showDomainErrors => 1,
) if $self->type eq 'Union';
my $type = $self->type;
$type = ($self->isComplex)? 'Complex': 'Real' if $type eq 'Number';
$type = 'Value::'.$type.'::';
- return (&{$type.'cmp_defaults'}($self,@_), upToConstant => 0)
- if defined(%$type) && $self->type ne 'List';
+ return (
+ &{$type.'cmp_defaults'}($self,@_),
+ upToConstant => 0,
+ showDomainErrors => 1,
+ ) if defined(%$type) && $self->type ne 'List';
return (
Value::List::cmp_defaults($self,@_),
removeParens => $self->{autoFormula},
typeMatch => Value::Formula->new(($self->createRandomPoints(1))[1]->[0]{data}[0]),
+ showDomainErrors => 1,
);
}
@@ -703,7 +1128,8 @@
my $cmp = $self->SUPER::cmp(@_);
if ($cmp->{rh_ans}{removeParens} && $self->type eq 'List') {
$self->{tree}{open} = $self->{tree}{close} = '';
- $cmp->ans_hash(correct_ans => $self->stringify);
+ $cmp->ans_hash(correct_ans => $self->stringify)
+ unless defined($self->{correct_ans});
}
if ($cmp->{rh_ans}{eval} && $self->isConstant) {
$cmp->ans_hash(correct_value => $self->eval);
@@ -716,7 +1142,11 @@
$context->{_variables}->{pattern} = $context->{_variables}->{namePattern} =
'C0|' . $context->{_variables}->{pattern};
$context->update; $context->variables->add('C0' => 'Parameter');
- $cmp->ans_hash(correct_value => Value::Formula->new('C0')+$self);
+ my $f = Value::Formula->new('C0')+$self;
+ for ('limits','test_points','test_values','num_points','granularity','resolution',
+ 'checkUndefinedPoints','max_undefined')
+ {$f->{$_} = $self->{$_} if defined($self->{$_})}
+ $cmp->ans_hash(correct_value => $f);
Parser::Context->current(undef,$current);
}
return $cmp;
@@ -745,14 +1175,106 @@
sub cmp_postprocess {
my $self = shift; my $ans = shift;
return unless $ans->{score} == 0 && !$ans->{isPreview};
- return if $ans->{ans_message} || !$ans->{showDimensionHints};
+ return if $ans->{ans_message};
+ if ($self->{domainMismatch} && $ans->{showDomainErrors}) {
+ $self->cmp_Error($ans,"The domain of your function doesn't match that of the correct answer");
+ return;
+ }
+ return if !$ans->{showDimensionHints};
my $other = $ans->{student_value};
+ return if $ans->{ignoreStrings} && (!Value::isValue($other) || $other->type eq 'String');
return unless $other->type =~ m/^(Point|Vector|Matrix)$/;
return unless $self->type =~ m/^(Point|Vector|Matrix)$/;
return if P...
[truncated message content] |
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 02:24:30
|
Log Message:
-----------
Corrected usage help message
Modified Files:
--------------
webwork-modperl/clients:
webwork_xmlrpc_client.pl
Revision Data
-------------
Index: webwork_xmlrpc_client.pl
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/clients/webwork_xmlrpc_client.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lclients/webwork_xmlrpc_client.pl -Lclients/webwork_xmlrpc_client.pl -u -r1.1 -r1.2
--- clients/webwork_xmlrpc_client.pl
+++ clients/webwork_xmlrpc_client.pl
@@ -36,9 +36,9 @@
} else {
- print STDERR "Useage: .xmlrpc_client4.pl command file_name\n";
- print STDERR "For example: .xmlrpc_client4.pl renderProblem input.txt\n";
- print STDERR "For example: .xmlrpc_client4.pl listLibraries \n";
+ print STDERR "Useage: ./webwork_xmlrpc_client.pl command [file_name]\n";
+ print STDERR "For example: ./webwork_xmlrpc_client.pl renderProblem input.txt\n";
+ print STDERR "For example: ./webwork_xmlrpc_client.pl listLibraries \n";
print STDERR "Commands are: ", join(" ", @COMMANDS), "\n";
}
@@ -274,4 +274,4 @@
webworkDocsURL => 'http://webwork.math.rochester.edu/webwork_gage_system_html',
};
$envir;
-};
\ No newline at end of file
+};
|
|
From: Mike G. v. a. <we...@ma...> - 2005-06-10 02:21:09
|
Log Message:
-----------
Merging changes from rel-2-1-3 back into rel-2-1-patches
Tags:
----
rel-2-1-patches
Modified Files:
--------------
webwork2:
README
webwork2/conf:
devel.apache-config.dist
global.conf.dist
webwork.apache-config.dist
webwork2/courses:
adminClasslist.lst
defaultClasslist.lst
webwork2/doc/parser/problems:
sample05.pg
sample21.pg
webwork2/htdocs/css:
ur.css
webwork2/lib/WeBWorK:
ContentGenerator.pm
DB.pm
PG.pm
Utils.pm
webwork2/lib/WeBWorK/ContentGenerator:
CourseAdmin.pm
Login.pm
Problem.pm
ProblemSet.pm
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
ProblemSetList.pm
Scoring.pm
SetsAssignedToUser.pm
Stats.pm
StudentProgress.pm
UsersAssignedToSet.pm
webwork2/lib/WeBWorK/DB/Record:
Key.pm
Password.pm
PermissionLevel.pm
Problem.pm
Set.pm
User.pm
UserProblem.pm
UserSet.pm
webwork2/lib/WeBWorK/DB/Schema:
SQL.pm
webwork2/lib/WeBWorK/PG:
Local.pm
webwork2/lib/WeBWorK/Utils:
CourseManagement.pm
DBImportExport.pm
webwork2/lib/WeBWorK/Utils/CourseManagement:
sql_single.pm
Added Files:
-----------
webwork2/bin:
ww_db_v2_to_v3
webwork2/clients:
README
hello_world_soap_client.pl
hello_world_xmlrpc_client.pl
input.txt
webwork_soap_client.pl
webwork_xmlrpc_client.pl
webwork2/conf/snippets:
blankProblem.pg
webwork2/courses/modelCourse:
course.conf
webwork2/lib:
MySOAP.pm
RQP.pm
WebworkWebservice.pm
webwork2/lib/WeBWorK:
DBv3.pm
webwork2/lib/WeBWorK/DBv3:
NormalizerMixin.pm
Utils.pm
webwork2/lib/WebworkWebservice:
LibraryActions.pm
MathTranslators.pm
RenderProblem.pm
Revision Data
-------------
Index: Problem.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Record/Problem.pm,v
retrieving revision 1.5
retrieving revision 1.5.8.1
diff -Llib/WeBWorK/DB/Record/Problem.pm -Llib/WeBWorK/DB/Record/Problem.p=
m -u -r1.5 -r1.5.8.1
--- lib/WeBWorK/DB/Record/Problem.pm
+++ lib/WeBWorK/DB/Record/Problem.pm
@@ -45,4 +45,12 @@
max_attempts
)}
=20
+sub SQL_TYPES {qw(
+ BLOB
+ INT
+ TEXT
+ INT
+ INT
+)}
+
1;
Index: User.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Record/User.pm,v
retrieving revision 1.5
retrieving revision 1.5.8.1
diff -Llib/WeBWorK/DB/Record/User.pm -Llib/WeBWorK/DB/Record/User.pm -u -=
r1.5 -r1.5.8.1
--- lib/WeBWorK/DB/Record/User.pm
+++ lib/WeBWorK/DB/Record/User.pm
@@ -53,4 +53,16 @@
comment
)}
=20
+sub SQL_TYPES {qw(
+ BLOB
+ TEXT
+ TEXT
+ TEXT
+ TEXT
+ TEXT
+ TEXT
+ TEXT
+ TEXT
+)}
+
1;
Index: Key.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Record/Key.pm,v
retrieving revision 1.5
retrieving revision 1.5.8.1
diff -Llib/WeBWorK/DB/Record/Key.pm -Llib/WeBWorK/DB/Record/Key.pm -u -r1=
.5 -r1.5.8.1
--- lib/WeBWorK/DB/Record/Key.pm
+++ lib/WeBWorK/DB/Record/Key.pm
@@ -41,4 +41,10 @@
timestamp
)}
=20
+sub SQL_TYPES {qw(
+ BLOB
+ TEXT
+ TEXT
+)}
+
1;
Index: PermissionLevel.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Record/PermissionLe=
vel.pm,v
retrieving revision 1.6
retrieving revision 1.6.8.1
diff -Llib/WeBWorK/DB/Record/PermissionLevel.pm -Llib/WeBWorK/DB/Record/P=
ermissionLevel.pm -u -r1.6 -r1.6.8.1
--- lib/WeBWorK/DB/Record/PermissionLevel.pm
+++ lib/WeBWorK/DB/Record/PermissionLevel.pm
@@ -40,4 +40,9 @@
permission
)}
=20
+sub SQL_TYPES {qw(
+ BLOB
+ INT
+)}
+
1;
Index: Password.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Record/Password.pm,=
v
retrieving revision 1.4
retrieving revision 1.4.8.1
diff -Llib/WeBWorK/DB/Record/Password.pm -Llib/WeBWorK/DB/Record/Password=
.pm -u -r1.4 -r1.4.8.1
--- lib/WeBWorK/DB/Record/Password.pm
+++ lib/WeBWorK/DB/Record/Password.pm
@@ -39,4 +39,9 @@
password
)}
=20
+sub SQL_TYPES {qw(
+ BLOB
+ TEXT
+)}
+
1;
Index: Set.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Record/Set.pm,v
retrieving revision 1.8
retrieving revision 1.8.4.1
diff -Llib/WeBWorK/DB/Record/Set.pm -Llib/WeBWorK/DB/Record/Set.pm -u -r1=
.8 -r1.8.4.1
--- lib/WeBWorK/DB/Record/Set.pm
+++ lib/WeBWorK/DB/Record/Set.pm
@@ -49,4 +49,14 @@
published
)}
=20
+sub SQL_TYPES {qw(
+ BLOB
+ TEXT
+ TEXT
+ BIGINT
+ BIGINT
+ BIGINT
+ INT
+)}
+
1;
Index: UserSet.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Record/UserSet.pm,v
retrieving revision 1.7
retrieving revision 1.7.4.1
diff -Llib/WeBWorK/DB/Record/UserSet.pm -Llib/WeBWorK/DB/Record/UserSet.p=
m -u -r1.7 -r1.7.4.1
--- lib/WeBWorK/DB/Record/UserSet.pm
+++ lib/WeBWorK/DB/Record/UserSet.pm
@@ -53,4 +53,16 @@
published
)}
=20
+sub SQL_TYPES {(
+ "BLOB",
+ "BLOB",
+ "INT NOT NULL PRIMARY KEY AUTO_INCREMENT",
+ "TEXT",
+ "TEXT",
+ "BIGINT",
+ "BIGINT",
+ "BIGINT",
+ "INT"
+)}
+
1;
Index: UserProblem.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Record/UserProblem.=
pm,v
retrieving revision 1.4
retrieving revision 1.4.8.1
diff -Llib/WeBWorK/DB/Record/UserProblem.pm -Llib/WeBWorK/DB/Record/UserP=
roblem.pm -u -r1.4 -r1.4.8.1
--- lib/WeBWorK/DB/Record/UserProblem.pm
+++ lib/WeBWorK/DB/Record/UserProblem.pm
@@ -60,4 +60,22 @@
num_incorrect
)}
=20
+# Should value be float instead of text?
+
+sub SQL_TYPES {qw(
+ BLOB
+ BLOB
+ INT
+ TEXT
+ INT
+ INT
+ INT
+ TEXT
+ INT
+ TEXT
+ INT
+ INT
+)}
+
+
1;
--- /dev/null
+++ lib/WeBWorK/DBv3/Utils.pm
@@ -0,0 +1,115 @@
+########################################################################=
########
+# WeBWorK Online Homework Delivery System
+# Copyright =A9 2000-2003 The WeBWorK Project, http://openwebwork.sf.net=
/
+# $CVSHeader: webwork2/lib/WeBWorK/DBv3/Utils.pm,v 1.2.2.1 2005/06/10 02=
:18:25 gage 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::DBv3::Utils;
+use base qw(Exporter);
+
+=3Dhead1 NAME
+
+WeBWorK::DBv3::Utils - useful utilities for WWDBv3.
+
+=3Dcut
+
+use strict;
+use warnings;
+use DBI;
+use Fcntl qw/:DEFAULT :flock/;
+
+use constant GET_VERSION =3D> "SELECT `val` FROM `setting` WHERE `name`=3D=
'db_version'";
+use constant INCR_VERSION =3D> "UPDATE `setting` SET `val`=3D`val`+1 WHE=
RE `name`=3D'db_version'";
+use constant DB_VERSION =3D> 1;
+use constant DELTAS =3D> [
+ q/ # DUMMY VALUE FOR 0 /,
+ q/ # DUMMY VALUE FOR 1 /,
+];
+
+our @EXPORT =3D qw(
+ upgrade_schema
+);
+
+=3Dhead1 FUNCTIONS
+
+=3Dhead2 upgrade_schema
+
+ upgrade_schema($dbh, $lockfile)
+
+This is a private subroutine, but it has interesting behavior and is the=
refore
+documented here. It should only be called by WeBWorK::DBv3.
+
+Checks the 'db_version' setting in the C<setting> table of the specified=
WWDBv3
+database. If it is less than the current version (defined by the constan=
t
+C<DB_VERSION> in this file), deltas are applied to the database to updat=
e it.
+
+A lockfile is used to prevent concurrent execution of this subroutine. H=
owever,
+it does not protect against concurrent execution on the same database fr=
om
+separate machines.
+
+Any database error causes an exception to be thrown.
+
+=3Dcut
+
+sub upgrade_schema {
+ my ($dbh, $lockfile) =3D @_;
+ my $dsn =3D "dbi:" . $dbh->{Driver}->{Name} . ":" . $dbh->{Name};
+=09
+ # use the upgrade_lock to protect this critical section
+ local *LOCK;
+ sysopen LOCK, $lockfile, O_RDONLY|O_CREAT
+ or die "failed to sysopen WWDBv3 upgrade lock '$lockfile' with flags '=
O_RDONLY|OCREAT': $!";
+ flock LOCK, LOCK_EX
+ or die "failed to flock WWDBv3 upgrade lock '$lockfile' with flags 'LO=
CK_EX': $!";
+=09
+ my @record =3D $dbh->selectrow_array(GET_VERSION);
+ if (@record) {
+ my $db_version =3D $record[0];
+ if ($db_version !~ /^-?\d+$/) {
+ warn "System setting 'db_version' in WWDBv3 database '$dsn' has non-n=
umeric value '$db_version'. Assuming database schema is up-to-date.\n";
+ } elsif ($db_version =3D=3D DB_VERSION) {
+ # database is fine :)
+ } elsif ($db_version < 1) {
+ warn "System setting 'db_version' in WWDBv3 database '$dsn' has nonse=
nsical value '$db_version'. Assuming database schema is up-to-date.\n";
+ } elsif ($db_version > DB_VERSION) {
+ warn "System setting 'db_version' in WWDBv3 database '$dsn' has futur=
e value '$db_version'. Assuming database schema is up-to-date.\n";
+ } else {
+ warn "WWDBv3 schema at version '$db_version', current version is '@{[=
DB_VERSION]}'. Upgrade required.\n";
+ =09
+ foreach my $version ($db_version+1 .. DB_VERSION) {
+ my $delta =3D DELTAS->[$version];
+ =09
+ unless ($dbh->do($delta)) {
+ warn "Failed to apply schema delta '$version' to WWDBv3 database '$=
dsn'. Bailing out. DBI error: $DBI::errstr";
+ last;
+ }
+ =09
+ unless ($dbh->do(INCR_VERSION)) {
+ warn "Failed to increment system setting 'db_version' in WWDBv3 dat=
abase '$dsn'. Bailing out. DBI error: $DBI::errstr";
+ last;
+ }
+ =09
+ warn "Upgraded WWDBv3 schema to version '$version'.\n";
+ }
+ }
+ } else {
+ # Value doesn't exist yet. We could add it, but there's no sensible
+ # default since we can't tell what state the database is in otherwise.
+ warn "System setting 'db_version' not found in WWDBv3 database '$dsn'.=
Assuming database schema is up-to-date.\n";
+ }
+=09
+ # we're done, disconnect and unlock
+ close LOCK;
+}
+
+1;
--- /dev/null
+++ lib/WeBWorK/DBv3/NormalizerMixin.pm
@@ -0,0 +1,153 @@
+package WeBWorK::DBv3::NormalizerMixin;
+
+=3Dhead1 NAME
+
+WeBWorK::DBv3NormalizerMixin - Mixin to add/call inhertiable normalizers.
+
+=3Dhead1 SYNOPSIS
+
+ package My::DB;
+ use base "Class::DBI";
+ use WeBWorK::DBv3::NormalizerMixin;
+=20
+ # overload Class::DBI's empty normalize_column_values method to use cal=
l_normalizer().
+ sub normalize_column_values {
+ my ($self, $column_values) =3D @_;
+ =09
+ my @errors;
+ =09
+ foreach my $column (keys %$column_values) {
+ #warn "callig normalizers for column '$column'.\n";
+ eval { $self->call_normalizer($column_values, $column) };
+ push @errors, $column =3D> $@ if $@;
+ }
+ =09
+ return unless @errors;
+ $self->_croak(
+ "normalize_column_values error: " . join(" ", @errors),
+ method =3D> "normalize_column_values",
+ data =3D> { @errors },
+ );
+ }
+=20
+ package My::DB::SomeTable;
+=20
+ # ... other Class::DBI stuff here ...
+=20
+ # add normalizers for various fields
+ __PACKAGE__->add_normalizer(field =3D> \&normalizer_sub);
+
+=3Dcut
+
+use strict;
+use warnings;
+use Class::Data::Inheritable;
+use Carp ();
+
+sub import {
+ my ($invocant) =3D @_;
+ my $pkg =3D caller(0);
+=09
+ # XXX 5.005_03 isa() is broken with MI
+ unless ($pkg->can('mk_classdata')) {
+ no strict 'refs';
+ push @{"$pkg\::ISA"}, 'Class::Data::Inheritable';
+ }
+
+ $pkg->mk_classdata('__normalizers');
+
+ # export mixin methods
+ no strict 'refs';
+ my @methods =3D qw(add_normalizer call_normalizer);
+ *{"$pkg\::$_"} =3D \&{$_} for @methods;
+}
+
+sub add_normalizer {
+ my ($invocant, @new) =3D @_;
+=09
+ my $normalizers =3D __fetch_normalizers($invocant) || {};
+ my %normalizers =3D __deep_dereference($normalizers);
+=09
+ while (my ($column, $code) =3D splice @new, 0, 2) {
+ __validate_field($invocant, $column);
+ Carp::croak('add_normalizer() needs coderef') unless ref($code) eq 'CO=
DE';
+ push @{$normalizers{$column}}, $code;
+ }
+=09
+ __store_normalizers($invocant, \%normalizers);
+}
+
+sub call_normalizer {
+ my ($invocant, $column_values, $column) =3D @_;
+=09
+ my $normalizers =3D __fetch_normalizers($invocant) || return;
+ if (exists $normalizers->{$column}) {
+ foreach my $code (@{$normalizers->{$column}}) {
+ #warn "call_normalizer: old value of column '$column': '", $column_va=
lues->{$column}, "'.\n";
+ $column_values->{$column} =3D $code->($column_values->{$column});
+ #warn "call_normalizer: new value of column '$column': '", $column_va=
lues->{$column}, "'.\n";
+ }
+ } else {
+ __validate_field($invocant, $column);
+ }
+}
+
+########################################################################=
########
+
+sub __validate_field {
+ my ($invocant, $column) =3D @_;
+ Carp::croak("$column is not valid field for " . (ref($invocant) || $inv=
ocant))
+ unless $invocant->find_column($column) ? 1 : "";
+}
+
+sub __fetch_normalizers {
+ my ($invocant) =3D @_;
+=09
+ if (ref $invocant) {
+ # called with an instance, use the instance's normalizers
+ return $invocant->{__normalizers};
+ } else {
+ # called with a class, use the class's normalizers
+ return $invocant->__normalizers;
+ }
+}
+
+sub __store_normalizers {
+ my ($invocant, $normalizers) =3D @_;
+=09
+ if (ref $invocant) {
+ # called with an instance, use the instance's normalizers
+ $invocant->{__normalizers} =3D $normalizers;
+ } else {
+ # called with a class, use the class's normalizers
+ $invocant->__normalizers($normalizers);
+ }
+}
+
+# straight from Class::Trigger -- two-level copy of hash-of-arrays.
+sub __deep_dereference {
+ my $hashref =3D shift;
+ my %copy;
+ while (my($key, $arrayref) =3D each %$hashref) {
+ $copy{$key} =3D [ @$arrayref ];
+ }
+ return %copy;
+}
+
+########################################################################=
########
+
+=3Dhead1 AUTHOR
+
+Written by Sam Hathaway, sh002i (at) math.rochester.edu.
+
+Based on Class::Trigger, which says:
+
+ Original idea by Tony Bowden <to...@ka...> in Class::DBI.
+=20
+ Code by Tatsuhiko Miyagawa <miy...@bu...>.
+=20
+ Patches by Tim Buce <Tim...@po...>.
+
+=3Dcut
+
+1;
Index: Local.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/PG/Local.pm,v
retrieving revision 1.15
retrieving revision 1.15.2.1
diff -Llib/WeBWorK/PG/Local.pm -Llib/WeBWorK/PG/Local.pm -u -r1.15 -r1.15=
.2.1
--- lib/WeBWorK/PG/Local.pm
+++ lib/WeBWorK/PG/Local.pm
@@ -95,8 +95,7 @@
# set the directory hash
#warn "PG: setting the directory hash\n";
$translator->rh_directories({
- courseScriptsDirectory =3D> $ce->{pg}->{directories}->{macros},
- macroDirectory =3D> $ce->{courseDirs}->{macros},
+ macrosPath =3D> $ce->{courseDirs}->{macrosPath},
templateDirectory =3D> $ce->{courseDirs}->{templates},
tempDirectory =3D> $ce->{courseDirs}->{html_temp},
});
@@ -180,17 +179,39 @@
=09
# store the problem source
#warn "PG: storing the problem source\n";
- my $sourceFile =3D $problem->source_file;
- $sourceFile =3D $ce->{courseDirs}->{templates}."/".$sourceFile
- unless ($sourceFile =3D~ /^\//);
- eval { $translator->source_string(readFile($sourceFile)) };
- if ($@) {
+ my $source =3D'';
+ my $sourceFilePath =3D '';
+ my $readErrors =3D undef;
+ if (ref($translationOptions->{r_source}) ) {
+ # the source for the problem is already given to us as a reference to =
a string
+ $source =3D ${$translationOptions->{r_source}};
+ } else {
+ # the source isn't given to us so we need to read it=20
+ # from a file defined by the problem
+ =20
+ # we grab the sourceFilePath from the problem
+ $sourceFilePath =3D $problem->source_file;
+ =09
+ # the path to the source file is usually given relative to the=20
+ # the templates directory. Unless the path starts with / assume
+ # that it is relative to the templates directory
+ =20
+ $sourceFilePath =3D $ce->{courseDirs}->{templates}."/"
+ .$sourceFilePath unless ($sourceFilePath =3D~ /^\//);
+ #now grab the source
+ eval {$source =3D readFile($sourceFilePath) };
+ $readErrors =3D $@ if $@;
+ }
+ # put the source into the translator object
+ eval { $translator->source_string( $source ) } unless $readErrors;
+ $readErrors .=3D"\n $@ " if $@;
+ if ($readErrors) {
# well, we couldn't get the problem source, for some reason.
return bless {
translator =3D> $translator,
head_text =3D> "",=20
body_text =3D> <<EOF,
-WeBWorK::Utils::readFile($sourceFile) says:=20
+WeBWorK::Utils::readFile($sourceFilePath) says:=20
$@
EOF
answers =3D> {},
Index: webwork.apache-config.dist
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/conf/webwork.apache-config.dist,v
retrieving revision 1.4
retrieving revision 1.4.6.1
diff -Lconf/webwork.apache-config.dist -Lconf/webwork.apache-config.dist =
-u -r1.4 -r1.4.6.1
--- conf/webwork.apache-config.dist
+++ conf/webwork.apache-config.dist
@@ -28,6 +28,9 @@
# Set this variable to the path to your WeBWorK installation.
my $webwork_dir =3D "/opt/webwork2";
=20
+$ENV{WEBWORK_ROOT} =3D $webwork_dir; #allows the XMLRPC modules to find
+ # the webwork root directory
+
# This code reads global.conf and extracts the remaining configuration
# variables. There is no need to modify it.
eval "use lib '$webwork_dir/lib'"; die $@ if $@;
@@ -40,6 +43,16 @@
my $webwork_courses_url =3D $ce->{webwork_courses_url};
my $webwork_courses_dir =3D $ce->{webwork_courses_dir};
eval "use lib '$pg_dir/lib'"; die $@ if $@;
+
+##########################################
+# allows Webservice access to WeBWorK
+##########################################
+
+eval "use WebworkWebservice";die $@ if $@; #FIXME, is there anoth=
er way to initialize this?
+eval "use RQP"; die $@ if $@;
+
+##########################################
+
$WeBWorK::SeedCE{webwork_dir} =3D $webwork_dir;
=20
# Between the line below and the "EOF" line are the three configuration =
stanzas
@@ -73,7 +86,9 @@
#=20
Alias $webwork_htdocs_url $webwork_htdocs_dir
<Directory $webwork_htdocs_dir>
- Options None
+ Order Allow,Deny
+ Allow from All
+ Options FollowSymLinks
AllowOverride None
</Directory>
=20
@@ -81,10 +96,49 @@
#=20
AliasMatch $webwork_courses_url/([^/]*)/(.*) $webwork_courses_dir/\$1/ht=
ml/\$2
<Directory $webwork_courses_dir/*/html>
+ Order Allow,Deny
+ Allow from All
Options FollowSymLinks
AllowOverride None
</Directory>
=20
+ ########## XMLRPC installation ##########
+<Location /mod_xmlrpc>
+ SetHandler perl-script
+ PerlHandler Apache::XMLRPC::Lite
+ PerlSetVar dispatch_to "WebworkXMLRPC"
+ PerlSetVar options "compress_threshold =3D> 10000"
+ Order Allow,Deny
+ Allow from All
+</Location>
+ ########## RQP installation ##########
+=20
+#<Location /rqp>
+# SetHandler perl-script
+# PerlHandler Apache::SOAP
+# PerlSetVar dispatch_to "RQP"
+# PerlSetVar options "compress_threshold =3D> 10000"
+# Order Allow,Deny
+# Allow from All
+#</Location>
+
+<Location /rqp>
+ SetHandler perl-script
+ PerlHandler MySOAP
+ Order Allow,Deny
+ Allow from All
+</Location>
+
+########## SOAP installation ############
+<Location /mod_soap>
+ SetHandler perl-script
+ PerlHandler Apache::SOAP
+ PerlSetVar dispatch_to "WebworkXMLRPC"=20
+ PerlSetVar options "compress_threshold =3D> 10000"
+ Order Allow,Deny
+ Allow from All
+</Location>
+
EOF
=20
</Perl>
Index: global.conf.dist
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/conf/global.conf.dist,v
retrieving revision 1.111.2.5
retrieving revision 1.111.2.6
diff -Lconf/global.conf.dist -Lconf/global.conf.dist -u -r1.111.2.5 -r1.1=
11.2.6
--- conf/global.conf.dist
+++ conf/global.conf.dist
@@ -256,9 +256,13 @@
# The set header is displayed on the problem set page. It is a PG file.
$webworkFiles{screenSnippets}{setHeader} =3D "$webworkDirs{conf}/=
snippets/setHeader.pg"; # screenSetHeader.pg"
=20
+
# A PG template for creation of new problems.
$webworkFiles{screenSnippets}{blankProblem} =3D "$webworkDirs{conf}/s=
nippets/blankProblem.pg"; # screenSetHeader.pg"
=20
+# A site info "message of the day" file
+$webworkFiles{site_info} =3D "$webworkDirs{htdocs}=
/site_info.txt";
+
########################################################################=
########
# Course-specific files
########################################################################=
########
@@ -299,7 +303,22 @@
};
=20
########################################################################=
########
-# Database options
+# Database options (WWDBv3)
+########################################################################=
########
+
+# The four arguments passed to the DBI::connect() method. See the DBI ma=
nual for
+# more information.
+$wwdbv3_settings{dsn} =3D "dbi:mysql:wwdbv3";
+$wwdbv3_settings{user} =3D "wwdbv3";
+$wwdbv3_settings{pass} =3D "xyzzy";
+$wwdbv3_settings{attr} =3D {};
+
+# WWDBv3 needs a lock file to prevent concurrent database upgrades. The =
file
+# will be locked with flock().
+$wwdbv3_settings{upgrade_lock} =3D "$webworkDirs{tmp}/wwdbv3_upgrade.loc=
k";
+
+########################################################################=
########
+# Database options (WWDBv2)
########################################################################=
########
=20
# Several database are defined in the file conf/database.conf and stored=
in the
@@ -425,7 +444,8 @@
my $nobody =3D undef;
=20
%permissionLevels =3D (
- login =3D> $student,
+
+ login =3D> $guest,
report_bugs =3D> $student,
submit_feedback =3D> $student,
change_password =3D> $student,
@@ -461,9 +481,9 @@
avoid_recording_answers =3D> $ta,
check_answers_before_open_date =3D> $ta,
check_answers_after_open_date_with_attempts =3D> $ta,
- check_answers_after_open_date_without_attempts =3D> $student,
- check_answers_after_due_date =3D> $student,
- check_answers_after_answer_date =3D> $student,
+ check_answers_after_open_date_without_attempts =3D> $guest,
+ check_answers_after_due_date =3D> $guest,
+ check_answers_after_answer_date =3D> $guest,
record_answers_when_acting_as_student =3D> $nobody,
# "record_answers_when_acting_as_student" takes precedence
# over the following for professors acting as students:
@@ -597,6 +617,16 @@
$pg{directories}{lib} =3D "$pg{directories}{root}/lib";
$pg{directories}{macros} =3D "$pg{directories}{root}/macros";
=20
+#
+# The macro file search path. Each directory in this list is seached
+# (in this order) by loadMacros() when it looks for a .pl file.
+#
+$pg{directories}{macrosPath} =3D [
+ ".", # search the problem file's directory
+ $courseDirs{macros},
+ $pg{directories}{macros},
+];
+
##### "Special" PG environment variables. (Stuff that doesn't fit in any=
where else.)
=20
# Users for whom to print the file name of the PG file being processed.
@@ -622,7 +652,7 @@
[qw(Exporter)],
[qw(GD)],
=09
- [qw(AlgParser AlgParserWithImplicitExpand Expr ExprWithImplicitExpand)]=
,
+ [qw(AlgParser AlgParserWithImplicitExpand Expr ExprWithImplicitExpand u=
tf8)],
[qw(AnswerHash AnswerEvaluator)],
[qw(WWPlot)], # required by Circle (and others)
[qw(Circle)],
Index: devel.apache-config.dist
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/conf/devel.apache-config.dist,v
retrieving revision 1.4
retrieving revision 1.4.2.1
diff -Lconf/devel.apache-config.dist -Lconf/devel.apache-config.dist -u -=
r1.4 -r1.4.2.1
--- conf/devel.apache-config.dist
+++ conf/devel.apache-config.dist
@@ -26,8 +26,8 @@
# central location.
#=20
# The second part is the stock webwork.apache-config file that is used f=
or
-# normal installations. Customize this file, setting $webwork_dir approp=
riatly
-# for your development server.
+# normal installations. Customize this file, setting the $webwork_url,
+# $webwork_dir, $pg_dir, etc. appropriatly for your development server.
#=20
# The third part is this file. It contains the user-specific directives =
that are
# specific to each developer's server.
@@ -59,7 +59,7 @@
$Group =3D $group_name;
=20
# It will listen on a port equal to the UID of the user who starts it + =
10000.
-$Port =3D $> + 10000;
+$Port =3D $> + 7000; # effectively picks a port between 8000 and 8999 =
since uid's are 1000+
=20
# Email address of server administator.
$ServerAdmin =3D "$user_name\@$host_name";
@@ -101,3 +101,5 @@
# Stick any local additions down here
########################################################################=
########
=20
+#Alias /segue /home/gage/webwork/webwork-modperl/htdocs/segue
+#Alias /moodle /home/gage/webwork/webwork-modperl/htdocs/moodle
Index: SQL.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB/Schema/SQL.pm,v
retrieving revision 1.24
retrieving revision 1.24.2.1
diff -Llib/WeBWorK/DB/Schema/SQL.pm -Llib/WeBWorK/DB/Schema/SQL.pm -u -r1=
.24 -r1.24.2.1
--- lib/WeBWorK/DB/Schema/SQL.pm
+++ lib/WeBWorK/DB/Schema/SQL.pm
@@ -368,7 +368,11 @@
next unless defined $part;
=09
$where .=3D " AND" unless $first;
- $where .=3D " BINARY $name=3D?";
+# $where .=3D " BINARY $name=3D?";
+ $where .=3D " $name=3D?"; ## Make lookups case insensitive. Otherwi=
se
+ ## indices seem not to be used which slows things
+ ## down drastically. See =20
+ ## ope...@li... discussion
push @used_keyparts, $part;
=09
$first =3D 0;
Index: README
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/README,v
retrieving revision 1.10.2.3
retrieving revision 1.10.2.4
diff -LREADME -LREADME -u -r1.10.2.3 -r1.10.2.4
--- README
+++ README
@@ -1,4 +1,4 @@
-
+this is a test
WeBWorK =
=20
Online Homework Delivery System =
=20
Version 2.1.2 =
=20
--- /dev/null
+++ bin/ww_db_v2_to_v3
@@ -0,0 +1,703 @@
+#!/usr/bin/env perl
+########################################################################=
########
+# WeBWorK Online Homework Delivery System
+# Copyright =A9 2000-2003 The WeBWorK Project, http://openwebwork.sf.net=
/
+# $CVSHeader: webwork2/bin/ww_db_v2_to_v3,v 1.5.2.1 2005/06/10 02:18:20 =
gage 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.
+########################################################################=
########
+
+=3Dhead1 NAME
+
+ww_db_v2_to_v3 - convert a WWDBv2 database to a WWDBv3 database.
+
+=3Dhead1 SYNOPSIS
+
+ ww_db_v2_to_v3 -crsuv course ...
+
+=3Dhead1 DESCRIPTION
+
+Copies course data from legacy WWDBv2 database(s) to a WWDBv3 database. =
This may
+take a long time.
+
+You must disallow login to the WeBWorK system while the transfer is taki=
ng
+place. To disable logins for all courses, set the permission level neces=
sary for
+C<login> to $nobody in F<global.conf>. (It is usually set to $student.)
+
+=3Dhead1 OPTIONS
+
+=3Dover
+
+=3Ditem -c
+
+If an error occurs while copying a course's data, continue copying with =
the next
+course.
+
+=3Ditem -r
+
+Update role table in WWDBv3 database from permission level information i=
n
+F<global.conf>.
+
+=3Ditem -s
+
+Update status table in WWDBv3 database from the status information in
+F<global.conf>.
+
+=3Ditem -u
+
+When importing a user that already exists in the WWDBv3 database, replac=
e the
+existing information (including the password) with the information in th=
e user
+record being imported.
+
+If this option is not specified, existing users are not updated.
+
+=3Ditem -v
+
+Verbose operation.
+
+=3Ditem course ...
+
+Data from these courses will be copied.
+
+=3Dback
+
+=3Dhead1 BEHAVIOR
+
+=3Dhead2 ROLES
+
+=3Dover
+
+=3Ditem *
+
+Roles created with the -r switch are created as system-wide roles.
+
+=3Ditem *
+
+Roles are created by observing the %permissionLevels hash in F<global.co=
nf>, and
+collecting the privileges granted at each permission level into sets. Ea=
ch set
+of privileges becomes a WWDBv3 role record.
+
+=3Ditem *
+
+When a role with the same set of permissions already exists in the WWDBv=
3
+database, a new one is not created.
+
+=3Dback
+
+=3Dhead2 STATUSES
+
+=3Dover
+
+=3Ditem *
+
+Statuses created with the -s switch are created as system-wide statuses.
+
+=3Ditem *
+
+Statuses are created by observing the %{$siteDefaults{status}} hash in
+F<global.conf>, and=20
+
+=3Ditem *
+
+A status named "Enrolled" is imported into the database with the
+C<allow_course_access>, C<include_in_assignment>, C<include_in_stats>, a=
nd
+C<include_in_scoring> flags set.
+
+=3Ditem *
+
+A status named "Audit" is imported into the database with the
+C<allow_course_access>, C<include_in_assignment>, and C<include_in_stats=
>, flags
+set, and the C<include_in_scoring> flag unset.
+
+=3Ditem *
+
+A status named "Drop" is imported into the database with the
+C<allow_course_access>, C<include_in_assignment>, C<include_in_stats>, a=
nd
+C<include_in_scoring> flags unset.
+
+=3Ditem *
+
+Statuses with other names are imported into the database with the same f=
lags set
+as the "Enrolled" flag.
+
+=3Dback
+
+=3Dhead2 USERS
+
+=3Dover
+
+=3Ditem *
+
+WWDBv2 user IDs are converted to login IDs.
+
+=3Ditem *
+
+Users with the same v2 user ID in different courses are assumed to be th=
e same
+user.
+
+=3Ditem *
+
+A user's permission level is used to determine the role to assign to the=
ir v3
+participant record. (See L<ROLES>.) If the user has an empty permission =
level,
+they are assigned the role associated with permission level "0".
+
+=3Ditem *
+
+A user's status abbreviation is used to determine the status to assign t=
o their
+v3 participant record. (See L<STATUSES>.) If the user has an empty statu=
s, they
+are assigned the status "Enrolled".
+
+=3Ditem *
+
+If a user has a non-empty section or recitation, their v3 participant re=
cord
+will be assigned to the section or recitation with a matching name.
+
+=3Dback
+
+=3Dcut
+
+use strict;
+use warnings;
+use Data::Dumper;
+use DateTime;
+use Getopt::Std;
+
+BEGIN {
+ die "WEBWORK_ROOT not found in environment.\n"
+ unless exists $ENV{WEBWORK_ROOT};
+}
+
+use lib "$ENV{WEBWORK_ROOT}/lib";
+use WeBWorK::CourseEnvironment;
+use WeBWorK::DB;
+use WeBWorK::DBv3;
+
+# map statuses from course environment to sets of status privileges
+use constant STATUS_MAP =3D> {
+ Enrolled =3D> { allow_course_access =3D> 1, include_in_assignment =3D> =
1, include_in_stats =3D> 1, include_in_scoring =3D> 1 },
+ Audit =3D> { allow_course_access =3D> 1, include_in_assignment =3D> =
1, include_in_stats =3D> 1, include_in_scoring =3D> 0 },
+ Drop =3D> { allow_course_access =3D> 0, include_in_assignment =3D> =
0, include_in_stats =3D> 0, include_in_scoring =3D> 0 },
+};
+
+use constant DEFAULT_STATUS =3D> "C";
+use constant DEFAULT_PERMISSION_LEVEL =3D> "0";
+
+our ($opt_c, $opt_r, $opt_s, $opt_u, $opt_v);
+getopts("crsuv");
+
+sub debug { print STDERR @_ if $opt_v }
+sub usage { print STDERR "usage: $0 [-crsuv] course ...\n"; exit 1 }
+
+main(@ARGV);
+
+sub main {
+ my (@courseIDs) =3D @_;
+=09
+ usage() unless @courseIDs;
+=09
+ my $ce =3D WeBWorK::CourseEnvironment->new({webwork_dir =3D> $ENV{WEBWO=
RK_ROOT}});
+=09
+ WeBWorK::DBv3::init($ce->{wwdbv3_settings});
+=09
+ my %abbrev_to_status_id =3D set_up_statuses($ce->{siteDefaults}{status}=
);
+ warn "abbrev_to_status_id: ", Dumper(\%abbrev_to_status_id);
+=09
+ my %level_to_role_id =3D set_up_roles($ce->{permissionLevels});
+ warn "level_to_role_id: ", Dumper(\%level_to_role_id);
+=09
+ foreach my $courseID (@courseIDs) {
+ eval { copy_course_data($courseID, \%abbrev_to_status_id, \%level_to_r=
ole_id) };
+ if ($@) {
+ warn "An error occured while copying data from course '$courseID':\n\=
n$@\n\n";
+ if ($opt_c) {
+ warn "Continuing with the next course...\n";
+ } else {
+ warn "Exiting.\n";
+ exit 2;
+ }
+ }
+ }
+}
+
+########################################################################=
########
+
+sub reverse_hash {
+ my (%hash) =3D @_;
+=09
+ my %reverse_hash;
+ foreach my $key (keys %hash) {
+ my $value =3D $hash{$key};
+ if (defined $value and not ref $value) {
+ push @{ $reverse_hash{$value} }, $key;
+ #} else {
+ # my $val_string =3D defined $value ? $value : "UNDEF";
+ # warn "pair ( $key =3D> $val_string ) skipped.\n";
+ }
+ }
+=09
+ return %reverse_hash;
+}
+
+sub listeq {
+ my ($a, $b) =3D @_;
+ return "" unless @$a =3D=3D @$b;
+ for (my $i =3D 0; $i < @$a; $i++) {
+ return "" unless $a->[$i] eq $b->[$i];
+ }
+ return 1;
+}
+
+sub is_empty {
+ my ($val) =3D @_;
+ return (not defined $val or $val eq "");
+}
+
+########################################################################=
########
+
+sub set_up_roles {
+ my ($permissionLevels) =3D @_;
+ my %permissionLevels =3D %$permissionLevels;
+=09
+ my %level_to_role_id;
+=09
+ # reverse the permission levels hash, resulting in a hash mapping
+ # permissions levels to arrayrefs containing privileges
+ my %levels =3D reverse_hash(%permissionLevels);
+=09
+ # copy up the privileges at each level to the next-higher level
+ # also sort each level
+ my @level_names =3D sort { $a <=3D> $b } keys %levels;
+ foreach my $i (0 .. $#level_names-1) {
+ my $this_level =3D $level_names[$i];
+ my $next_level =3D $level_names[$i+1];
+ push @{ $levels{$next_level} }, @{ $levels{$this_level} };
+ }
+=09
+ # sort the privileges in each level
+ debug("I found the following permission levels:\n");
+ foreach my $level (keys %levels) {
+ my @sorted =3D sort @{ $levels{$level} };
+ $levels{$level} =3D [ @sorted ];
+ debug("\t$level =3D> @sorted\n");
+ }
+=09
+ # keep track of role names so we know if we need to rename any of our n=
ew ones
+ my %role_names;
+=09
+ # look at existing roles to see if we can avoid adding some new ones
+ my $i =3D retrieve_all WeBWorK::DBv3::Role;
+ while (my $Role =3D $i->next) {
+ $role_names{$Role->name} =3D 1;
+ my @role_privs =3D sort $Role->privs_list;
+ =09
+ foreach my $level (keys %levels) {
+ if (listeq($levels{$level}, \@role_privs)) {
+ debug("Permission level '$level' is already represented as role '",
+ $Role->name, "' (ID $Role) -- skipping.\n");
+ delete $levels{$level};
+ $level_to_role_id{$level} =3D $Role->id;
+ }
+ }
+ }
+=09
+ if ($opt_r) {
+ debug("Updating role table (as per -r switch).\n");
+ foreach my $level (keys %levels) {
+ my $name =3D "Legacy permission level $level";
+ if (exists $role_names{$name}) {
+ my $i =3D 2;
+ while (1) {
+ my $try_name =3D "$name (#$i)";
+ if (not exists $role_names{$try_name}) {
+ $name =3D $try_name;
+ last;
+ }
+ }
+ }
+ =09
+ my @privs =3D @{ $levels{$level} };
+ =09
+ my $Role =3D create WeBWorK::DBv3::Role({name =3D> $name});
+ $Role->privs_list(@privs);
+ $Role->update;
+ debug("Added role '", $Role->name, "' (ID $Role) with privileges '@pr=
ivs'.\n");
+ $level_to_role_id{$level} =3D $Role->id;
+ }
+ } else {
+ debug("Not updating role table (as per lack of -r switch).\n");
+ debug("I might run into users with permission levels that don't map to=
roles later.\n");
+ }
+=09
+ return %level_to_role_id;
+}
+
+sub set_up_statuses {
+ my ($abbrevs) =3D @_;
+ my %abbrevs =3D %$abbrevs;
+=09
+ my %abbrev_to_status_id;
+=09
+ # reverse the statuses hash, resulting in a hash mapping statuses to
+ # arrayrefs containing abbreviations
+ my %statuses =3D reverse_hash(%abbrevs);
+=09
+ # look at existing statuses to see if we can avoid adding some new ones
+ my $i =3D retrieve_all WeBWorK::DBv3::Status;
+ while (my $Status =3D $i->next) {
+ if (exists $statuses{$Status->name}) {
+ debug("Status '", $Status->name, "' (ID $Status) already exists in th=
e database -- skipping.\n");
+ # add entries mapping abbreviations to the ID of this status
+ foreach my $abbrev (@{$statuses{$Status->name}}) {
+ $abbrev_to_status_id{$abbrev} =3D $Status->id;
+ }
+ =09
+ delete $statuses{$Status->name};
+ }
+ }
+=09
+ if ($opt_s) {
+ debug("Updating status table (as per -s switch).\n");
+ foreach my $status (keys %statuses) {
+ my %flags;
+ %flags =3D %{ STATUS_MAP->{$status} } if exists STATUS_MAP->{$status}=
;
+ my $Status =3D create WeBWorK::DBv3::Status({name =3D> $status, %flag=
s});
+ =09
+ my @flags =3D grep { $flags{$_} } keys %flags;
+ debug("Added status '", $Status->name, "' (ID $Status) with flags '@f=
lags'.\n");
+ =09
+ # add entries mapping abbreviations to the ID of this status
+ foreach my $abbrev (@{$statuses{$status}}) {
+ $abbrev_to_status_id{$abbrev} =3D $Status->id;
+ }
+ }
+ } else {
+ debug("Not updating status table (as per lack of -s switch).\n");
+ debug("I might run into users with status abbreviations that don't map=
to statuses later.\n");
+ }
+=09
+ return %abbrev_to_status_id;
+}
+
+########################################################################=
########
+
+sub copy_course_data {
+ my ($courseID, $abbrev_to_status_id, $level_to_role_id) =3D @_;
+=09
+ debug("Processing course '$courseID'...\n");
+=09
+ my $course_ce =3D WeBWorK::CourseEnvironment->new({
+ webwork_dir =3D> $ENV{WEBWORK_ROOT},
+ courseName =3D> $courseID,
+ });
+=09
+ my $course_db =3D WeBWorK::DB->new($course_ce->{dbLayout});
+=09
+ debug("Adding course '$courseID' to v3 DB.\n");
+ my $v3Course =3D eval { create WeBWorK::DBv3::Course({name =3D> $course=
ID}) };
+ $@ =3D~ /Duplicate entry/ and die "Course '$courseID' exists in v3 DB.\=
n";
+ $@ and die $@;
+=09
+ copy_users($course_db, $v3Course, $abbrev_to_status_id, $level_to_role_=
id);
+=09
+ # { $globalSetID =3D> [ $v3AbsSet->id, { $globalProblemID =3D> $vAbsPro=
b->id, ... }, ... }
+ my %global_set_id_to_abstract_set_data =3D copy_abstract_data($course_d=
b, $v3Course);
+}
+
+########################################################################=
########
+
+sub copy_users {
+ my ($course_db, $v3Course, $abbrev_to_status_id, $level_to_role_id) =3D=
@_;
+=09
+ my $DefaultStatus =3D find_status(DEFAULT_STATUS, $abbrev_to_status_id)=
;
+ die "Default status '", DEFAULT_STATUS, "' does not correspond to any v=
3 status.\n"
+ unless $DefaultStatus;
+=09
+ my $DefaultRole =3D find_role(DEFAULT_PERMISSION_LEVEL, $level_to_role_=
id);
+ die "Default permission level '", DEFAULT_PERMISSION_LEVEL, "' does not=
correspond to any v3 role.\n"
+ unless $DefaultRole;
+=09
+ my @userIDs =3D $course_db->listUsers;
+ my %Users; @Users{@userIDs} =3D $course_db->getUsers(@userIDs);
+ my %Passwords; @Passwords{@userIDs} =3D $course_db->getPasswords(@userI=
Ds);
+ my %PermissionLevels; @PermissionLevels{@userIDs} =3D $course_db->getPe=
rmissionLevels(@userIDs);
+=09
+ foreach my $userID (keys %Users) {
+ my $User =3D $Users{$userID};
+ my $Password =3D $Passwords{$userID};
+ my $PermissionLevel =3D $PermissionLevels{$userID};
+ =09
+ unless (defined $User) {
+ debug("User record for user ID '$userID' not found -- skipping.\n");
+ next;
+ }
+ =09
+ debug("Processing user '$userID'...\n");
+ =09
+ # create/update user record
+ my ($v3User) =3D search WeBWorK::DBv3::User(login_id =3D> $userID);
+ if ($v3User) {
+ debug("A user with login_id '$userID' exists in v3 database -- ");
+ if ($opt_u) {
+ # password record might not exist (annoying...)
+ my $password =3D defined $Password ? $Password->password : "";
+ =09
+ debug("updating (as per -u switch).\n");
+ $v3User->first_name($User->first_name) unless is_empty($User->first_=
name);
+ $v3User->last_name($User->first_name) unless is_empty($User->last_na=
me);
+ $v3User->email_address($User->email_address) unless is_empty($User->=
email_address);
+ $v3User->student_id($User->student_id) unless is_empty($User->studen=
t_id);
+ $v3User->password($password) unless is_empty($password);
+ $v3User->update;
+ } else {
+ debug("not updating (as per lack of -u switch).\n");
+ }
+ } else {
+ # password record might not exist (annoying...)
+ my $password =3D defined $Password ? $Password->password : "";
+ =09
+ debug("No user with login_id '$userID' exists in v3 database -- addin=
g.\n");
+ $v3User =3D create WeBWorK::DBv3::User({
+ first_name =3D> $User->first_name,
+ last_name =3D> $User->last_name,
+ email_address =3D> $User->email_address,
+ student_id =3D> $User->student_id,
+ login_id =3D> $User->user_id,
+ password =3D> $password,
+ });
+ }
+ =09
+ # get status
+ my $v3Status =3D find_status($User->status, $abbrev_to_status_id);
+ unless ($v3Status) {
+ debug("Using default status '", $DefaultStatus->name, "'.\n");
+ $v3Status =3D $DefaultStatus;
+ }
+ =09
+ # get role
+ my $level =3D defined $PermissionLevel ? $PermissionLevel->permission =
: "";
+ my $v3Role =3D find_role($level, $level_to_role_id);
+ unless ($v3Role) {
+ debug("Using default role '", $DefaultRole->name, "'.\n");
+ $v3Role =3D $DefaultRole;
+ }
+ =09
+ # find/create section record
+ my $section =3D $User->section;
+ my $v3Section;
+ if (is_empty($section)) {
+ debug("This user has section '$section'.\n");
+ ($v3Section) =3D search WeBWorK::DBv3::Section(course =3D> $v3Course,=
name =3D> $section);
+ if ($v3Section) {
+ debug("This corresponds to existing section ID $v3Section in v3 data=
base.\n");
+ } else {
+ debug("No corresponding section exists in v3 DB -- adding.\n");
+ $v3Section =3D create WeBWorK::DBv3::Section({
+ course =3D> $v3Course,
+ name =3D> $section,
+ });
+ debug("Added section '", $v3Section->name, "' (ID $v3Section).\n");
+ }
+ } else {
+ debug("This user has no section.\n");
+ }
+ =09
+ # find/create recitation record
+ my $recitation =3D $User->recitation;
+ my $v3Recitation;
+ if (is_empty($recitation)) {
+ debug("This user has recitation '$recitation'.\n");
+ ($v3Recitation) =3D search WeBWorK::DBv3::Recitation(course =3D> $v3=
Course, name =3D> $User->recitation);
+ if ($v3Recitation) {
+ debug("This correponds to existing recitation ID $v3Recitation in v3=
database.\n");
+ } else {
+ debug("No corresponding recitation exists in v3 DB -- adding.\n");
+ $v3Recitation =3D create WeBWorK::DBv3::Recitation({
+ course =3D> $v3Course,
+ name =3D> $User->recitation,
+ });
+ debug("Added recitation '", $v3Recitation->name, "' (ID $v3Recitatio=
n).\n");
+ }
+ } else {
+ debug("This user has no recitation.\n");
+ }
+ =09
+ # create participant record
+ debug("Adding participant record for user '$userID'...");
+ #my $sectionID =3D $v3Section->id if defined $v3Section;
+ #my $recitationID =3D $v3Recitation->id if defined $v3Recitation;
+ my $v3Participant =3D create WeBWorK::DBv3::Participant({
+ course =3D> $v3Course,
+ user =3D> $v3User,
+ status =3D> $v3Status,
+ role =3D> $v3Role,
+ section =3D> $v3Section,
+ recitation =3D> $v3Recitation,
+ comment =3D> $User->comment,
+ });
+ debug(" added participant ID $v3Participant.\n");
+ }
+}
+
+sub find_status {
+ my ($status, $abbrev_to_status_id) =3D @_;
+=09
+ return if is_empty($status);
+=09
+ my $v3Status_id =3D $abbrev_to_status_id->{$status};
+ my $v3Status;
+ if (defined $v3Status_id) {
+ #debug("Status '$status' maps to v3 status ID '$v3Status_id'.\n");
+ $v3Status =3D retrieve WeBWorK::DBv3::Status($v3Status_id);
+ } else {
+ #debug("Status '$status' doesn't map to any v3 status.\n");
+ }
+=09
+ return $v3Status;
+}
+
+sub find_role {
+ my ($level, $level_to_role_id) =3D @_;
+=09
+ return if is_empty($level);
+=09
+ my $v3Role_id =3D $level_to_role_id->{$level};
+ my $v3Role;
+ if (defined $v3Role_id) {
+ #debug("Permission level '$level' maps to v3 role ID '$v3Role_id'.\n")=
;
+ $v3Role =3D retrieve WeBWorK::DBv3::Role($v3Role_id);
+ } else {
+ #debug("Permission level '$level' doesn't map to any v3 role.\n");
+ }
+=09
+ return $v3Role;
+}
+
+########################################################################=
########
+
+sub copy_abstract_data {
+ my ($course_db, $v3Course) =3D @_;
+=09
+ my %global_set_id_to_abstract_set_data;
+=09
+ my @globalSetIDs =3D $course_db->listGlobalSets;
+ my %GlobalSets; @GlobalSets{@globalSetIDs} =3D $course_db->getGlobalSet=
s(@globalSetIDs);
+=09
+ foreach my $globalSetID (keys %GlobalSets) {
+ my $GlobalSet =3D $GlobalSets{$globalSetID};
+ =09
+ unless (defined $GlobalSet) {
+ debug("Global set record for global set ID '$globalSetID' not found -=
- skipping.\n");
+ next;
+ }
+ =09
+ debug("Processing global set '$globalSetID'...\n");
+ =09
+ # set up some fields that need setting up
+ # (if the conditional is false, the variable is left undefined)
+ =09
+ # convert empty strings to undefined values
+ my $set_header =3D $GlobalSet->set_header unless is_empty($GlobalSet->=
set_header);
+ my $hardcopy_header =3D $GlobalSet->hardcopy_header unless is_empty($G=
lobalSet->hardcopy_header);
+ =09
+ # convert=20
+ my $open_date =3D DateTime->from_epoch(epoch =3D> $GlobalSet->open_dat=
e);
+ my $due_date =3D DateTime->from_epoch(epoch =3D> $GlobalSet->due_date)=
;
+ my $answer_date =3D DateTime->from_epoch(epoch =3D> $GlobalSet->answer=
_date);
+ =09
+ # create abstract_set record
+ debug("Adding abstract_set record for global set '$globalSetID'...");
+ my $v3AbsSet =3D create WeBWorK::DBv3::AbstractSet({
+ course =3D> $v3Course,
+ name =3D> $GlobalSet->set_id,
+ set_header =3D> $set_header,
+ hardcopy_header =3D> $hardcopy_header,
+ open_date =3D> $open_date,
+ due_date =3D> $due_date,
+ answer_date =3D> $answer_date,
+ published =3D> $GlobalSet->published,
+ });
+ debug(" added abstract_set ID '$v3AbsSet'.\n");
+ =09
+ =09
+ my %problem_mapping;
+ =09
+ my @globalProblemIDs =3D sort { $a <=3D> $b } $course_db->listGlobalPr=
oblems($globalSetID);
+ warn "globalProblemIDs=3D@globalProblemIDs\n";
+ my %GlobalProblems; @GlobalProblems{@globalProblemIDs}
+ =3D $course_db->getGlobalProblems(map { [ $globalSetID, $_ ] } @globa=
lProblemIDs);
+ =09
+ my @problem_order;
+ =09
+ foreach my $globalProblemID (@globalProblemIDs) {
+ my $GlobalProblem =3D $GlobalProblems{$globalProblemID};
+ =09
+ unless (defined $GlobalProblem) {
+ warn "Global problem record for global problem ID '$globalProblemID'=
in set ID '$globalSetID' not found -- skipping.\n";
+ next;
+ }
+ =09
+ debug("Processing global problem '$globalProblemID'...\n");
+ =09
+ # convert max_attempts of -1 to undef
+ my $max_attempts_per_version =3D $GlobalProblem->max_attempts
+ if $GlobalProblem->max_attempts >=3D 0;
+ =09
+ # create abstract_problem record
+ debug("Adding abstract_set record for global problem '$globalProblemI=
D'...");
+ my $v3AbsProb =3D create WeBWorK::DBv3::AbstractProblem({
+ abstract_set =3D> $v3AbsSet,
+ name =3D> "Legacy problem $globalProblemID",
+ source_type =3D> "file",
+ source_file =3D> $GlobalProblem->source_file,
+ weight =3D> $GlobalProblem->value,
+ max_attempts_per_version =3D> $max_attempts_per_version,
+ version_creation_interval =3D> undef,
+ versions_per_interval =3D> 1,
+ version_due_date_offset =3D> undef,
+ version_answer_date_offset =3D> undef,
+ });
+ debug(" added abstract_problem ID '$v3AbsProb'.\n");
+ =09
+ push @problem_order, $v3AbsProb->id;
+ =09
+ $problem_mapping{$globalProblemID} =3D $v3AbsProb->id;
+ }
+ =09
+ # update problem order
+ debug("Setting problem order to: '@problem_order'...");
+ $v3AbsSet->problem_order_list(@problem_order);
+ $v3AbsSet->update;
+ debug(" done.\n");
+ =09
+ $global_set_id_to_abstract_set_data{$globalSetID} =3D [ $v3AbsSet->id,=
\%problem_mapping ];
+ }
+=09
+ return %global_set_id_to_abstract_set_data;
+}
+
+########################################################################=
########
+
+sub copy_assignment_data {
+ my ($course_db, $v3Course, $global_set_id_to_abstract_set_data) =3D @_;
+=09
+ my $participant_iter =3D WeBWorK::DBv3::Participant->search(course =3D>=
$v3Course);
+=09
+ while (my $Participant =3D $participant_iter->next) {
+ my @userSetIDs =3D $course_db->listUserSets($Participant->user->login_=
id);
+ $v3AbsSet->
+ }
+}
+
+sub copy_single_assignment {
+ my ($course_db, $v3Course, $v3Participant, $v3AbsSet, $global_set_id_to=
_abstract_set_data) =3D @_;
+=09
+=09
+}
--- /dev/null
+++ clients/input.txt
@@ -0,0 +1,99 @@
+##DESCRIPTION
+## A very simple first problem
+##ENDDESCRIPTION
+##KEYWORDS('algebra')
+DOCUMENT(); # This should be the first executable line in the pro=
blem.
+loadMacros(
+"PG.pl",
+"PGbasicmacros.pl",
+"PGchoicemacros.pl",
+"PGanswermacros.pl",
+"PGauxiliaryFunctions.pl"
+);
+
+TEXT(&beginproblem);
+$showPartialCorrectAnswers =3D 1;
+$a =3D random(-10,-1,1);
+$b =3D random(1,11,1);
+$c =3D random(1,11,1);
+$d =3D random(1,11,1);
+
+BEGIN_TEXT
+$PAR
+displayMode is $displayMode $BR
+$PAR
+This problem demonstrates how you enter numerical answers into WeBWorK. =
$PAR
+Evaluate the expression \(3($a )($b -$c -2($d ))\):
+
+ \{ ans_rule(10) \}
+
+$BR
+END_TEXT
+$ans =3D 3*($a)*($b-$c-2*($d));
+
+&ANS(strict_num_cmp($ans));
+
+BEGIN_TEXT
+
+In the case above you need to enter a number, since we're testing whethe=
r you can multiply
+out these numbers. (You can use a calculator if you want.)=20
+$PAR
+For most problems, you will be able to get WeBWorK to
+do some of the work for you. For example
+$BR
+Calculate ($a) * ($b): \{ ans_rule()\}
+$BR
+END_TEXT
+$ans =3D $a*$b;
+
+&ANS(std_num_cmp($ans));
+
+BEGIN_TEXT
+The asterisk is what most computers use to denote multiplication and you=
can use this with WeBWorK.=20
+But WeBWorK will also allow use to use a space to denote multiplication.
+You can either \($a * $b\) or \{$a*$b\} or even \($a \ $b\). All will w=
ork. Try them. =20
+$PAR
+Now try calculating the sine of 45 degrees ( that's sine of pi over 4 in=
radians
+and numerically sin(pi/4) equals \{1/sqrt(2)\} or, more precisely, \(1/=
\sqrt{2} \) ). =20
+You can enter this as sin(pi/4) , as=20
+sin(3.1415926/4), as 1/sqrt(2), as 2**(-.5), etc. This is because WeBWor=
K knows about=20
+functions like sin and sqrt (square root). (Note: exponents
+can be indicated by either a "caret" or **). Try it.$BR \( \sin(\pi/4) =
=3D \) \{ ans_rule(20) \}$PAR
+ Here's the=20
+\{
+htmlLink(qq!http://webwork.math.rochester.edu/webwork_system_html/docs/d=
ocs/pglanguage/availablefunctions.html!,"list=20
+of the functions") \}
+ which WeBWorK understands. WeBWorK ALWAYS uses radian mode for trig f=
unctions.=20
+ $PAR
+END_TEXT
+
+&ANS( std_num_cmp(sin(3.1415926/4)) );
+BEGIN_TEXT
+You can also use juxtaposition to denote multiplication. E.g. enter \( 2=
\sin(3\pi/2) \).
+You can enter this as 2*sin(3*pi/2) or more simply as 2sin(3pi/2). Try =
it: $BR=20
+\{ ans_rule(20) \}$PAR
+
+END_TEXT
+
+$pi =3D 4*atan(1);
+&ANS( std_num_cmp(2*sin(3*$pi/2)) );
+
+BEGIN_TEXT
+Sometimes you need to use ( )'s to make your meaning clear. E.g. 1/2+3 i=
s 3.5, but 1/(2+3) is .2 Why?
+Try entering both and use the ${LQ}Preview${RQ} button below to see the =
difference. In addition to
+( )'s, you can also use [ ]'s and $LB ${RB}'s. $BR
+\{ ans_rule(20) \}$PAR
+END_TEXT
+
+&ANS( std_num_cmp(.2));
+
+BEGIN_TEXT
+You can always try to enter answers and let WeBWorK do the calculating.=20
+WeBWorK will tell you if the problem requires a strict numerical answer.=
=20
+The way we use WeBWorK in this class there is no penalty for getting an =
answer wrong. What counts
+is that you get the answer right eventually (before the due date). For =
complicated answers,
+you should use the ${LQ}Preview${RQ} button to check for syntax errors a=
nd also to check that the answer
+you enter is really what you think it is.
+END_TEXT
+
+ENDDOCUMENT(); # This should be the last executable line in the p=
roblem.
--- /dev/null
+++ clients/webwork_xmlrpc_client.pl
@@ -0,0 +1,277 @@
+#!/usr/local/bin/perl -w
+
+use XMLRPC::Lite;
+
+# configuration section
+use constant HOSTURL =3D> 'devel.webwork.rochester.edu';=20
+use constant HOSTPORT =3D> 8002;
+use constant TRANSPORT_METHOD =3D> 'XMLRPC::Lite';
+use constant REQUEST_CLASS =3D>'WebworkXMLRPC'; # WebworkXMLRPC is use=
d for soap also!!
+use constant REQUEST_URI =3D>'mod_xmlrpc';
+my @COMMANDS =3D qw( listLibraries renderProblem ); #listLib readFi=
le tex2pdf=20
+
+# $pg{displayModes} =3D [
+# "plainText", # display raw TeX for math expressions
+# "formattedText", # format math expressions using TtH
+# "images", # display math expressions as images generated by dv=
ipng
+# "jsMath", # render TeX math expressions on the client side usi=
ng jsMath
+# "asciimath", # render TeX math expressions on the client side usi=
ng ASCIIMathML
+# ];
+use constant DISPLAYMODE =3D> 'images';
+
+# end configuration section
+use MIME::Base64 qw( encode_base64 decode_base64);
+
+
+print STDERR "inputs are ", join (" | ", @ARGV), "\n";
+our $source;
+
+if (@ARGV) {
+ my $command =3D $ARGV[0];
+ =20
+ warn "executing WebworkXMLRPC.$command";
+ $source =3D (defined $ARGV[1]) ? `cat $ARGV[1]` : '' ;
+ xmlrpcCall($command);
+
+
+} else {
+
+ print STDERR "Useage: .xmlrpc_client4.pl command file_name\n";
+ print STDERR "For example: .xmlrpc_client4.pl renderProblem input.txt=
\n";
+ print STDERR "For example: .xmlrpc_client4.pl listLibraries \n";
+ print STDERR "Commands are: ", join(" ", @COMMANDS), "\n";
+=09
+}
+
+
+
+sub xmlrpcCall {
+ my $command =3D shift;
+ $command =3D 'listLibraries' unless $command;
+
+ my $requestResult =3D TRANSPORT_METHOD
+ #->uri('http://'.HOSTURL.':'.HOSTPORT.'/'.REQUEST_CLASS)
+ -> proxy('http://'.HOSTURL.':'.HOSTPORT.'/'.REQUEST_URI);
+ =09
+ my $test =3D [3,4,5,6]; =20
+ my $input =3D setInputTable();
+ print "displayMode=3D",$input->{envir}->{displayMode},"\n";
+ local( $result);
+ # use eval to catch errors
+ eval { $result =3D $requestResult->call(REQUEST_CLASS.'.'.$command,$i=
nput) };
+ print STDERR "There were a lot of errors\n" if $@;
+ print "Errors: \n $@\n End Errors\n" if $@;
+=09
+ print "result is|", ref($result),"|";
+=09
+ unless (ref($result) and $result->fault) {
+ =20
+ if (ref($result->result())=3D~/HASH/ and defined($result->result()->=
{text}) ) {
+ $result->result()->{text} =3D decode_base64($result->result()->{tex=
t});
+ }
+ print pretty_print_rh($result->result()),"\n"; #$result->result()
+ } else {
+ print 'oops ', join ', ',
+ $result->faultcode,
+ $result->faultstring;
+ }
+}
+ =20
+sub source {
+ encode_base64($source);
+}
+sub pretty_print_rh {=20
+ shift if UNIVERSAL::isa($_[0] =3D> __PACKAGE__);
+ my $rh =3D shift;
+ my $indent =3D shift || 0;
+ my $out =3D "";
+ my $type =3D ref($rh);
+
+ if (defined($type) and $type) {
+ $out .=3D " type =3D $type; ";
+ } elsif (! defined($rh )) {
+ $out .=3D " type =3D UNDEFINED; ";
+ }
+ return $out." " unless defined($rh);
+=09
+ if ( ref($rh) =3D~/HASH/ or "$rh" =3D~/HASH/ ) {
+ $out .=3D "{\n";
+ $indent++;
+ foreach my $key (sort keys %{$rh}) {
+ $out .=3D " "x$indent."$key =3D> " . pretty_print_rh( $rh->{$key}, =
$indent ) . "\n";
+ }
+ $indent--;
+ $out .=3D "\n"." "x$indent."}\n";
+
+ } elsif (ref($rh) =3D~ /ARRAY/ or "$rh" =3D~/ARRAY/) {
+ $out .=3D " ( ";
+ foreach my $elem ( @{$rh} ) {
+ $out .=3D pretty_print_rh($elem, $indent);
+ =09
+ }
+ $out .=3D " ) \n";
+ } elsif ( ref($rh) =3D~ /SCALAR/ ) {
+ $out .=3D "scalar reference ". ${$rh};
+ } elsif ( ref($rh) =3D~/Base64/ ) {
+ $out .=3D "base64 reference " .$$rh;
+ } else {
+ $out .=3D $rh;
+ }
+=09
+ return $out." ";
+}
+
+sub setInputTable_for_listLib {
+ $out =3D {
+ #password =3D> 'geometry',
+ pw =3D> 'geometry',
+ set =3D> 'set0',
+ library_name =3D> 'rochesterLibrary',
+ command =3D> 'all',
+ };
+
+ $out;
+}
+sub setInputTable {
+ $out =3D {
+ #password =3D> 'geometry',
+ pw =3D> 'geometry',
+ set =3D> 'set0',
+ library_name =3D> 'rochesterLibrary',
+ command =3D> 'all',
+ answer_form_submitted =3D> 1,
+ course =3D> 'daemon_course',
+ extra_packages_to_load =3D> [qw( AlgParserWithImplicitExpand Expr
+ ExprWithImplicitExpand AnswerEvaluator
+ AnswerEvaluatorMaker=20
+ )],
+ mode =3D> 'HTML_dpng',
+ modules_to_evaluate =3D> [ qw(=20
+Exporter
+
+DynaLoader
+
+ =09
+GD
+WWPlot
+Fun
+Circle
+Label
+
+ =09
+PGrandom
+Units
+Hermite
+
+List
+
+ =09
+Match
+Multiple
+Select
+
+ =09
+AlgParser
+
+AnswerHash
+
+ =09
+Fraction
+VectorField
+
+ =09
+Complex1
+Complex
+
+ =09
+MatrixReal1 Matrix
+
+ =09
+Distr...
[truncated message content] |
|
From: Gavin L. v. a. <we...@ma...> - 2005-06-09 16:21:11
|
Log Message:
-----------
Gateway update: make display of test time in Student Progress default to yes
Tags:
----
rel-2-1-a1
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
StudentProgress.pm
Revision Data
-------------
Index: StudentProgress.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm,v
retrieving revision 1.4.2.6
retrieving revision 1.4.2.7
diff -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -u -r1.4.2.6 -r1.4.2.7
--- lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm
@@ -308,7 +308,7 @@
# the returning parameter lets us set defaults for versioned sets
my $ret = $r->param('returning');
$showColumns{'date'} = $ret ? $r->param('show_date') : 1;
- $showColumns{'testtime'} = $ret ? $r->param('show_testtime') : 0;
+ $showColumns{'testtime'} = $ret ? $r->param('show_testtime') : 1;
$showColumns{'index'} = $ret ? $r->param('show_index') : 0;
$showColumns{'problems'} = $ret ? $r->param('show_problems') : 0;
$showColumns{'section'} = $ret? $r->param('show_section') : 0;
|
|
From: Gavin L. v. a. <we...@ma...> - 2005-06-09 16:17:38
|
Log Message:
-----------
Gateway update: change Grades table to display gateway tests better.
Tags:
----
rel-2-1-a1
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
Grades.pm
Revision Data
-------------
Index: Grades.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Grades.pm,v
retrieving revision 1.5.2.3
retrieving revision 1.5.2.4
diff -Llib/WeBWorK/ContentGenerator/Grades.pm -Llib/WeBWorK/ContentGenerator/Grades.pm -u -r1.5.2.3 -r1.5.2.4
--- lib/WeBWorK/ContentGenerator/Grades.pm
+++ lib/WeBWorK/ContentGenerator/Grades.pm
@@ -194,8 +194,10 @@
my @setIDs = sort $db->listUserSets($studentName);
my $fullName = join("", $studentRecord->first_name," ", $studentRecord->last_name);
+ my $effectiveUser = $studentRecord->user_id();
+
my $act_as_student_url = "$root/$courseName/?user=".$r->param("user").
- "&effectiveUser=".$studentRecord->user_id()."&key=".$r->param("key");
+ "&effectiveUser=$effectiveUser&key=".$r->param("key");
print CGI::h3($fullName ),
@@ -209,18 +211,34 @@
my @rows;
my $max_problems=0;
-
- # FIXME: we adjust the URL for ALL VERSIONED SETS to point to the gateway quiz module.
- # FIXME: this is a fudge to avoid having to get the actual set data from the database
- # FIXME: to see if it's got $set->assignment_type() =~ /gateway/
- # FIXME: in the long run this is not a good solution
foreach my $setName (@setIDs) {
my $act_as_student_set_url = "$root/$courseName/$setName/?user=".$r->param("user").
- "&effectiveUser=".$studentRecord->user_id()."&key=".$r->param("key");
- if ( $setName =~ /,v\d+$/ ) {
- $act_as_student_set_url =~ s/($courseName)\//$1\/quiz_mode\//;
+ "&effectiveUser=$effectiveUser&key=".$r->param("key");
+
+ # get the set from the database so that we know if it's a gateway
+ # and if it's versioned, which determines how we display it.
+ my $set;
+ if ( $setName =~ /,v\d+$/ ) { # then it's versioned
+ $set = $db->getMergedVersionedSet( $effectiveUser, $setName );
+ } else {
+ $set = $db->getMergedSet( $effectiveUser, $setName );
}
+
+ if ( defined( $set->assignment_type() ) &&
+ $set->assignment_type() =~ /gateway/ ) {
+ # skip template sets
+ next if ( $setName !~ /,v\d+$/ );
+ # reset the URL for gateways
+ if ( $set->assignment_type() eq 'proctored_gateway' ) {
+ $act_as_student_set_url =~
+ s/($courseName)\//$1\/proctored_quiz_mode\//;
+ } else {
+ $act_as_student_set_url =~
+ s/($courseName)\//$1\/quiz_mode\//;
+ }
+ }
+
my $status = 0;
my $attempted = 0;
my $longStatus = '';
|
|
From: Gavin L. v. a. <we...@ma...> - 2005-06-09 15:02:17
|
Log Message:
-----------
Gateway update: revise gateway template file
Tags:
----
rel-2-1-a1
Modified Files:
--------------
webwork2/conf/templates:
gw.template
Revision Data
-------------
Index: gw.template
===================================================================
RCS file: /webwork/cvs/system/webwork2/conf/templates/Attic/gw.template,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -Lconf/templates/gw.template -Lconf/templates/gw.template -u -r1.1.2.2 -r1.1.2.3
--- conf/templates/gw.template
+++ conf/templates/gw.template
@@ -200,7 +200,7 @@
</style>
<script language="javascript" type="text/javascript">
-function jumpTo(ref) { // scrolling javascript functin
+function jumpTo(ref) { // scrolling javascript function
if ( ref ) {
var pn = ref - 1; // we start anchors at 1, not zero
if ( navigator.appName == "Netscape" &&
@@ -222,6 +222,8 @@
// timer for gateway
var theTime = -1; // -1 before we've initialized
+var alerted = -1; // -1 = no alert set; 1 = 1st alert set
+ // this shouldn't really be needed
function runtimer() {
// aesthetically this is displeasing: we're assuming that the
@@ -241,10 +243,26 @@
theTime = st;
tm.value = toMinSec(theTime);
setTimeout("runtimer()", 1000); // 1000 ms = 1 sec
- } else {
+ } else if ( theTime == 0 && alerted != 3 ) {
+ alert("* You are out of time! *");
+ alerted = 3;
+ } else if ( alerted != 3 ) {
theTime--;
tm.value = toMinSec(theTime);
setTimeout("runtimer()", 1000); // 1000 ms = 1 sec
+ if ( theTime == 35 && alerted != 2 ) { // time is in seconds
+ alert("* You have only about 30 seconds to complete " +
+ "this assignment. Press Grade very soon! *\n" +
+ "* The timer stops while this alert box is open. *");
+ alerted = 2;
+ theTime -= 5;
+ } else if ( theTime == 75 && alerted != 1) {
+ alert("* You have only about a minute left " +
+ "to complete this assignment! *\n" +
+ "* The timer stops while this alert box is open. *");
+ alerted = 1;
+ theTime -= 5;
+ }
}
}
}
|
|
From: Gavin L. v. a. <we...@ma...> - 2005-06-09 15:01:51
|
Log Message:
-----------
Gateway bugfixes/feature additions
- added test time to student progress display
- corrected bugs from overtime proctored tests
- corrected behavior for closed tests
- added restrictions to prevent gateways from being taken as regular
assignments
- updated problem set lists to better deal with gateways
Tags:
----
rel-2-1-a1
Modified Files:
--------------
webwork2/lib/WeBWorK/ContentGenerator:
GatewayQuiz.pm
Problem.pm
ProblemSet.pm
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
ProblemSetEditor.pm
ProblemSetList.pm
StudentProgress.pm
Revision Data
-------------
Index: Problem.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Problem.pm,v
retrieving revision 1.143.2.4
retrieving revision 1.143.2.5
diff -Llib/WeBWorK/ContentGenerator/Problem.pm -Llib/WeBWorK/ContentGenerator/Problem.pm -u -r1.143.2.4 -r1.143.2.5
--- lib/WeBWorK/ContentGenerator/Problem.pm
+++ lib/WeBWorK/ContentGenerator/Problem.pm
@@ -84,6 +84,9 @@
#
# ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem)
+# *** GatewayQuiz note:
+# *** The "can" routines are excerpted with few changes to GatewayQuiz.pm
+
sub can_showOldAnswers {
#my ($self, $User, $PermissionLevel, $EffectiveUser, $Set, $Problem) = @_;
@@ -167,6 +170,10 @@
sub after { return time >= $_[0] }
sub between { my $t = time; return $t > $_[0] && $t < $_[1] }
+# *** GatewayQuiz note:
+# *** output utilities are transcribed verbatim to GatewayQuiz.pm, though
+# *** we may change the summary message in attemptResults at some point
+
################################################################################
# output utilities
################################################################################
@@ -390,10 +397,23 @@
# obtain the merged set for $effectiveUser
my $set = $db->getMergedSet($effectiveUserName, $setName); # checked
+
+# gateway check here: we want to be sure that someone isn't trying to take
+# a GatewayQuiz through the regular problem/homework mechanism, thereby
+# circumventing the versioning, time limits, etc.
+ $self->{invalidSet} = 'The "Problem" ContentGenerator was called for ' .
+ 'a GatewayQuiz' if ( defined( $set->assignment_type() ) &&
+ $set->assignment_type() =~ /gateway/ );
# obtain the merged problem for $effectiveUser
my $problem = $db->getMergedProblem($effectiveUserName, $setName, $problemNumber); # checked
+ # this shouldn't happen, but we're happy to have a check to preent people
+ # from gaming the system
+ die "Set $setName is a gateway test. Error in ContentGenerator call."
+ if ( defined($set) && defined( $set->assignment_type ) &&
+ $set->assignment_type =~ /gateway/ );
+
my $editMode = $r->param("editMode");
if ($authz->hasPermissions($userName, "modify_problem_sets")) {
@@ -857,6 +877,11 @@
##### answer processing #####
$WeBWorK::timer->continue("begin answer processing") if defined($WeBWorK::timer);
+
+# *** GatewayQuiz note:
+# *** this conditional through to the output section of this subroutine is
+# *** duplicated almost verbatim in GatewayQuiz.pm, after wrapping it in a loop.
+
# if answers were submitted:
my $scoreRecordedMessage;
my $pureProblem;
Index: GatewayQuiz.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/GatewayQuiz.pm,v
retrieving revision 1.9.4.9
retrieving revision 1.9.4.10
diff -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -u -r1.9.4.9 -r1.9.4.10
--- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm
+++ lib/WeBWorK/ContentGenerator/GatewayQuiz.pm
@@ -19,21 +19,11 @@
=head1 NAME
-WeBWorK::ContentGenerator::GatewayQuiz - display a quiz of problems on one page,
+WeBWorK::ContentGenerator::GatewayQuiz - display a quiz of problems on one page,
deal with versioning sets
=cut
-# ASSUMPTIONS ABOUT DATABASE DATA
-# set data includes the new entries:
-# assignment_type
-# attempts_per_version
-# time_interval
-# versions_per_interval
-# version_time_limit
-# version_creation_time
-# problem_randorder
-
use strict;
use warnings;
use CGI qw();
@@ -205,7 +195,7 @@
# gateway change here: we allow an optional additional argument to use as the
# time to check rather than time()
sub before { return (@_==2) ? $_[1] <= $_[0] : time <= $_[0] }
-sub after { return (@_==2) ? $_[1] <= $_[0] : time >= $_[0] }
+sub after { return (@_==2) ? $_[1] >= $_[0] : time >= $_[0] }
sub between { my $t = (@_==3) ? $_[2] : time; return $t > $_[0] && $t < $_[1] }
################################################################################
@@ -691,6 +681,9 @@
$versionIsOpen = 1;
} else {
$versionIsOpen = 0; # redundant; default is 0
+ $self->{invalidSet} = "No new versions of this assignment" .
+ "are available,\nbecause the set is not open or its" .
+ "time limit has expired.\n";
}
} elsif ( $versionsPerInterval &&
@@ -744,15 +737,21 @@
}
# set isn't available.
- } else {
+ } elsif ( ! $isOpen ) {
# die("No available set version is available for $userName, and " .
# "none can be created after the due date.")
$self->{invalidSet} = "This assignment is not open.";
- if ( $isClosed) {
- $self->{invalidSet} .= "\nPreviously completed versions " .
- "may be available for practice,\n but no new versions " .
- "may be obtained at this time.\n";
- }
+# the following isn't what we want, because ! isOpen -> before open date,
+# while isClosed -> after closed date, which takes care of itself (we
+# aren't allowed to save answers, etc.) so that we don't need any error message
+# if ( $isClosed) {
+# $self->{invalidSet} .= "\nPreviously completed versions " .
+# "may be available for practice,\n but no new versions " .
+# "may be obtained at this time.\n";
+# }
+ } elsif ( ! $requestedVersion ) { # closed set, with attempt at a new one
+ $self->{invalidSet} = "This set is closed. No new set versions may " .
+ "be taken.";
}
@@ -1017,6 +1016,7 @@
my $setVersionName = $set->set_id;
my ( $setName ) = ( $setVersionName =~ /(.*),v\d+$/ );
+ my ( $versionNumber ) = ( $setVersionName =~ /.*,v(\d+)$/ );
# translation errors -- we use the same output routine as Problem.pm, but
# play around to allow for errors on multiple translations because we
@@ -1185,44 +1185,37 @@
}
} # end loop through problems
-# additional set-level submitAnswers database manipulation: this is all
-# for versioned sets/gateway tests
+# warn("in submitanswers conditional\n");
+
+ } # end if submitAnswers conditional
+ $WeBWorK::timer->continue("end answer processing")
+ if defined( $WeBWorK::timer );
+
+# additional set-level database manipulation: this is all for versioned
+# sets/gateway tests
# we want to save the time that a set was submitted, and for proctored
# tests we want to reset the assignment type after a set is submitted
-# for the last time so that it's possible to look at it without getting
-# proctor authorization
- if ( $will{recordAnswers} || ( ! $can{recordAnswersNextTime} &&
- $set->assignment_type() eq 'proctored_gateway' ) ) {
+# for the last time so that it's possible to look at it later without
+# getting proctor authorization
+ if ( ( $submitAnswers && $will{recordAnswers} ) ||
+ ( ! $can{recordAnswersNextTime} &&
+ $set->assignment_type() eq 'proctored_gateway' ) ) {
+
# warn("in put set conditional\n");
- my $setName = $set->set_id();
-# I started out getting the set back out of the database, but I don't think
-# this is needed here. the only manipulation of the $set object is internal,
-# so I think it's safe to just use the $set that we have
-# # note that getMergedVersionedSet returns the requested set if the set name is
-# # versioned ("name,vN"), or the latest set if no version is specified (that
-# # is, it gives us the set we're working with)
-# my $cleanSet = $db->getMergedVersionedSet($user,$setName);
-
- if ( $will{recordAnswers} ) {
-# $cleanSet->version_last_attempt_time( $timeNow );
- $set->version_last_attempt_time( $timeNow );
-# warn("set last attempt time in clean set " . $set->set_id() . " to $timeNow\n");
- }
- if ( ! $can{recordAnswersNextTime} &&
- $set->assignment_type() eq 'proctored_gateway' ) {
-# $cleanSet->assignment_type( 'gateway' );
- $set->assignment_type( 'gateway' );
- }
-# $db->putVersionedUserSet( $cleanSet );
- $db->putVersionedUserSet( $set );
+ my $setName = $set->set_id();
+
+ if ( $submitAnswers && $will{recordAnswers} ) {
+ $set->version_last_attempt_time( $timeNow );
+ }
+ if ( ! $can{recordAnswersNextTime} &&
+ $set->assignment_type() eq 'proctored_gateway' ) {
+ $set->assignment_type( 'gateway' );
}
+ $db->putVersionedUserSet( $set );
+ }
-# warn("in submitanswers conditional\n");
- } # end if submitAnswers conditional
- $WeBWorK::timer->continue("end answer processing")
- if defined( $WeBWorK::timer );
####################################
# output
@@ -1261,7 +1254,8 @@
}
print CGI::div({class=>"$divClass"},
- CGI::strong("Score on this attempt = " .
+ CGI::strong("Score on this attempt (test number " .
+ "$versionNumber) = " .
"$overallScore / $totPossible"),
CGI::br(),
CGI::strong("$recdMsg")),"\n\n";
@@ -1276,8 +1270,9 @@
"because its time limit has expired.\n" .
"To attempt the set again, please try again after the time " .
"limit between versions has expired.\n";
- print CGI::p(CGI::strong("Note: this set version can no longer be " .
- "submitted for a grade"),"\n",$mesg,"\n",
+ print CGI::p(CGI::strong("Note: this set version (number " .
+ "$versionNumber) can no longer be submitted for a" .
+ " grade"),"\n",$mesg,"\n",
"You may, however, check your answers to see what you did" .
" right or wrong."), "\n\n";
print CGI::end_div();
@@ -1476,6 +1471,18 @@
print CGI::endform();
+# debugging verbiage
+# if ( $can{checkAnswersNextTime} ) {
+# print "Can check answers next time\n";
+# } else {
+# print "Can NOT check answers next time\n";
+# }
+# if ( $can{recordAnswersNextTime} ) {
+# print "Can record answers next time\n";
+# } else {
+# print "Can NOT record answers next time\n";
+# }
+
# we exclude the feedback form from gateway tests. they can use the feedback
# button on the preceding or following pages
# my $ce = $r->ce;
Index: ProblemSet.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/ProblemSet.pm,v
retrieving revision 1.54.2.4
retrieving revision 1.54.2.5
diff -Llib/WeBWorK/ContentGenerator/ProblemSet.pm -Llib/WeBWorK/ContentGenerator/ProblemSet.pm -u -r1.54.2.4 -r1.54.2.5
--- lib/WeBWorK/ContentGenerator/ProblemSet.pm
+++ lib/WeBWorK/ContentGenerator/ProblemSet.pm
@@ -48,6 +48,9 @@
die "user $user (real user) not found." unless $user;
die "effective user $effectiveUserName not found. One 'acts as' the effective user." unless $effectiveUser;
+ die "set $setName is a GatewayQuiz. Enter through the GatewayQuiz " .
+ "module." if ( defined( $set->assignment_type() ) &&
+ $set->assignment_type() =~ /gateway/ );
# A set is valid if it is defined and if it is either published or the user is privileged.
$self->{invalidSet} = !(defined $set && ($set->published || $authz->hasPermissions($userName, "view_unpublished_sets")));
@@ -102,7 +105,7 @@
my @setIDs = sortByName(undef, $db->listUserSets($eUserID));
# do not show unpublished siblings unless user is allowed to view unpublished sets
unless ($authz->hasPermissions($user, "view_unpublished_sets") ) {
- @setIDs = grep {my $vset = $db->getGlobalSet($_); my $visible = defined($vset) ? $vset->published : 0; (defined($visible))? $visible : 1}
+ @setIDs = grep {my $visible = $db->getGlobalSet( $_)->published; (defined($visible))? $visible : 1}
@setIDs;
}
print CGI::start_ul({class=>"LinksMenu"});
Index: ProblemSetEditor.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetEditor.pm,v
retrieving revision 1.57.2.4
retrieving revision 1.57.2.5
diff -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetEditor.pm -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetEditor.pm -u -r1.57.2.4 -r1.57.2.5
--- lib/WeBWorK/ContentGenerator/Instructor/ProblemSetEditor.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/ProblemSetEditor.pm
@@ -415,7 +415,7 @@
my $timeInterval = ( defined( $setRecord->time_interval ) &&
$setRecord->time_interval ne '' ) ?
int(($setRecord->time_interval() + 0.5)/60) :
- 7200; # default is 12 hours
+ 720; # default is 12 hours
print CGI::table( {},
CGI::Tr( {}, [
CGI::td( {}, " ",
@@ -448,7 +448,7 @@
CGI::td( {}, " ",
setRowHTML( "Order problems randomly in set (0|1)",
"problem_randorder",
- $setRecord->problem_randorder ?
+ $setRecord->problem_randorder ne '' ?
$setRecord->problem_randorder : 1,
3,
@{$overrideArgs{problem_randorder}}) .
Index: StudentProgress.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm,v
retrieving revision 1.4.2.5
retrieving revision 1.4.2.6
diff -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -u -r1.4.2.5 -r1.4.2.6
--- lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm
@@ -269,8 +269,9 @@
# only see the best score, so we include that as an option also.
# defaults:
my %showColumns = ( 'name' => 1, 'score' => 1, 'outof' => 1,
- 'date' => 0, 'index' => 1, 'problems' => 1,
- 'section' => 1, 'recit' => 1, 'login' => 1 );
+ 'date' => 0, 'testtime' => 1, 'index' => 1,
+ 'problems' => 1, 'section' => 1, 'recit' => 1,
+ 'login' => 1 );
my $showBestOnly = 0;
my @index_list = (); # list of all student index
@@ -307,6 +308,7 @@
# the returning parameter lets us set defaults for versioned sets
my $ret = $r->param('returning');
$showColumns{'date'} = $ret ? $r->param('show_date') : 1;
+ $showColumns{'testtime'} = $ret ? $r->param('show_testtime') : 0;
$showColumns{'index'} = $ret ? $r->param('show_index') : 0;
$showColumns{'problems'} = $ret ? $r->param('show_problems') : 0;
$showColumns{'section'} = $ret? $r->param('show_section') : 0;
@@ -455,16 +457,30 @@
}
- # for versioned tests we might be displaying the test date
+ # for versioned tests we might be displaying the test date and test time
my $dateOfTest = '';
+ my $testTime = '';
# annoyingly, this is a set property, so get the set
- if ( $setIsVersioned && $showColumns{'date'} ) {
+ if ( $setIsVersioned &&
+ ( $showColumns{'date'} || $showColumns{'testtime'} ) ) {
my @userSet =
$db->getMergedVersionedSets( [ $studentRecord->user_id, $setName, $sN ] );
if ( defined( $userSet[0] ) ) { # if this isn't defined, something's wrong
- $dateOfTest = localtime( $userSet[0]->version_creation_time() );
+ $dateOfTest =
+ localtime( $userSet[0]->version_creation_time() );
+ my $gradeTime = '';
+ if ( defined( $userSet[0]->version_last_attempt_time() ) &&
+ $userSet[0]->version_last_attempt_time() ) {
+ $testTime = ( $userSet[0]->version_last_attempt_time() -
+ $userSet[0]->version_creation_time() ) /
+ 60;
+ $testTime = sprintf("%3.1f min", $testTime);
+ } else {
+ $testTime = 'time limit exceeded';
+ }
} else {
$dateOfTest = '???';
+ $testTime = '???';
}
}
@@ -500,6 +516,7 @@
email_address => $studentRecord->email_address,
problemData => {%h_problemData},
date => $dateOfTest,
+ testtime => $testTime,
};
# keep track of best score
@@ -579,6 +596,9 @@
CGI::checkbox(-name=>'show_date', -value=>'1',
-checked=>$showColumns{'date'},
-label=>' test date; '),
+ CGI::checkbox(-name=>'show_testtime', -value=>'1',
+ -checked=>$showColumns{'testtime'},
+ -label=>' test time; '),
CGI::checkbox(-name=>'show_problems', -value=>'1',
-checked=>$showColumns{'problems'},
-label=>'problems;'), "\n", CGI::br(), "\n",
@@ -607,6 +627,7 @@
'show_best_only' => $showBestOnly,
'show_index' => $showColumns{'index'},
'show_date' => $showColumns{'date'},
+ 'show_testtime' => $showColumns{'testtime'},
'show_problems' => $showColumns{'problems'},
'show_section' => $showColumns{'section'},
'show_recitation' => $showColumns{'recit'},
@@ -616,6 +637,7 @@
push(@columnHdrs, (! defined($sort_method_name) || $sort_method_name ne 'score') ? CGI::a({"href"=>$self->systemLink($setStatsPage,params=>{'sort'=>'score', %paramList})},'Score') : 'Score') if ( $showColumns{'score'} );
push(@columnHdrs, 'Out'.CGI::br().'Of') if ( $showColumns{'outof'} );
push(@columnHdrs, 'Date') if ( $showColumns{'date'} );
+ push(@columnHdrs, 'TestTime') if ( $showColumns{'testtime'} );
push(@columnHdrs, (! defined($sort_method_name) || $sort_method_name ne 'index') ? CGI::a({"href"=>$self->systemLink($setStatsPage,params=>{'sort'=>'index', %paramList})},'Ind') : 'Ind') if ( $showColumns{'index'} );
push(@columnHdrs, 'Problems'.CGI::br().$problem_header) if ( $showColumns{'problems'} );
push(@columnHdrs, (! defined($sort_method_name) || $sort_method_name ne 'section') ? CGI::a({"href"=>$self->systemLink($setStatsPage,params=>{'sort'=>'section', %paramList})},'Section') : 'Section') if ( $showColumns{'section'} );
@@ -671,6 +693,7 @@
push(@cols, sprintf("%0.2f",$rec->{score})) if ($showColumns{'score'});
push(@cols, $rec->{total}) if ( $showColumns{'outof'} );
push(@cols, $self->nbsp($rec->{date})) if ($showColumns{'date'});
+ push(@cols, $self->nbsp($rec->{testtime})) if ($showColumns{'testtime'});
push(@cols, sprintf("%0.0f",100*($rec->{index}))) if ($showColumns{'index'});
push(@cols, $rec->{problemString}) if ($showColumns{'problems'});
push(@cols, $self->nbsp($rec->{section})) if ($showColumns{'section'});
Index: ProblemSetList.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm,v
retrieving revision 1.60.2.4
retrieving revision 1.60.2.5
diff -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm -Llib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm -u -r1.60.2.4 -r1.60.2.5
--- lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/ProblemSetList.pm
@@ -1437,8 +1437,10 @@
$problemRandOrder =~ s/(.*?)\s*/$1/;
# convert times into seconds
- $timeInterval = WeBWorK::Utils::timeToSec( $timeInterval );
- $versionTimeLimit = WeBWorK::Utils::timeToSec( $versionTimeLimit );
+ $timeInterval = WeBWorK::Utils::timeToSec( $timeInterval )
+ if ( $timeInterval );
+ $versionTimeLimit = WeBWorK::Utils::timeToSec( $versionTimeLimit )
+ if ( $versionTimeLimit );
#####################################################################
# Read and check list of problems for the set
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-09 11:18:12
|
Log Message:
-----------
Fixed Disable() and Enable() so that they can be called as
Context()->functions->disable()
and
Context()->functions->enable()
as well as
Parser::Context::Functions::Disable()
and
Parser::Context::Functions::Enable()
The former is the preferred syntax.
Modified Files:
--------------
pg/lib/Parser/Context:
Functions.pm
Revision Data
-------------
Index: Functions.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Functions.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/Parser/Context/Functions.pm -Llib/Parser/Context/Functions.pm -u -r1.4 -r1.5
--- lib/Parser/Context/Functions.pm
+++ lib/Parser/Context/Functions.pm
@@ -53,7 +53,9 @@
All => [qw(_alias_ Trig Numeric Vector Complex)],
);
+sub disable {Disable(@_)}
sub Disable {
+ shift if ref($_[0]) ne ""; # pop off the $self reference
my @names = @_; my ($list,$name);
my $context = Parser::Context->current;
while ($name = shift(@names)) {
@@ -66,7 +68,9 @@
}
}
+sub enable {Enable(@_)}
sub Enable {
+ shift if ref($_[0]) ne ""; # pop off the $self reference
my @names = @_; my ($list,$name);
my $context = Parser::Context->current;
while ($name = shift(@names)) {
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-06 02:34:17
|
Log Message:
-----------
Forgot to check hardcopy mode. Fixed some problems with that. The
answer array items have to turn off verbatim mode that is used when
answer are included in the hardcopy. This causes paragraph breaks
between entries in a singleResult MultiPart that includes ans_arrays,
which make the output less pretty, but at least they show up.
Modified Files:
--------------
pg/lib/Value:
AnswerChecker.pm
Revision Data
-------------
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.45
retrieving revision 1.46
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.45 -r1.46
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -295,14 +295,17 @@
sub format_matrix_tex {
my $self = shift; my $array = shift;
- my %options = {open=>'',close=>'',sep=>'',@_};
+ my %options = (open=>'.',close=>'.',sep=>'',@_);
$self->{format_options} = [%options] unless $self->{format_options};
my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
my $tex = "";
- $tex .= '\left'.$open.'\begin{array}{'.('c'x$cols).'}';
- foreach my $i (0..$rows-1) {$tex .= join('&',@{$array->[$i]}).'\\'."\n"}
- $tex .= '\end{array}\right'.$close;
+ $open = '\\'.$open if $open =~ m/[{}]/; $close = '\\'.$close if $close =~ m/[{}]/;
+ $tex .= '\(\left'.$open;
+ $tex .= '\setlength{\arraycolsep}{2pt}', $sep = '\,'.$sep if $sep;
+ $tex .= '\begin{array}{'.('c'x$cols).'}';
+ foreach my $i (0..$rows-1) {$tex .= join($sep.'&',@{$array->[$i]}).'\cr'."\n"}
+ $tex .= '\end{array}\right'.$close.'\)';
return $tex;
}
@@ -338,6 +341,13 @@
. '</TABLE>';
}
+sub VERBATIM {
+ my $string = shift;
+ my $displayMode = Value->getPG('$displayMode');
+ $string = '\end{verbatim}'.$string.'\begin{verbatim}' if $displayMode eq 'TeX';
+ return $string;
+}
+
#
# Create a tall delimiter to match the line height
#
@@ -589,7 +599,7 @@
sub correct_ans {
my $self = shift;
return $self->SUPER::correct_ans unless $self->{ans_name};
- return $self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1);
+ Value::VERBATIM($self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1));
}
sub ANS_MATRIX {
@@ -656,10 +666,10 @@
sub correct_ans {
my $self = shift;
return $self->SUPER::correct_ans unless $self->{ans_name};
- return $self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1)
+ return Value::VERBATIM($self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1))
unless $self->{ColumnVector};
my @array = (); foreach my $x ($self->value) {push(@array,[$x])}
- return $self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1);
+ return Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
}
sub ANS_MATRIX {
@@ -722,7 +732,7 @@
my $self = shift;
return $self->SUPER::correct_ans unless $self->{ans_name};
my @array = $self->value; @array = ([@array]) if $self->isRow;
- return $self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1);
+ Value::VERBATIM($self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1));
}
sub ANS_MATRIX {
@@ -1199,7 +1209,7 @@
if ($self->{tree}{ColumnVector}) {foreach my $x (@array) {$x = [$x]}}
else {@array = [@array]}
}
- return $self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1);
+ Value::VERBATIM($self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1));
}
#
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-06 00:48:03
|
Log Message:
-----------
Added styles to make Parser's ans_array methods show up properly in
the student answer and correct answer blocks.
The style for the td in the results table causes havoc for tables that
are nested in there. This solves is for Parser produced answer
arrays, but it is still messed up for the standard ans_array() and for
the output of tth (the formatted text option).
The way the style for this table is handled should probably be
changed. Perhaps if we could override for td's in tables nested in
the results area? I don't know enough about CSS to figure that out.
Modified Files:
--------------
webwork-modperl/htdocs/css:
ur.css
Revision Data
-------------
Index: ur.css
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/htdocs/css/ur.css,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lhtdocs/css/ur.css -Lhtdocs/css/ur.css -u -r1.1 -r1.2
--- htdocs/css/ur.css
+++ htdocs/css/ur.css
@@ -122,6 +122,14 @@
padding: 2px 5px 2px 5px;
background-color: #DDDDDD;
}
+/*
+ * override above settings in tables used to display ans_array results
+ */
+table.ArrayLayout td {
+ border-style: none;
+ border-width: 0px;
+ padding: 0px;
+}
table.attemptResults td.Message {
text-align: left;
padding: 2px 5px 2px 5px;
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-06 00:03:42
|
Log Message:
-----------
This file implements a Multi-Part parser object that allows you to tie
several input blanks to a single answer checker that can compare the
student's answers in several blanks in order to determine which are
correct.
For example:
$mp = MultiPart("x^2",1,-1)->with(
singleResult => 1,
checker => sub {
my ($correct,$student,$self) = @_; # get the parameters
my ($f,$x1,$x2) = @{$student}; # extract the student answers
Value::Error("Function can't be the identity") if ($f == 'x');
Value::Error("Function can't be constant") if ($f->isConstant);
return $f->eval(x=>$x1) == $f->eval(x=>$x2);
},
);
.
BEGIN_TEXT
\(f(x)\) = \{$mp->ans_rule(20)\} produces the same value
at \(x\) = \{$mp->ans_rule(10)\} as it does at \(x\) = \{$mp->ans_rule(10)\}.
END_TEXT
ANS($mp->cmp);
This produces three answer blanks all tied to the same checker, which
is supplied by the user when the MultiPart is specified. This one
checks if two inputs to a function provide the same output.
The answer blanks can each produce a separate row in the results area
at the top of the page, or they con be combined into a single row, as
in this case. The checker routine can provide error messages for
individual parts via the setMessage() method, or for the problem as a
whole, as above. Finally, the ans_array() method can be used to
produce answer blanks for individual entries for those objects that
support such arrays.
See the documentation at the top of the file for additional details.
Added Files:
-----------
pg/macros:
parserMultiPart.pl
Revision Data
-------------
--- /dev/null
+++ macros/parserMultiPart.pl
@@ -0,0 +1,386 @@
+sub _parserMultiPart_init {}
+
+#
+# MultiPart objects let you tie several answer blanks to a single
+# answer checker, so you can have the answer in one blank influence
+# the answer in another. The MultiPart can produce either a single
+# result in the answer results area, or a separate result for each
+# blank.
+#
+# To create a MultiPart pass a list of answers to MultiPart() in the
+# order they will appear in the problem. For example:
+#
+# $mp = MultiPart("x^2",-1,1);
+#
+# or
+#
+# $mp = MultiPart(Vector(1,1,1),Vector(2,2,2))->with(singleResult=>1);
+#
+# Then, use $mp->ans_rule to create answer blanks for the various parts
+# just as you would ans_rule. You can pass the width of the blank, which
+# defaults to 20 otherwise. For example:
+#
+# BEGIN_TEXT
+# \(f(x)\) = \{$mp->ans_rule(20)\} produces the same value
+# at \(x\) = \{$mp->ans_rule(10)\} as it does at \(x\) = \{$mp->ans_rule(10)\}.
+# END_TEXT
+#
+# Finally, call $mp->cmp to produce the answer checker(s) used in the MultiPart.
+# You need to provide a checker routine that will be called to determine if the
+# answers are correct or not. The checker will only be called if the student
+# answers have no syntax errors and their types match the types of the professor's
+# answers, so you don't ahve to worry about handling bad data from the student
+# (at least as far as typechecking goes).
+#
+# The checker routine should accept three parameters: a reference to the array
+# of correct answers, a reference to the array of student answers, and a reference
+# to the MultiPart itself. It should do whatever checking it needs to do and
+# then return a score for the MultiPart as a whole (every answer blank will be
+# given the same score), or a reference to an array of scores, one for each
+# blank. The routine can set error messages via the MultiPart's setMessage()
+# method (e.g., $mp->setMessage(1,"The function can't be the identity") would
+# set the message for the first answer blank of the MultiPart), or can call
+# Value::Error() to generate an error and die.
+#
+# The checker routine can be supplied either when the MultiPart is created, or
+# when the cmp() method is called. For example:
+#
+# $mp = MultiPart("x^2",1,-1)->with(
+# singleResult => 1,
+# checker => sub {
+# my ($correct,$student,$self) = @_; # get the parameters
+# my ($f,$x1,$x2) = @{$student}; # extract the student answers
+# Value::Error("Function can't be the identity") if ($f == 'x');
+# Value::Error("Function can't be constant") if ($f->isConstant);
+# return $f->eval(x=>$x1) == $f->eval(x=>$x2);
+# },
+# );
+# .
+# .
+# .
+# ANS($mp->cmp);
+#
+# or
+#
+# $mp = MultiPart("x^2",1,-1)->with(singleResult=>1);
+# sub check {
+# my ($correct,$student,$self) = @_; # get the parameters
+# my ($f,$x1,$x2) = @{$student}; # extract the student answers
+# Value::Error("Function can't be the identity") if ($f == 'x');
+# Value::Error("Function can't be constant") if ($f->isConstant);
+# return $f->eval(x=>$x1) == $f->eval(x=>$x2);
+# };
+# .
+# .
+# .
+# ANS($mp->cmp(checker=>~~&check));
+#
+######################################################################
+
+package MultiPart;
+our @ISA = qw(Value);
+
+our $count = 0; # counter for unique identifier for multi-parts
+our $answerPrefix = "MuLtIpArT"; # answer rule prefix
+our $separator = ';'; # separator for singleResult previews
+
+#
+# Create a new MultiPart item from a list of items.
+# The items are converted if Value items, if they aren't already.
+# You can set the following fields of the resulting item:
+#
+# checker => code a subroutine to be called to check the
+# student answers. The routine is passed
+# three parameters: a reference to the array
+# or correct answers, a reference to the
+# array of student answers, and a reference
+# to the MultiPart object itself. The routine
+# should return either a score or an array of
+# scores (one for each student answer).
+#
+# singleResult => 0 or 1 whether to show only one entry in the
+# results area at the top of the page,
+# or one for each answer rule.
+# (Default: 0)
+#
+# namedRules => 0 or 1 wether to use named rules or default
+# rule names. Use named rules if you need
+# to intersperse other rules with the
+# ones for the MultiPart, in which case
+# you must use NAMED_ANS not ANS.
+# (Default: 0)
+#
+# checkTypes => 0 or 1 whether the types of the student and
+# professor's answers must match exactly
+# or just pass the usual type-match error
+# checking (in which case, you should check
+# the types before you use the data).
+# (Default: 1)
+#
+# separator => string the string to use between entries in the
+# results area when singleResult is set.
+#
+# tex_separator => string same, but for the preview area.
+#
+my @ans_defaults = (
+ checker => sub {0},
+ showCoordinateHints => 0,
+ showEndpointHints => 0,
+ showEndTypeHints => 0,
+);
+
+sub new {
+ my $self = shift; my $class = ref($self) || $self;
+ my @data = @_; my @cmp;
+ Value::Error($class." lists can't be empty") if scalar(@data) == 0;
+ foreach my $x (@data) {
+ $x = Value::makeValue($x) unless Value::isValue($x);
+ push(@cmp,$x->cmp(@ans_defaults));
+ }
+ bless {
+ data => [@data], cmp => [@cmp], ans => [],
+ part => 0, singleResult => 0, namedRules => 0, checkTypes => 1,
+ tex_separator => $separator.'\,', separator => $separator.' ',
+ context => $$Value::context, id => $answerPrefix.($count++),
+ }, $class;
+}
+
+#
+# Creates an answer checker (or array of same) to be passed
+# to ANS() or NAMED_ANS(). Any parameters are passed to
+# the individual answer checkers.
+#
+sub cmp {
+ my $self = shift; my %options = @_;
+ foreach my $id ('checker','separator') {
+ if (defined($options{$id})) {
+ $self->{$id} = $options{$id};
+ delete $options{$id};
+ }
+ }
+ die "You must supply a checker subroutine" unless ref($self->{checker}) eq 'CODE';
+ my @cmp = ();
+ if ($self->{singleResult}) {
+ push(@cmp,$self->ANS_NAME(0)) if $self->{namedRules};
+ push(@cmp,$self->single_cmp(%options));
+ } else {
+ foreach my $i (0..$self->length-1) {
+ push(@cmp,$self->ANS_NAME($i)) if $self->{namedRules};
+ push(@cmp,$self->entry_cmp($i,%options));
+ }
+ }
+ return @cmp;
+}
+
+######################################################################
+
+#
+# Get the answer checker used for when all the answers are treated
+# as a single result.
+#
+sub single_cmp {
+ my $self = shift; my @correct;
+ foreach my $cmp (@{$self->{cmp}}) {push(@correct,$cmp->{rh_ans}{correct_ans})}
+ my $ans = new AnswerEvaluator;
+ $ans->ans_hash(
+ correct_ans => join($self->{separator},@correct),
+ type => "MultiPart",
+ @_,
+ );
+ $ans->install_evaluator(sub {my $ans = shift; (shift)->single_check($ans)},$self);
+ $ans->install_pre_filter('erase'); # don't do blank check
+ return $ans;
+}
+
+#
+# Check the answers when they are treated as a single result.
+#
+# First, call individual answer checkers to get any type-check errors
+# Then perform the user's checker routine
+# Finally collect the individual answers and errors and combine
+# them for the single result.
+#
+sub single_check {
+ my $self = shift; my $ans = shift;
+ my $inputs = $main::inputs_ref;
+ $self->{ans}[0] = $self->{cmp}[0]->evaluate($ans->{student_ans});
+ foreach my $i (1..$self->length-1)
+ {$self->{ans}[$i] = $self->{cmp}[$i]->evaluate($inputs->{$self->ANS_NAME($i)})}
+ my $score = 0; my (@errors,@student,@latex,@text);
+ my $i = 0; my $nonblank = 0;
+ if ($self->perform_check) {
+ push(@errors,$self->{ans}[0]{ans_message});
+ $self->{ans}[0]{ans_message} = "";
+ }
+ foreach my $result (@{$self->{ans}}) {
+ $i++; $nonblank |= ($result->{student_ans} =~ m/\S/);
+ push(@latex,check_string($result->{preview_latex_string},'\_\_'));
+ push(@text,check_string($result->{preview_text_string},'__'));
+ push(@student,check_string($result->{student_ans},'__'));
+ if ($result->{ans_message}) {
+ push(@errors,"Answer $i: ".$result->{ans_message});
+ } else {$score += $result->{score}}
+ }
+ $ans->score($score/$self->length);
+ $ans->{ans_message} = $ans->{error_message} = join("<BR>",@errors);
+ if ($nonblank) {
+ $ans->{preview_latex_string} = '{'.join('}'.$self->{tex_separator}.'{',@latex).'}';
+ $ans->{preview_text_string} = join($self->{separator},@text);
+ $ans->{student_ans} = join($self->{separator},@student);
+ }
+ return $ans;
+}
+
+#
+# Return a given string or a default if it is empty or not defined
+#
+sub check_string {
+ my $s = shift;
+ $s = shift unless defined($s) && $s =~ m/\S/;
+ return $s;
+}
+
+######################################################################
+
+#
+# Answer checker to use for individual entries when singleResult
+# is not in effect.
+#
+sub entry_cmp {
+ my $self = shift; my $i = shift;
+ my $ans = new AnswerEvaluator;
+ $ans->ans_hash(
+ correct_ans => $self->{cmp}[$i]{rh_ans}{correct_ans},
+ part => $i,
+ type => "MultiPart($i)",
+ @_,
+ );
+ $ans->install_evaluator(sub {my $ans = shift; (shift)->entry_check($ans)},$self);
+ $ans->install_pre_filter('erase'); # don't do blank check
+ return $ans;
+}
+
+#
+# Call the correct answser's checker to check for syntax and type errors.
+# If this is the last one, perform the user's checker routine as well
+# Return the individual answer (our answer hash is discarded).
+#
+sub entry_check {
+ my $self = shift; my $ans = shift;
+ my $i = $ans->{part};
+ $self->{ans}[$i] = $self->{cmp}[$i]->evaluate($ans->{student_ans});
+ $self->{ans}[$i]->score(0);
+ $self->perform_check if ($i == $self->length - 1);
+ return $self->{ans}[$i];
+}
+
+######################################################################
+
+#
+# Collect together the correct and student answers, and call the
+# user's checker routine.
+#
+# If any of the answers produced errors or the types don't match
+# don't call the user's routine.
+# Otherwise, call it, and if there was an error, report that.
+# Set the individual scores based on the result from the user's routine.
+#
+sub perform_check {
+ my $self = shift; $self->{context}->clearError;
+ my @correct; my @student;
+ foreach my $ans (@{$self->{ans}}) {
+ push(@correct,$ans->{correct_value});
+ push(@student,$ans->{student_value});
+ return if $ans->{ans_message} ne "" || !defined($ans->{student_value});
+ return if $self->{checkTypes} && $ans->{student_value}->type ne $ans->{correct_value}->type;
+ }
+ my $result = Value::cmp_compare([@correct],[@student],$self);
+ if (!defined($result) && $self->{context}{error}{flag}) {$self->cmp_error($self->{ans}[0]); return 1}
+ $result = 0 if (!defined($result) || $result eq '');
+ if (ref($result) eq 'ARRAY') {
+ die "Checker subroutine returned the wrong number of results"
+ if (scalar(@{$result}) != $self->length);
+ foreach my $i (0..$self->length-1) {$self->{ans}[$i]->score($result->[$i])}
+ } elsif (Value::matchNumber($result)) {
+ foreach my $ans (@{$self->{ans}}) {$ans->score($result)}
+ } else {
+ die "Checker subroutine should return a number or array of numbers ($result)";
+ }
+ return;
+}
+
+######################################################################
+
+#
+# The user's checker can call setMessage(n,message) to set the error message
+# for the n-th answer blank.
+#
+sub setMessage {
+ my $self = shift; my $i = (shift)-1; my $message = shift;
+ $self->{ans}[$i]->{ans_message} = $self->{ans}[$i]->{error_message} = $message;
+}
+
+
+######################################################################
+
+#
+# Produce the name for a named answer blank
+#
+sub ANS_NAME {
+ my $self = shift; my $i = shift;
+ $self->{id}.'_'.$i;
+}
+
+#
+# Record an answer-blank name (when using extensions)
+#
+sub NEW_NAME {
+ my $self = shift;
+ main::RECORD_FORM_LABEL(shift);
+}
+
+#
+# Produce an answer rule for the next item in the list,
+# taking care to use names or extensions as needed
+# by the settings of the MultiPart.
+#
+sub ans_rule {
+ my $self = shift; my $size = shift || 20;
+ my $data = $self->{data}[$self->{part}];
+ my $name = $self->ANS_NAME($self->{part}++);
+ return $data->named_ans_rule_extension($self->NEW_NAME($name),$size,@_)
+ if ($self->{singleResult} && $self->{part} > 1);
+ return $data->ans_rule($size,@_) unless $self->{namedRules};
+ return $data->named_ans_rule($name,$size,@_);
+}
+
+#
+# Do the same, but for answer arrays, which are generated by the
+# Value objects automatically sized to suit their data.
+# Reset the correct_ans once the array is made
+#
+sub ans_array {
+ my $self = shift; my $size = shift || 5; my $HTML;
+ my $data = $self->{data}[$self->{part}];
+ my $name = $self->ANS_NAME($self->{part}++);
+ if ($self->{singleResult} && $self->{part} > 1) {
+ $HTML = $data->named_ans_array_extension($self->NEW_NAME($name),$size,@_);
+ } elsif (!$self->{namedRules}) {
+ $HTML = $data->ans_array($size,@_);
+ } else {
+ $HTML = $data->named_ans_array($name,$size,@_);
+ }
+ $self->{cmp}[$self->{part}-1] = $data->cmp(@ans_defaults);
+ return $HTML;
+}
+
+######################################################################
+
+package main;
+
+#
+# Main routine to create MultiPart items.
+#
+sub MultiPart {MultiPart->new(@_)};
+
+1;
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-05 23:54:08
|
Log Message:
-----------
Added ability to have Matrix, Vector and Point objects produce input
arrays similar to the ones available in PGmatrixmacros.pg. This
provides some substantial new functionality, and it may still have
some shaking down to do, but it should not affect the existing
functionality of the answer checkers.
To create an answer array for a matrix, vector or point, use the new
ans_array() or named_ans_array() methods of these objects. For
example:
Context("Matrix");
$M = Matrix([1,2],[3,4]);
BEGIN_TEXT
\{$M->TeX\} = \{$M->ans_array\}
END_TEXT
ANS($M->cmp);
This creates a matrix, then prints it ans creates an answer array of
the appropriate size for the matrix. The answer checker will
automatically know to handle the multiple entry blanks.
To used a named answer rule, use:
Context("Matrix");
$M = Matrix([1,2],[3,4]);
BEGIN_TEXT
\{$M->TeX\} = \{$M->named_ans_array('fred')\}
END_TEXT
NAMED_ANS(fred => $M->cmp);
Both methods also take an optional argument that specifies the width
of the answer rules. The default is 5.
You can get a multi-input point or vector array as well, and you can
make column vectors as follows:
Context("Vector");
$V = ColumnVector("1+x","3x","1-x");
BEGIN_TEXT
\{$V->TeX\} = \{$V->ans_array\}
END_TEXT
ANS($V->cmp);
Note that you can make answer arrays for matrices and vectors of
formulas as well as constants, provided the formula is an explicit
matrix or vector of formulas, and is not obtained by matrix
arithmatic.
For concistencey, all objets now have ans_rule and named_ans_rule
methods as well. The default width is 20 for these.
Modified Files:
--------------
pg/lib/Value:
AnswerChecker.pm
Revision Data
-------------
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.44
retrieving revision 1.45
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.44 -r1.45
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -26,20 +26,23 @@
sub cmp {
my $self = shift;
my $ans = new AnswerEvaluator;
- my $correct = $self->{correct_ans};
- $correct = $self->string unless defined($correct);
+ my $correct = protectHTML($self->{correct_ans});
+ $correct = $self->correct_ans unless defined($correct);
$ans->ans_hash(
type => "Value (".$self->class.")",
- correct_ans => protectHTML($correct),
+ correct_ans => $correct,
correct_value => $self,
$self->cmp_defaults(@_),
@_
);
$ans->install_evaluator(sub {$ans = shift; $ans->{correct_value}->cmp_parse($ans)});
+ $ans->install_pre_filter('erase') if $self->{ans_name}; # don't do blank check if answer_array
$self->{context} = $$Value::context unless defined($self->{context});
return $ans;
}
+sub correct_ans {protectHTML(shift->string)}
+
#
# Parse the student answer and compute its value,
# produce the preview strings, and then compare the
@@ -83,10 +86,13 @@
$ans->{preview_latex_string} = $ans->{student_formula}->TeX;
$ans->{preview_text_string} = protectHTML($ans->{student_formula}->string);
$ans->{student_ans} = $ans->{preview_text_string};
- $self->cmp_equal($ans);
- $self->cmp_postprocess($ans) if !$ans->{error_message};
+ if ($self->cmp_collect($ans)) {
+ $self->cmp_equal($ans);
+ $self->cmp_postprocess($ans) if !$ans->{error_message};
+ }
} else {
$self->cmp_error($ans);
+ $self->cmp_collect($ans);
}
contextSet($context,%{$flags}); # restore context values
Parser::Context->current(undef,$current); # put back the old context
@@ -94,6 +100,37 @@
}
#
+# Check if the object has an answer array and collect the results
+# Build the combined student answer and set the preview values
+#
+sub cmp_collect {
+ my $self = shift; my $ans = shift;
+ return 1 unless $self->{ans_name};
+ $ans->{preview_latex_string} = $ans->{preview_text_string} = "";
+ my $OK = $self->ans_collect($ans);
+ $ans->{student_ans} = $self->format_matrix($ans->{student_formula},@{$self->{format_options}},tth_delims=>1);
+ return 0 unless $OK;
+ my $array = $ans->{student_formula};
+ if ($self->{ColumnVector}) {
+ my @V = (); foreach my $x (@{$array}) {push(@V,$x->[0])}
+ $array = [@V];
+ } elsif (scalar(@{$array}) == 1) {$array = $array->[0]}
+ my $type = $self;
+ $type = "Value::".$self->{tree}->type if $self->class eq 'Formula';
+ $ans->{student_formula} = eval {$type->new($array)->with(ColumnVector=>$self->{ColumnVector})};
+ if (!defined($ans->{student_formula}) || $$Value::context->{error}{flag})
+ {Parser::reportEvalError($@); return 0}
+ $ans->{student_value} = $ans->{student_formula};
+ $ans->{preview_text_string} = $ans->{student_ans};
+ $ans->{preview_latex_string} = $ans->{student_formula}->TeX;
+ if (Value::isFormula($ans->{student_formula}) && $ans->{student_formula}->isConstant) {
+ $ans->{student_value} = Parser::Evaluate($ans->{student_formula});
+ return 0 unless $ans->{student_value};
+ }
+ return 1;
+}
+
+#
# Check if the parsed student answer equals the professor's answer
#
sub cmp_equal {
@@ -107,8 +144,8 @@
} else {
return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
$ans->{ans_message} = $ans->{error_message} =
- "Your answer isn't ".lc($ans->{cmp_class}).
- " (it looks like ".lc($student->showClass).")"
+ "Your answer isn't ".lc($ans->{cmp_class}).'<BR>'.
+ "(it looks like ".lc($student->showClass).")"
if !$ans->{isPreview} && $ans->{showTypeWarnings} && !$ans->{error_message};
}
}
@@ -193,6 +230,229 @@
sub cmp_postprocess {}
#
+# create answer rules of various types
+#
+sub ans_rule {shift; pgCall('ans_rule',@_)}
+sub named_ans_rule {shift; pgCall('NAMED_ANS_RULE',@_)}
+sub named_ans_rule_extension {shift; pgCall('NAMED_ANS_RULE_EXTENSION',@_)}
+sub ans_array {shift->ans_rule(@_)};
+sub named_ans_array {shift->named_ans_rule(@_)};
+sub named_ans_array_extension {shift->named_ans_rule_extension(@_)};
+
+sub pgCall {my $call = shift; &{WeBWorK::PG::Translator::PG_restricted_eval('\&'.$call)}(@_)}
+sub pgRef {WeBWorK::PG::Translator::PG_restricted_eval('\&'.shift)}
+
+our $answerPrefix = "MaTrIx";
+
+#
+# Lay out a matrix of answer rules
+#
+sub ans_matrix {
+ my $self = shift;
+ my ($extend,$name,$rows,$cols,$size,$open,$close,$sep) = @_;
+ my $named_extension = pgRef('NAMED_ANS_RULE_EXTENSION');
+ my $new_name = pgRef('RECORD_FORM_LABEL');
+ my $HTML = ""; my $ename = $name;
+ if ($name eq '') {
+ my $n = pgCall('inc_ans_rule_count');
+ $name = pgCall('NEW_ANS_NAME',$n);
+ $ename = $answerPrefix.$n;
+ }
+ $self->{ans_name} = $ename;
+ $self->{ans_rows} = $rows;
+ $self->{ans_cols} = $cols;
+ my @array = ();
+ foreach my $i (0..$rows-1) {
+ my @row = ();
+ foreach my $j (0..$cols-1) {
+ if ($i == 0 && $j == 0) {
+ if ($extend) {push(@row,&$named_extension(&$new_name($name),$size))}
+ else {push(@row,pgCall('NAMED_ANS_RULE',$name,$size))}
+ } else {
+ push(@row,&$named_extension(&$new_name(ANS_NAME($ename,$i,$j)),$size));
+ }
+ }
+ push(@array,[@row]);
+ }
+ $self->format_matrix([@array],open=>$open,close=>$close,sep=>$sep);
+}
+
+sub ANS_NAME {
+ my ($name,$i,$j) = @_;
+ $name.'_'.$i.'_'.$j;
+}
+
+
+#
+# Lay out an arbitrary matrix
+#
+sub format_matrix {
+ my $self = shift;
+ my $displayMode = $self->getPG('$displayMode');
+ return $self->format_matrix_tex(@_) if ($displayMode eq 'TeX');
+ return $self->format_matrix_HTML(@_);
+}
+
+sub format_matrix_tex {
+ my $self = shift; my $array = shift;
+ my %options = {open=>'',close=>'',sep=>'',@_};
+ $self->{format_options} = [%options] unless $self->{format_options};
+ my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
+ my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
+ my $tex = "";
+ $tex .= '\left'.$open.'\begin{array}{'.('c'x$cols).'}';
+ foreach my $i (0..$rows-1) {$tex .= join('&',@{$array->[$i]}).'\\'."\n"}
+ $tex .= '\end{array}\right'.$close;
+ return $tex;
+}
+
+sub format_matrix_HTML {
+ my $self = shift; my $array = shift;
+ my %options = (open=>'',close=>'',sep=>'',tth_delims=>0,@_);
+ $self->{format_options} = [%options] unless $self->{format_options};
+ my ($open,$close,$sep) = ($options{open},$options{close},$options{sep});
+ my ($rows,$cols) = (scalar(@{$array}),scalar(@{$array->[0]}));
+ my $HTML = "";
+ if ($sep) {$sep = '</TD><TD STYLE="padding: 0px 1px">'.$sep.'</TD><TD>'}
+ else {$sep = '</TD><TD WIDTH="8px"></TD><TD>'}
+ foreach my $i (0..$rows-1) {
+ $HTML .= '<TR><TD HEIGHT="6px"></TD></TR>' if $i;
+ $HTML .= '<TR ALIGN="MIDDLE"><TD>'.join($sep,@{$array->[$i]}).'</TD></TR>'."\n";
+ }
+ $open = $self->format_delimiter($open,$rows,$options{tth_delims});
+ $close = $self->format_delimiter($close,$rows,$options{tth_delims});
+ if ($open ne '' || $close ne '') {
+ $HTML = '<TR ALIGN="MIDDLE">'
+ . '<TD>'.$open.'</TD>'
+ . '<TD WIDTH="2"></TD>'
+ . '<TD><TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout">'
+ . $HTML
+ . '</TABLE></TD>'
+ . '<TD WIDTH="4"></TD>'
+ . '<TD>'.$close.'</TD>'
+ . '</TR>'."\n";
+ }
+ return '<TABLE BORDER="0" CELLSPACING="0" CELLPADDING="0" CLASS="ArrayLayout"'
+ . ' STYLE="display:inline;vertical-align:-'.(1.1*$rows-.6).'em">'
+ . $HTML
+ . '</TABLE>';
+}
+
+#
+# Create a tall delimiter to match the line height
+#
+sub format_delimiter {
+ my $self = shift; my $delim = shift; my $rows = shift; my $tth = shift;
+ return '' if $delim eq '' || $delim eq '.';
+ my $displayMode = $self->getPG('$displayMode');
+ return $self->format_delimiter_tth($delim,$rows,$tth)
+ if $tth || $displayMode eq 'HTML_tth' || $displayMode !~ m/^HTML_/;
+ my $rule = '\vrule width 0pt height '.(.8*$rows).'em depth 0pt';
+ $rule = '\rule 0pt '.(.8*$rows).'em 0pt' if $displayMode eq 'HTML_jsMath';
+ $delim = '\\'.$delim if $delim eq '{' || $delim eq '}';
+ return '\(\left'.$delim.$rule.'\right.\)';
+}
+
+#
+# Data for tth delimiters [top,mid,bot,rep]
+#
+my %tth_delim = (
+ '[' => ['','','',''],
+ ']' => ['','','',''],
+ '(' => ['','','',''],
+ ')' => ['','','',''],
+ '{' => ['','','',''],
+ '}' => ['','','',''],
+ '|' => ['|','','|','|'],
+ '<' => ['<'],
+ '>' => ['>'],
+ '\lgroup' => ['','','',''],
+ '\rgroup' => ['','','',''],
+);
+
+#
+# Make delimiters as stacks of characters
+#
+sub format_delimiter_tth {
+ my $self = shift;
+ my $delim = shift; my $rows = shift; my $tth = shift;
+ return '' if $delim eq '' || !defined($tth_delim{$delim});
+ my $c = $delim; $delim = $tth_delim{$delim};
+ $c = $delim->[0] if scalar(@{$delim}) == 1;
+ my $size = ($tth? "": "font-size:175%; ");
+ return '<SPAN STYLE="'.$size.'margin:0px 2px">'.$c.'</SPAN>'
+ if $rows == 1 || scalar(@{$delim}) == 1;
+ my $HTML = "";
+ if ($delim->[1] eq '') {
+ $HTML = join('<BR>',$delim->[0],($delim->[3])x(2*($rows-1)),$delim->[2]);
+ } else {
+ $HTML = join('<BR>',$delim->[0],($delim->[3])x($rows-1),
+ $delim->[1],($delim->[3])x($rows-1),
+ $delim->[2]);
+ }
+ return '<DIV STYLE="line-height:90%; margin: 0px 2px">'.$HTML.'</DIV>';
+}
+
+
+#
+# Look up the values of the answer array entries, and check them
+# for syntax and other errors. Build the student answer
+# based on these, and keep track of error messages.
+#
+
+my @ans_defaults = (showCoodinateHints => 0, checker => sub {0});
+
+sub ans_collect {
+ my $self = shift; my $ans = shift;
+ my $inputs = $self->getPG('$inputs_ref');
+ my $blank = ($self->getPG('$displayMode') eq 'TeX') ? '\_\_' : '__';
+ my ($rows,$cols) = ($self->{ans_rows},$self->{ans_cols});
+ my @array = (); my $data = [$self->value]; my $errors = []; my $OK = 1;
+ if ($self->{ColumnVector}) {foreach my $x (@{$data}) {$x = [$x]}}
+ $data = [$data] unless ref($data->[0]) eq 'ARRAY';
+ foreach my $i (0..$rows-1) {
+ my @row = ();
+ foreach my $j (0..$cols-1) {
+ if ($i || $j) {
+ my $entry = $inputs->{ANS_NAME($self->{ans_name},$i,$j)};
+ my $result = $data->[$i][$j]->cmp(@ans_cmp_defaults)->evaluate($entry);
+ $OK &= entryCheck($result,$blank);
+ push(@row,$result->{student_formula});
+ entryMessage($result->{ans_message},$errors,$i,$j,$rows);
+ } else {
+ $ans->{student_formula} = $ans->{student_value} = undef unless $ans->{student_ans} =~ m/\S/;
+ $OK &= entryCheck($ans,$blank);
+ push(@row,$ans->{student_formula});
+ entryMessage($ans->{ans_message},$errors,$i,$j,$rows);
+ }
+ }
+ push(@array,[@row]);
+ }
+ $ans->{student_formula} = [@array];
+ $ans->{ans_message} = $ans->{error_message} = join("<BR>",@{$errors});
+ return $OK && scalar(@{$errors}) == 0;
+}
+
+sub entryMessage {
+ my $message = shift; return unless $message;
+ my ($errors,$i,$j,$rows) = @_; $i++; $j++;
+ if ($rows == 1) {$message = "Coordinate $j: $message"}
+ else {$message = "Entry ($i,$j): $message"}
+ push(@{$errors},$message);
+}
+
+sub entryCheck {
+ my $ans = shift; my $blank = shift;
+ return 1 if defined($ans->{student_value});
+ if (!defined($ans->{student_formula})) {
+ $ans->{student_formula} = $ans->{student_ans};
+ $ans->{student_formula} = $blank unless $ans->{student_formula};
+ }
+ return 0
+}
+
+
+#
# Get and Set values in context
#
sub contextSet {
@@ -314,7 +574,7 @@
my $student = $ans->{student_value};
return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
if ($ans->{showDimensionHints} && $self->length != $student->length) {
- $self->cmp_Error($ans,"The dimension of your result is incorrect"); return;
+ $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
}
if ($ans->{showCoordinateHints}) {
my @errors;
@@ -326,6 +586,25 @@
}
}
+sub correct_ans {
+ my $self = shift;
+ return $self->SUPER::correct_ans unless $self->{ans_name};
+ return $self->format_matrix([[@{$self->{data}}]],@{$self->{format_options}},tth_delims=>1);
+}
+
+sub ANS_MATRIX {
+ my $self = shift;
+ my $extend = shift; my $name = shift;
+ my $size = shift || 5;
+ my $def = ($self->{context} || $$Value::context)->lists->get('Point');
+ my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
+ $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
+}
+
+sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
+sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
+sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
+
#############################################################
package Value::Vector;
@@ -358,7 +637,7 @@
return if $ans->{ignoreStrings} && (!Value::isValue($student) || $student->type eq 'String');
if (!$ans->{isPreview} && $ans->{showDimensionHints} &&
$self->length != $student->length) {
- $self->cmp_Error($ans,"The dimension of your result is incorrect"); return;
+ $self->cmp_Error($ans,"The number of coordinates is incorrect"); return;
}
if ($ans->{parallel} &&
$self->isParallel($student,$ans->{sameDirection})) {
@@ -374,6 +653,31 @@
}
}
+sub correct_ans {
+ my $self = shift;
+ return $self->SUPER::correct_ans unless $self->{ans_name};
+ return $self->format_matrix([[$self->value]],@{$self->{format_options}},tth_delims=>1)
+ unless $self->{ColumnVector};
+ my @array = (); foreach my $x ($self->value) {push(@array,[$x])}
+ return $self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1);
+}
+
+sub ANS_MATRIX {
+ my $self = shift;
+ my $extend = shift; my $name = shift;
+ my $size = shift || 5; my ($def,$open,$close);
+ $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
+ $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
+ return $self->ans_matrix($extend,$name,$self->length,1,$size,$open,$close)
+ if ($self->{ColumnVector});
+ $def = ($self->{context} || $$Value::context)->lists->get('Vector');
+ $open = $self->{open} || $def->{open}; $close = $self->{close} || $def->{close};
+ $self->ans_matrix($extend,$name,1,$self->length,$size,$open,$close,',');
+}
+
+sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
+sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
+sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
#############################################################
@@ -414,6 +718,30 @@
}
}
+sub correct_ans {
+ my $self = shift;
+ return $self->SUPER::correct_ans unless $self->{ans_name};
+ my @array = $self->value; @array = ([@array]) if $self->isRow;
+ return $self->format_matrix([$self->value],@{$self->{format_options}},tth_delims=>1);
+}
+
+sub ANS_MATRIX {
+ my $self = shift;
+ my $extend = shift; my $name = shift;
+ my $size = shift || 5;
+ my $def = ($self->{context} || $$Value::context)->lists->get('Matrix');
+ my $open = $self->{open} || $def->{open}; my $close = $self->{close} || $def->{close};
+ my @d = $self->dimensions;
+ Value::Error("Can't create ans_array for ".scalar(@d)."-dimensional matrix")
+ if (scalar(@d) > 2);
+ @d = (1,@d) if (scalar(@d) == 1);
+ $self->ans_matrix($extend,$name,@d,$size,$open,$close,'');
+}
+
+sub ans_array {my $self = shift; $self->ANS_MATRIX(0,'',@_)}
+sub named_ans_array {my $self = shift; $self->ANS_MATRIX(0,@_)}
+sub named_ans_array_extension {my $self = shift; $self->ANS_MATRIX(1,@_)}
+
#############################################################
package Value::Interval;
@@ -851,6 +1179,92 @@
$self->cmp_Error($ans,"The dimension of your result is incorrect");
}
+#
+# If an answer array was used, get the data from the
+# Matrix, Vector or Point, and format the array of
+# data using the original parameter
+#
+sub correct_ans {
+ my $self = shift;
+ return $self->SUPER::correct_ans unless $self->{ans_name};
+ my @array = ();
+ if ($self->{tree}->type eq 'Matrix') {
+ foreach my $row (@{$self->{tree}{coords}}) {
+ my @row = ();
+ foreach my $x (@{$row->coords}) {push(@row,$x->string)}
+ push(@array,[@row]);
+ }
+ } else {
+ foreach my $x (@{$self->{tree}{coords}}) {push(@array,$x->string)}
+ if ($self->{tree}{ColumnVector}) {foreach my $x (@array) {$x = [$x]}}
+ else {@array = [@array]}
+ }
+ return $self->format_matrix([@array],@{$self->{format_options}},tth_delims=>1);
+}
+
+#
+# Get the size of the array and create the appropriate answer array
+#
+sub ANS_MATRIX {
+ my $self = shift;
+ my $extend = shift; my $name = shift;
+ my $size = shift || 5; my $type = $self->type;
+ my $cols = $self->length; my $rows = 1; my $sep = ',';
+ if ($type eq 'Matrix') {
+ $sep = ''; $rows = $cols; $cols = $self->{tree}->typeRef->{entryType}{length};
+ }
+ if ($self->{tree}{ColumnVector}) {
+ $sep = ""; $type = "Matrix";
+ my $tmp = $rows; $rows = $cols; $cols = $tmp;
+ $self->{ColumnVector} = 1;
+ }
+ my $def = ($self->{context} || $$Value::context)->lists->get($type);
+ my $open = $self->{open} || $self->{tree}{open} || $def->{open};
+ my $close = $self->{close} || $self->{tree}{close} || $def->{close};
+ $self->ans_matrix($extend,$name,$rows,$cols,$size,$open,$close,$sep);
+}
+
+sub ans_array {
+ my $self = shift;
+ return $self->SUPER::ans_array(@_) unless $self->array_OK;
+ $self->ANS_MATRIX(0,'',@_);
+}
+sub named_ans_array {
+ my $self = shift;
+ return $self->SUPER::named_ans_array(@_) unless $self->array_OK;
+ $self->ANS_MATRIX(0,@_);
+}
+sub named_ans_array_extension {
+ my $self = shift;
+ return $self->SUPER::named_ans_array_extension(@_) unless $self->array_OK;
+ $self->ANS_MATRIX(1,@_);
+}
+
+sub array_OK {
+ my $self = shift; my $tree = $self->{tree};
+ return $tree->type =~ m/^(Point|Vector|Matrix)$/ && $tree->class eq 'List';
+}
+
+#
+# Get an array of values from a Matrix, Vector or Point
+#
+sub value {
+ my $self = shift;
+ my @array = ();
+ if ($self->{tree}->type eq 'Matrix') {
+ foreach my $row (@{$self->{tree}->coords}) {
+ my @row = ();
+ foreach my $x (@{$row->coords}) {push(@row,Value::Formula->new($x))}
+ push(@array,[@row]);
+ }
+ } else {
+ foreach my $x (@{$self->{tree}->coords}) {
+ push(@array,Value::Formula->new($x));
+ }
+ }
+ return @array;
+}
+
#############################################################
1;
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-05 23:38:26
|
Log Message:
-----------
Removed some unused lines and comments.
Removed unnecessary spaces from around answer-rule-extension rules,
and made the TeX version of this rule be based on the width, as is
the case for ans_rule.
Modified Files:
--------------
pg/macros:
PGbasicmacros.pl
Revision Data
-------------
Index: PGbasicmacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/PGbasicmacros.pl,v
retrieving revision 1.37
retrieving revision 1.38
diff -Lmacros/PGbasicmacros.pl -Lmacros/PGbasicmacros.pl -u -r1.37 -r1.38
--- macros/PGbasicmacros.pl
+++ macros/PGbasicmacros.pl
@@ -71,7 +71,6 @@
);
sub _PGbasicmacros_init {
-
# The big problem is that at compile time in the cached Safe compartment
# main:: has one definition, probably Safe::Root1::
# At runtime main has another definition Safe::Rootx:: where x is > 1
@@ -267,7 +266,6 @@
sub NAMED_ANS_RULE {
my($name,$col) = @_;
- my $len = 0.07*$col;
my $answer_value = '';
$answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
if ($answer_value =~ /\0/ ) {
@@ -289,9 +287,6 @@
$answer_value =~ tr/\\$@`//d; ## make sure student answers can not be interpolated by e.g. EV3
$name = RECORD_ANS_NAME($name);
- # incorporated Davide Cervone's changes
- # removed newlines from around <INPUT> tags
- # made TeX rule be based on specified width rather than varying size.
my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max
$tcol = $tcol < 40 ? $tcol : 40; ## get min
@@ -309,7 +304,6 @@
sub NAMED_ANS_RULE_EXTENSION {
my($name,$col) = @_;
- my $len = 0.07*$col;
my $answer_value = '';
$answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name});
if ( defined( $rh_sticky_answers->{$name} ) ) {
@@ -317,12 +311,13 @@
$answer_value = '' unless defined($answer_value);
}
$answer_value =~ tr/\\$@`//d; ## make sure student answers can not be interpolated by e.g. EV3
+ my $tcol = $col/2 > 3 ? $col/2 : 3; ## get max
+ $tcol = $tcol < 40 ? $tcol : 40; ## get min
MODES(
- TeX => '\\hrulefill\\quad ',
+ TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}",
Latex2HTML => qq!\\begin{rawhtml}\n<INPUT TYPE=TEXT SIZE=$col NAME=\"$name\" VALUE = \"\">\n\\end{rawhtml}\n!,
- HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME = "$name" VALUE = "$answer_value">\n
- <INPUT TYPE=HIDDEN NAME="previous_$name" VALUE = "$answer_value">
- !
+ HTML => qq!<INPUT TYPE=TEXT SIZE=$col NAME = "$name" VALUE = "$answer_value">!.
+ qq!<INPUT TYPE=HIDDEN NAME="previous_$name" VALUE = "$answer_value">!
);
}
@@ -338,7 +333,6 @@
$row = 10 unless defined($row);
$col = 80 unless defined($col);
$name = RECORD_ANS_NAME($name);
- my $len = 0.07*$col;
my $height = .07*$row;
my $answer_value = '';
$answer_value = $inputs_ref->{$name} if defined( $inputs_ref->{$name} );
@@ -1164,7 +1158,7 @@
sub BR { MODES( TeX => '\\par\\noindent ', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); };
# Alternate definition of BR which is slightly more flexible and gives more white space in printed output
# which looks better but kills more trees.
-#sub BR { MODES( TeX => '\\\\', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); };
+#sub BR { MODES( TeX => '\\leavevmode\\\\', Latex2HTML => '\\begin{rawhtml}<BR>\\end{rawhtml}', HTML => '<BR>'); };
sub LQ { MODES( TeX => "``", Latex2HTML => '"', HTML => '"' ); };
sub RQ { MODES( TeX => "''", Latex2HTML => '"', HTML => '"' ); };
sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML => ''); }; # begin math mode
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-05 23:27:21
|
Log Message:
-----------
Allow for vectors to be marked as Column Vectors.
Modified Files:
--------------
pg/lib/Parser:
List.pm
pg/macros:
Value.pl
Revision Data
-------------
Index: List.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/List.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -Llib/Parser/List.pm -Llib/Parser/List.pm -u -r1.11 -r1.12
--- lib/Parser/List.pm
+++ lib/Parser/List.pm
@@ -216,7 +216,8 @@
$open = '\left' .$open if $open ne '';
$close = '\right'.$close if $close ne '';
foreach my $x (@{$self->{coords}}) {push(@coords,$x->TeX)}
- return $open.join(',',@coords).$close;
+ return $open.join(',',@coords).$close unless $self->{ColumnVector};
+ '\left[\begin{array}{c}'.join('\cr'."\n",@coords).'\cr\end{array}\right]';
}
#
Index: Value.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/Value.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -Lmacros/Value.pl -Lmacros/Value.pl -u -r1.5 -r1.6
--- macros/Value.pl
+++ macros/Value.pl
@@ -16,6 +16,8 @@
sub Interval {Value::Interval->new(@_)}
sub Union {Value::Union->new(@_)}
+sub ColumnVector {Value::Vector->new(@_)->with(ColumnVector=>1,open=>undef,close=>undef)}
+
# sub Formula {Value::Formula->new(@_)}
#
# #
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-05 23:26:34
|
Log Message:
-----------
Better handling of delimiters that are explicitly set byt he user.
Fixed an incorrect call during object class promotion.
Added ability to sepcify that a vector is a Column Vector.
Modified Files:
--------------
pg/lib/Value:
Vector.pm
Revision Data
-------------
Index: Vector.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Vector.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Llib/Value/Vector.pm -Llib/Value/Vector.pm -u -r1.16 -r1.17
--- lib/Value/Vector.pm
+++ lib/Value/Vector.pm
@@ -52,8 +52,17 @@
unless Value::isNumber($x);
}
}
- return $self->formula($p) if $isFormula;
- bless {data => $p}, $class;
+ if ($isFormula) {
+ my $v = $self->formula($p);
+ if (ref($self) && $self->{ColumnVector}) {
+ $v->{tree}{ColumnVector} = 1;
+ $v->{tree}{open} = $v->{tree}{close} = undef;
+ }
+ return $v;
+ }
+ my $v = bless {data => $p}, $class;
+ $v->{ColumnVector} = 1 if ref($self) && $self->{ColumnVector};
+ return $v;
}
#
@@ -136,7 +145,7 @@
sub cross {
my ($l,$r,$flag) = @_;
- if ($l->promotePrecedence($r)) {return $r->dot($l,!$flag)}
+ if ($l->promotePrecedence($r)) {return $r->cross($l,!$flag)}
($l,$r) = (promote($l)->data,promote($r)->data);
Value::Error("Vector must be in 3-space for cross product")
unless scalar(@{$l}) == 3 && scalar(@{$r}) == 3;
@@ -239,8 +248,8 @@
sub stringify {
my $self = shift;
- return $self->TeX(undef,$self->{open},$self->{close}) if $$Value::context->flag('StringifyAsTeX');
- return $self->string(undef,$self->{open},$self->{close})
+ return $self->TeX if $$Value::context->flag('StringifyAsTeX');
+ return $self->string(undef,$self->{open},$self->{close});
};
sub string {
@@ -248,7 +257,7 @@
return $self->ijk($ijk_string)
if ($self->{ijk} || $equation->{ijk} || $$Value::context->flag("ijk"));
my $def = ($equation->{context} || $$Value::context)->lists->get('Vector');
- my $open = shift || $def->{open}; my $close = shift || $def->{close};
+ my $open = shift || $def->{open}; my $close = shift || $def->{close};
my @coords = ();
foreach my $x (@{$self->data}) {
if (Value::isValue($x)) {push(@coords,$x->string($equation))} else {push(@coords,$x)}
@@ -260,12 +269,17 @@
my $self = shift; my $equation = shift;
return $self->ijk if ($self->{ijk} || $equation->{ijk} || $$Value::context->flag("ijk"));
my $def = ($equation->{context} || $$Value::context)->lists->get('Vector');
- my $open = shift || $def->{open}; my $close = shift || $def->{close};
+ my $open = shift || $self->{open} || $def->{open};
+ my $close = shift || $self->{close} || $def->{close};
my @coords = ();
foreach my $x (@{$self->data}) {
if (Value::isValue($x)) {push(@coords,$x->TeX($equation))} else {push(@coords,$x)}
}
- return '\left'.$open.join(',',@coords).'\right'.$close;
+ return '\left'.$open.join(',',@coords).'\right'.$close unless $self->{ColumnVector};
+ $def = ($equation->{context} || $$Value::context)->lists->get('Matrix');
+ $open = shift || $self->{open} || $def->{open};
+ $close = shift || $self->{close} || $def->{close};
+ return '\left'.$open.'\begin{array}{c}'.join('\\\\',@coords).'\\\\\end{array}\right'.$close;
}
sub ijk {
|
|
From: dpvc v. a. <we...@ma...> - 2005-06-05 23:24:18
|
Log Message:
-----------
Better handling of open and close delimiters that are explicitly set.
Modified Files:
--------------
pg/lib/Value:
Matrix.pm
Point.pm
Revision Data
-------------
Index: Matrix.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Matrix.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -Llib/Value/Matrix.pm -Llib/Value/Matrix.pm -u -r1.18 -r1.19
--- lib/Value/Matrix.pm
+++ lib/Value/Matrix.pm
@@ -361,14 +361,14 @@
sub stringify {
my $self = shift;
- return $self->TeX(undef,$self->{open},$self->{close}) if $$Value::context->flag('StringifyAsTeX');
- return $self->string(undef,$self->{open},$self->{close})
+ return $self->TeX if $$Value::context->flag('StringifyAsTeX');
+ return $self->string(undef,$self->{open},$self->{close});
}
sub string {
my $self = shift; my $equation = shift;
my $def = ($equation->{context} || $$Value::context)->lists->get('Matrix');
- my $open = shift || $def->{open}; my $close = shift || $def->{close};
+ my $open = shift || $def->{open}; my $close = shift || $def->{close};
my @coords = ();
foreach my $x (@{$self->data}) {
if (Value::isValue($x)) {push(@coords,$x->string($equation,$open,$close))}
@@ -378,12 +378,13 @@
}
#
-# Use \matrix to lay out matrices
+# Use array environment to lay out matrices
#
sub TeX {
my $self = shift; my $equation = shift;
my $def = ($equation->{context} || $$Value::context)->lists->get('Matrix');
- my $open = shift || $def->{open}; my $close = shift || $def->{close};
+ my $open = shift || $self->{open} || $def->{open};
+ my $close = shift || $self->{close} || $def->{close};
$open = '\{' if $open eq '{'; $close = '\}' if $close eq '}';
my $TeX = ''; my @entries = (); my $d;
if ($self->isRow) {
Index: Point.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Point.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -Llib/Value/Point.pm -Llib/Value/Point.pm -u -r1.14 -r1.15
--- lib/Value/Point.pm
+++ lib/Value/Point.pm
@@ -176,7 +176,7 @@
sub stringify {
my $self = shift;
- return $self->TeX(undef,$self->{open},$self->{close}) if $$Value::context->flag('StringifyAsTeX');
+ return $self->TeX if $$Value::context->flag('StringifyAsTeX');
return $self->string(undef,$self->{open},$self->{close});
}
@@ -194,7 +194,8 @@
sub TeX {
my $self = shift; my $equation = shift;
my $def = ($equation->{context} || $$Value::context)->lists->get('Point');
- my $open = shift || $def->{open}; my $close = shift || $def->{close};
+ my $open = shift || $self->{open} || $def->{open};
+ my $close = shift || $self->{close} || $def->{close};
my @coords = ();
foreach my $x (@{$self->data}) {
if (Value::isValue($x)) {push(@coords,$x->TeX($equation))} else {push(@coords,$x)}
|
2 messages has been excluded from this view by a project administrator.
