[LON-CAPA-cvs] cvs: modules /jerf/tests Utils.pm utils_courseTest.pm utils_userTest.pm
bowersj2
lon-capa-cvs@mail.lon-capa.org
Wed, 02 Jul 2003 20:31:31 -0000
This is a MIME encoded message
--bowersj21057177891
Content-Type: text/plain
bowersj2 Wed Jul 2 16:31:31 2003 EDT
Modified files:
/modules/jerf/tests Utils.pm utils_courseTest.pm utils_userTest.pm
Log:
Can now *correctly* create users, courses correctly retain their DC
information (for subsequent modification), users can now correctly
choose what role they want to activate, users can be deleted correctly.
Ready to start testing simple role assignment and start assembling real
courses tommorow.
--bowersj21057177891
Content-Type: text/plain
Content-Disposition: attachment; filename="bowersj2-20030702163131.txt"
Index: modules/jerf/tests/Utils.pm
diff -u modules/jerf/tests/Utils.pm:1.4 modules/jerf/tests/Utils.pm:1.5
--- modules/jerf/tests/Utils.pm:1.4 Tue Jul 1 16:20:16 2003
+++ modules/jerf/tests/Utils.pm Wed Jul 2 16:31:31 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# testing utilities
#
-# $Id: Utils.pm,v 1.4 2003/07/01 20:20:16 bowersj2 Exp $
+# $Id: Utils.pm,v 1.5 2003/07/02 20:31:31 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -50,6 +50,7 @@
use Apache::loncreateuser;
use Apache::lonauth; # for logging on
use ApacheRequest;
+use Apache::Constants;
use Data;
=pod
@@ -92,7 +93,8 @@
=head2 Creating a new user
To create a new user, use the B<create> method on the user object. The
-create method takes two arguments, a hash reference containing some
+create method takes three arguments, an ApacheRequest object corresponding
+to a logged-in Domain Coordinator, a hash reference containing some
arguments, and a list reference containing strings representing the
domain-level roles to activate.
@@ -126,39 +128,42 @@
sub create {
my $self = shift;
+ my $r = shift;
if ($self->{exists}) { return 0; }
my $params = shift;
+ if (!defined($params)) { $params = {}; }
my $desiredRoles = shift;
my $desiredhome = $Data::testHome;
- my $handlerEnv = {};
-
# We want to convince the loncreateuser.pm handler that we have a user
# here what needs creating...
- $handlerEnv->{'form.makeuser'} = $self->{exists} ? '1' : '';
- $handlerEnv->{'form.phase'} = 'update_user_data';
- $handlerEnv->{'form.hserver'} = $Data::testServer;
- $handlerEnv->{'form.ccuname'} = $self->{name};
- $handlerEnv->{'form.ccdomain'} = $self->{domain};
- $handlerEnv->{'form.login'} = 'int';
- $handlerEnv->{'form.intarg'} = $self->{password};
- $handlerEnv->{'request.role.domain'} = $self->{domain};
+ $params->{'makeuser'} = $self->{exists} ? '' : '1';
+ $params->{'phase'} = 'update_user_data';
+ $params->{'hserver'} = $Data::testServer;
+ $params->{'ccuname'} = $self->{name};
+ $params->{'ccdomain'} = $self->{domain};
+ $params->{'login'} = 'int';
+ $params->{'intarg'} = $self->{password};
for (@$desiredRoles) {
- $handlerEnv->{'form.act_' . $Data::testDomain . '_' . $_} = 'on';
+ $params->{'act_' . $Data::testDomain . '_' . $_} = 'on';
}
- for (keys %$params) {
- $handlerEnv->{'form.' . $_} = $params->{$_};
- }
my $request = ApacheRequest->new({ uri => '/adm/createuser',
- env => $handlerEnv });
+ postcontent => $params,
+ env => $r->{env},
+ headers => $r->{headers},
+ 'handler_list' => ["Apache::lonacc"]});
$request->doHandler('Apache::loncreateuser');
+ if ($request->{return_value} != Apache::Constants::OK) {
+ return 0;
+ }
+
# Check success on some rudimentary level
my $query = "encrypt:currentauth:" . $self->{domain}
. ":" .
@@ -187,31 +192,60 @@
the rest of the system.
Note that users which will be deleted should only be used in the context of
-test-only courses; I don't care to predict what would happen if a deleted user
-showed up in a real course.
+test-only courses.
For this call to work, the current (UNIX) user will need permission to delete the
directory in lonUsers, which is another reason that these tests can only be
run by root.
+=head2 Methods
+
+=over 4
+
+=item * I<delete>(): Deletes the user's directory entirely from LON-CAPA.
+
=cut
sub delete {
my $self = shift;
+ system("rm -rf " . $self->dirname());
+}
+
+
+=pod
+
+=item * I<dirname>(): Returns the absolute path to the user's directory.
+
+=cut
+
+sub dirname {
+ my $self = shift;
+
my $dirname = "/home/httpd/lonUsers/";
$dirname .= $self->{domain} . '/';
$dirname .= substr($self->{name}, 0, 1) . '/';
$dirname .= substr($self->{name}, 1, 1) . '/';
$dirname .= substr($self->{name}, 2, 1) . '/';
$dirname .= $self->{name};
-
- print "I was going to delete $dirname";
- #system("rm -rf $dirname");
+ return $dirname;
}
+=pod
+
+=item * I<login>($request): Logs the user in using the login handler. $request
+ should be an ApacheRequest object, which will have its environment and
+ headers suitably modified to be considered "logged in". Note this is
+ exactly like logging in; the user will not yet have a role.
+
+ Note the cookie will be located in $request->{headers}, so if you want to
+ use this request as a prototype to create another request (perhaps to submit
+ a form), you need to pass the new request this $request's {headers} as
+ well as {env}; see ApacheRequest documentation for more on "cloning" a
+ request.
+
+=cut
-# FIXME: Document. (Note: Takes care of the cookie)
# Must pass request object
sub login {
my $self = shift;
@@ -232,20 +266,65 @@
# FIXME: Document; selects the DC role for the user, if any
# pass $r that has the user logged in.
-sub selectRoleDC {
+#sub selectRoleDC {
+# my $self = shift;
+# my $request = shift;
+
+# my $postcontent = { "dc./" . $Data::testDomain . "/" => 'Select',
+# 'selectrole' => 1 };
+# my $r = ApacheRequest->new({postcontent => $postcontent,
+# env => $request->{env},
+# 'handler_list' => ['Apache::lonacc'],
+# headers => $request->{headers},
+# uri => "/adm/roles"});
+# $r->doHandler("Apache::lonroles");
+
+ # FIXME: Return 0 if the role does not exist.
+# return 1;
+#}
+
+=pod
+
+=item I<selectRole>($request, $roleType, $domainAndCourse, $section): Selects
+ the role for the user logged in in the $request object (see I<login>).
+ $roleType is the role code for the desired domain. $domainAndCourse is
+ a forward slash, the domain, followed by a forward slash, and if the course requires a
+ course id, followed by the course ID. (For instance, 'dc' does not.) If you
+ have a Utils::Course object, all of this is just the $course->{courseId}.
+ The optional section is the section this role is for.
+
+ $domainAndCourse will default to the domain, followed by a slash, and
+ $section will default to empty, so selecting DC or Author roles is as
+ easy as $user->selectRole($r, 'dc');
+
+=cut
+
+sub selectRole {
my $self = shift;
- my $request = shift;
+ my ($request, $roleType, $domainAndCourse, $section) = @_;
- my $postcontent = { "dc./" . $Data::testDomain . "/" => 'Select',
- 'selectrole' => 1 };
- my $r = ApacheRequest->new({postcontent => $postcontent,
+ if (!defined($domainAndCourse)) {
+ $domainAndCourse = '/' . $Data::testDomain . '/';
+ }
+
+ my $key = "$roleType.$domainAndCourse";
+ if (defined($section)) { $key .= "/$section"; }
+
+ # There doesn't seem to be a way to get whether the role selection failed
+ # from lonroles, so check to see if the user has this role
+ # (note: assuming it's still valid, technically ought to check the dates)
+ if (!($request->{env}->{'user.role.' . $key})) {
+ return 0;
+ }
+
+ my $postcontent = { $key => 'Select', 'selectrole' => 1 };
+ my $r = ApacheRequest->new({postcontent => $postcontent,
env => $request->{env},
- 'handler_list' => ['Apache::lonacc'],
- headers => $request->{headers},
- uri => "/adm/roles"});
+ 'handler_list' => ['Apache::lonacc'],
+ headers => $request->{headers},
+ uri => "/adm/roles"});
$r->doHandler("Apache::lonroles");
-
- # FIXME: Return 0 if the role does not exist.
+
return 1;
}
@@ -327,19 +406,8 @@
my $output = $r->getOutputString();
($self->{courseId}) = $output =~ m/Course ID: ([^<]+)/;
- # Prepare a Domain Coordinator login that can be used to manipulate
- # the course
-
- $self->{dc} = Utils::User->new($Data::testDomain, $Data::dcName,
- $Data::dcPassword);
- $self->{r} = ApacheRequest->new({user=>$user});
- if (!$self->{dc}->login($self->{r}) || !$self->{dc}->selectRoleDC($self->{r})) {
- # will cause later calls to blow up.
- $self->{dc} = undef;
- $self->{r} = undef;
- }
-
bless($self, $class);
+ return $self;
}
=pod
@@ -358,7 +426,7 @@
my $call = sub { return &Apache::lonnet::assignrole($self->{domain}, $userName,
$self->{courseId}, $role, time(), 0, $delete); };
- my $result = $self->{r}->execInEnv($call);
+ my $result = $self->{request}->execInEnv($call);
return $result eq 'ok';
}
@@ -380,9 +448,9 @@
(my $userName, my $role) = @_;
my $call = sub { &Apache::lonnet::assignrole($self->{domain}, $userName,
- $self->{courseId}, $role, time() - 1,
- ''); };
- my $result = $self->{r}->execInEnv($call);
+ $self->{courseId}, $role, undef,
+ time() - 1); };
+ my $result = $self->{request}->execInEnv($call);
return $result eq 'ok';
}
Index: modules/jerf/tests/utils_courseTest.pm
diff -u modules/jerf/tests/utils_courseTest.pm:1.1 modules/jerf/tests/utils_courseTest.pm:1.2
--- modules/jerf/tests/utils_courseTest.pm:1.1 Tue Jul 1 16:13:43 2003
+++ modules/jerf/tests/utils_courseTest.pm Wed Jul 2 16:31:31 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# testing the course object
#
-# $Id: utils_courseTest.pm,v 1.1 2003/07/01 20:13:43 bowersj2 Exp $
+# $Id: utils_courseTest.pm,v 1.2 2003/07/02 20:31:31 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,7 +61,7 @@
$Data::dcPassword);
my $r = ApacheRequest->new({user=>$user});
$user->login($r);
- $user->selectRoleDC($r);
+ $user->selectRole($r, 'dc');
# Now create a new course
my $course = Utils::Course->new($r, "Test Course, should never see this", '',
@@ -70,9 +70,9 @@
my $courseDir = $course->courseDirectory();
$self->assert($courseDir);
- # Fortunately, assigning the CC role to the DC and checking the
- # "Immediately expire own role as DC" does remove the DC role, so
- # we don't need to futz with that now
+ # Delete the CC role; this should be done in "test_course_adding_other_roles"
+ # in theory but we can't wait that long; this course object will be gone by then.
+ $course->revokeRole($Data::dcName, 'cc', 1);
# assert the directory exists
$self->assert(-e $courseDir);
@@ -81,6 +81,56 @@
$course->delete();
$self->assert(!defined($course));
$self->assert(!-e $courseDir);
+}
+
+sub test_course_adding_other_roles {
+ my $self = shift;
+
+ # Test creating a course, deleting it, and adding other roles like student
+ # to it.
+ print "\nTesting role addition to courses... \n";
+
+ # This login will remain the DC for controlling roles.
+ my $user = Utils::User->new($Data::testDomain, $Data::dcName,
+ $Data::dcPassword);
+ my $r = ApacheRequest->new({user=>$user});
+ $user->login($r);
+ $user->selectRole($r, 'dc');
+
+ # This login will be used to change to the user roles
+ my $targetUser = Utils::User->new($Data::testDomain, $Data::testName,
+ $Data::testPassword);
+ my $targetRequest = ApacheRequest->new({user=>$targetUser});
+ # If the user exists, wipe it out so we know the state
+ if ($targetUser->{exists}) {
+ print "Deleted " . $Data::testName . ":" . $Data::testDomain . "\n";
+ $targetUser->delete();
+ }
+ $targetUser->create();
+
+ my $course = Utils::Course->new($r, "Test Course, should never see this", '',
+ $Data::dcName);
+
+ # Add roles w/o section to the $targetUser and make sure it can log in to
+ # the role
+ # FIXME: login failure checking, please
+ for my $role (@Data::courseRoles) {
+ # Add the role to the target user
+ print "Testing adding role $role to course... ";
+ $course->addRole($Data::testName, $role);
+ $targetUser->login($targetRequest);
+ $self->assert($targetUser->selectRole($targetRequest, $role,
+ $course->{courseId}));
+ print "revoke $role... ";
+ $course->revokeRole($Data::testing, $role, 1);
+ $targetUser->login($targetRequest);
+ $self->assert(!$targetUser->selectRole($targetRequest, $role,
+ $course->{courseId}));
+ print "done.\n";
+ }
+
+ # Remove the cc role for the DC
+ $course->revokeRole($Data::dcName, 'cc', 1);
}
1;
Index: modules/jerf/tests/utils_userTest.pm
diff -u modules/jerf/tests/utils_userTest.pm:1.1 modules/jerf/tests/utils_userTest.pm:1.2
--- modules/jerf/tests/utils_userTest.pm:1.1 Tue Jun 24 15:13:27 2003
+++ modules/jerf/tests/utils_userTest.pm Wed Jul 2 16:31:31 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# testing the user object
#
-# $Id: utils_userTest.pm,v 1.1 2003/06/24 19:13:27 bowersj2 Exp $
+# $Id: utils_userTest.pm,v 1.2 2003/07/02 20:31:31 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -43,6 +43,16 @@
sub new {
my $self = shift()->SUPER::new(@_);
+
+ # Create a DC, and log them in
+ $self->{dc} = Utils::User->new($Data::testDomain, $Data::dcName,
+ $Data::dcPassword);
+ $self->{r} = ApacheRequest->new({user=>$self->{dc}});
+ $self->{dc}->login($self->{r});
+ $self->assert($self->{dc}->selectRole($self->{r}, 'dc'),
+ "Domain Coordinator information in Data.pm does not ".
+ "appear to be correct.");
+
return $self;
}
@@ -56,44 +66,52 @@
sub test_logon_works {
my $self = shift;
- my $user = Utils::User->new($Data::testDomain, $Data::testName,
- $Data::testPassword);
+ my $user = Utils::User->new($Data::testDomain, $Data::existsName,
+ $Data::existsPassword);
+ $self->assert($user->{exists}, "Could not find the 'existing user' for testing; ".
+ "either there is something wrong or you did not create an existing user. ".
+ "Please see Data.pm's comments.");
my $r = ApacheRequest->new({ env => {}});
$user->login($r);
}
sub test_detects_existance_correctly {
my $self = shift;
- my $user = Utils::User->new($Data::testDomain, $Data::testName,
- $Data::testPassword);
+ my $user = Utils::User->new($Data::existsDomain, $Data::existsName,
+ $Data::existsPassword);
$self->assert($user->{exists});
- $self->assert($user->{firstname} eq $Data::testFirstname);
- $self->assert($user->{middlename} eq $Data::testMiddlename);
- $self->assert($user->{lastname} eq $Data::testLastname);
- $self->assert($user->{generation} eq $Data::testGeneration);
+ $self->assert($user->{firstname} eq $Data::existsFirstname);
+ $self->assert($user->{middlename} eq $Data::existsMiddlename);
+ $self->assert($user->{lastname} eq $Data::existsLastname);
+ $self->assert($user->{generation} eq $Data::existsGeneration);
$user = Utils::User->new($Data::testDomain, 'fiddlefaddle', 'oiejgwg');
$self->assert(!$user->{exists});
}
-# Here's where I am: I need to make the Apache::lonnet::allowed calls
-# in loncreateuser.pm:828 happy.
-
sub test_creation_and_deletion {
my $self = shift;
- my $user = Utils::User->new($Data::testDomain, 'fiddlefaddle', 'abcdefg');
+
+ # Test that user creation and deletion work correctly.
+
+ my $user = Utils::User->new($Data::testDomain, $Data::testName, $Data::testPassword);
$self->assert(!$user->{exists});
- $self->assert($user->create({
- cfirst => 'Fiddle',
- cmiddle => 'the',
- clast => 'Faddle',
- cgen => 'the Last',
+ $self->assert($user->create($self->{r}, {
+ cfirst => $Data::testFirstName,
+ cmiddle => $Data::testMiddleName,
+ clast => $Data::testLastName,
+ cgen => $Data::testGeneration,
cstid => 'A25053262',
}));
$user->delete();
- $user = Utils::User->new($Data::testDomain, 'fiddlefaddle', 'abcdefg');
+ $user = Utils::User->new($Data::testDomain, $Data::testName, $Data::testPassword);
$self->assert(!$user->{exists});
+ $user->create($self->{r});
+ $self->assert($user->{exists});
+ $user = Utils::User->new($Data::testDomain, $Data::testName, $Data::testPassword);
+ $self->assert($user->{exists});
+ $user->delete();
}
--bowersj21057177891--