[LON-CAPA-cvs] cvs: modules /jerf/tests Utils.pm lonnavmapsTest.pm utils_authorTest.pm utils_courseTest.pm utils_userTest.pm
bowersj2
lon-capa-cvs@mail.lon-capa.org
Mon, 28 Jul 2003 19:53:43 -0000
This is a MIME encoded message
--bowersj21059422023
Content-Type: text/plain
bowersj2 Mon Jul 28 15:53:43 2003 EDT
Modified files:
/modules/jerf/tests Utils.pm lonnavmapsTest.pm utils_authorTest.pm
utils_courseTest.pm utils_userTest.pm
Log:
Modifications to testing routines to make it easier to write useful
tests.
--bowersj21059422023
Content-Type: text/plain
Content-Disposition: attachment; filename="bowersj2-20030728155343.txt"
Index: modules/jerf/tests/Utils.pm
diff -u modules/jerf/tests/Utils.pm:1.13 modules/jerf/tests/Utils.pm:1.14
--- modules/jerf/tests/Utils.pm:1.13 Mon Jul 28 12:07:20 2003
+++ modules/jerf/tests/Utils.pm Mon Jul 28 15:53:43 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# testing utilities
#
-# $Id: Utils.pm,v 1.13 2003/07/28 16:07:20 bowersj2 Exp $
+# $Id: Utils.pm,v 1.14 2003/07/28 19:53:43 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -241,31 +241,6 @@
=cut
-package Utils;
-
-=head1 Utility Functions
-
-Setting up tests requires much the same steps, over and over. These
-functions help with setting up tests easily.
-
-=over 4
-
-=item * B<setupCourse>($topLevelMap): Sets up a course using the test
- resources in the test resource directory. $topLevelMap identifies
- a map in the test resource directory to use as the top-level map
- by filename ("all.problems.sequence").
-
-=cut
-
-
-=pod
-
-=back
-
-=cut
-
-1;
-
package Utils::User;
use lib '.';
@@ -296,6 +271,19 @@
$self->{name} = shift;
$self->{password} = shift;
+ # undocumented: To prevent the DC or the Author from being
+ # silently logged in somewhere else, we prevent them from being
+ # accidentally created.
+ my $overrideProtection = shift;
+
+ if (!$overrideProtection &&
+ ($self->{name} eq $Data::dcName ||
+ $self->{name} eq $Data::authorName)) {
+ die "Can't use Util::User->new to create domain "
+ ."coordinator or author objects. (Tried to create "
+ ."$self->{name}.)";
+ }
+
# Does this user already exist? If so, grab existing data
my $query = "encrypt:currentauth:" . $self->{domain}
. ":" .
@@ -353,7 +341,8 @@
sub create {
my $self = shift;
- my $r = shift;
+
+ my $r = $Utils::dcR;
if ($self->{exists}) { return 0; }
@@ -483,7 +472,7 @@
sub login {
my $self = shift;
my $r = shift;
-
+
# We automatically successfully login without dealing with the password
my $code = sub { Apache::lonauth::success($r, $self->{name}, $self->{domain},
$Data::testServer, ''); };
@@ -524,13 +513,6 @@
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},
@@ -624,6 +606,9 @@
system('rm -rf ' . $self->getResourceSpaceDir() . 'test/');
mkdir $self->getResourceSpaceDir() . 'test/';
+ # Have to re-login to clear some stuff out
+ $self->login($r);
+
return 1;
}
@@ -774,17 +759,21 @@
=head Constructing a New Course
-To construct a new course, call Utils::Course->new as follows:
+Utils::Course->new() is essentially a wrapper around
+loncreatecourse. Generally, you'll want to call setupCourse to get a
+completely new course. But if you just want to create a course without
+setting it up, call B<new> like this:
=over 4
-=item * I<new>($r, $courseTitle, $courseMap, $courseCoordinator, $paramHash): $r should
- be a request after a domain coordinator has logged in. $courseTitle should be
- the title of the course. $courseMap is the url of the top-level map (optional).
- $courseCoordinator is the account of the course coordinator. The domain
- and home server will be pulled from the current test
- environment. $paramHash can be used to override the form elements
- directly.
+=item * I<new>($r, $courseTitle, $courseMap, $courseCoordinator,
+ $paramHash): $r should be a request after a domain coordinator has
+ logged in. $courseTitle should be the title of the
+ course. $courseMap is the url of the top-level map (optional), as
+ a URL. $courseCoordinator is the account of the course
+ coordinator. The domain and home server will be pulled from the
+ current test environment. $paramHash can be used to override the
+ form elements directly.
=back
@@ -845,6 +834,67 @@
=pod
+To create a course useful for testing purposes, created from scratch,
+use B<setupCourse>. B<setupCourse> will initialize the author, publish
+all the files in the course (which are assumed to reside in the
+B<data> directory; external resources can not be used here), and
+create the new course with the appropriate top-level map. Call
+B<setupCourse> as follows:
+
+=over 4
+
+=item * B<setupCourse>($topLevelMap): The topLevelMap parameter is a
+filename in the data directory, like "all.problems.sequence".
+
+=back
+
+=cut
+
+# INCOMPLETE
+sub setupCourse {
+ my $class = shift;
+ my $topLevelMap = shift;
+ if (!$topLevelMap) { return (); }
+
+ print "Creating a course...\n";
+
+ # load in the file and publish the necessary resources
+ open SEQUENCE, '<', "data/$topLevelMap" or die "Can't find "
+ . "$topLevelMap in Utils::setupCourse";
+
+ my $sequence = join '', <SEQUENCE>;
+ my @filesToPublish = ();
+
+ # extract the filenames out of the sequence file
+ while ($sequence =~ /src=['"][^'"]+\/([^"']+)["']/g) {
+ push @filesToPublish, $1;
+ }
+
+ print "Publishing:";
+ $Utils::author->initializeResourceSpace($Utils::authorR);
+ for (@filesToPublish) {
+ print " $_";
+ $Utils::author->copyResource($_);
+ $Utils::author->publishResource($Utils::authorR, $_);
+ }
+ print "$topLevelMap\n";
+ $Utils::author->copyResource($topLevelMap);
+ $Utils::author->publishResource($Utils::authorR, $topLevelMap);
+
+ my $course = new($class, $Utils::dcR, 'Test course, delete on sight',
+ "/res/$Data::testDomain/" .
+ "$Data::authorName/test/$topLevelMap",
+ $Data::dcName,
+ { firstres => 'blank' });
+
+ die "Can't create course in Utils::setupCourse for unknown "
+ . "reasons." if !$course->{courseId};
+
+ return $course;
+}
+
+=pod
+
=item * I<revokeRole>(userName, roleType, delete): Revokes the given role
in the course, where user is the login name of the user who
owns the role you wish to revoke, and roleType is the two-letter
@@ -940,5 +990,99 @@
}
$_[0] = undef;
}
+
+1;
+
+package Utils;
+
+use ApacheRequest;
+use Data;
+
+=head1 Utility Functions
+
+Setting up tests requires much the same steps, over and over. These
+functions help with setting up tests easily. It also holds the DC and
+author login user and ApacheRequest objects. Since each user can only
+have one login active at a time, this prevents conflicts in trying to
+create and use them.
+
+=head2 Objects in Utils
+
+=over 4
+
+=item * B<$Utils::dc>: A Utils::User object for the domain
+ coordinator given in the Data.pm file.
+
+=item * B<$Utils::dcR): An ApacheRequest where the dc has logged in
+ and selected the "dc" role.
+
+=item * B<$Utils::author>: A Utils::User object for the author
+ given in the Data.pm file.
+
+=item * B<$Utils::authorR>: An ApacheRequest where the author
+ has logged in and selected the 'au' role.
+
+=back
+
+=cut
+
+our $dc = Utils::User->new($Data::testDomain, $Data::dcName, undef, 1);
+die "DC doesn't seem to exist.\n" if !$dc->{exists};
+our $dcR = ApacheRequest->new({user=>$dc});
+$dc->login($dcR);
+$dc->selectRole($dcR, 'dc');
+
+our $author = Utils::User->new($Data::testDomain, $Data::authorName,
+ undef, 1);
+die "Author doesn't seem to exist.\n" if !$author->{exists};
+our $authorR = ApacheRequest->new({user=>$author});
+$author->login($authorR);
+$author->selectRole($authorR, 'au');
+
+=pod
+
+=head2 Functions
+
+=over 4
+
+=item * B<getTestUser>($fresh): A convenience function for the common
+ case where you want to get the Test User and have him logged in.
+ $fresh controls whether the user is first deleted; if true, the
+ user is deleted and recreated. Default is true. Returns a list
+ containing the Utils::User object for the user, and an
+ ApacheRequest object with the user logged in.
+
+=cut
+
+sub getTestUser {
+ my ($fresh) = @_;
+
+ my $user = Utils::User->new($Data::testDomain, $Data::testName,
+ $Data::testPassword);
+ if ($fresh || !defined($fresh)) {
+ $user->delete();
+ $user->create($dcR);
+ }
+ my $r = ApacheRequest->new({user => $user});
+ $user->login($r);
+
+ return ($user, $r);
+}
+
+=pod
+
+=item * B<setupCourse>($topLevelMap): Sets up a course using the test
+ resources in the test resource directory. $topLevelMap identifies
+ a map in the test resource directory to use as the top-level map
+ by filename ("all.problems.sequence"). Returns
+
+=cut
+
+
+=pod
+
+=back
+
+=cut
1;
Index: modules/jerf/tests/lonnavmapsTest.pm
diff -u modules/jerf/tests/lonnavmapsTest.pm:1.1 modules/jerf/tests/lonnavmapsTest.pm:1.2
--- modules/jerf/tests/lonnavmapsTest.pm:1.1 Thu Jul 17 16:34:19 2003
+++ modules/jerf/tests/lonnavmapsTest.pm Mon Jul 28 15:53:43 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# navmaps testing code
#
-# $Id: lonnavmapsTest.pm,v 1.1 2003/07/17 20:34:19 bowersj2 Exp $
+# $Id: lonnavmapsTest.pm,v 1.2 2003/07/28 19:53:43 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -65,51 +65,15 @@
print "Doing basic navmaps test...\n";
- # First, publish the resources and the map
- my $author = Utils::User->new($Data::testDomain,
- $Data::authorName);
- my $request = ApacheRequest->new({user=>$author});
- $author->login($request);
- $author->selectRole($request, 'au');
-
- print "Publishing:";
- $author->initializeResourceSpace($request);
- for (@Data::problems) {
- print " $_";
- $author->copyResource($_);
- $author->publishResource($request, $_);
- }
- print " all.problems.sequence\n";
- $author->copyResource('all.problems.sequence');
- $author->publishResource($request, 'all.problems.sequence');
-
- # Now we've got the resources, create the course
- my $dc = Utils::User->new($Data::testDomain, $Data::dcName);
- $self->assert($dc->{exists}, "Can't test navmaps because the " .
- "domain coordinator needs to be set up.");
- my $dcR = ApacheRequest->new({user=>$author});
- $dc->login($dcR);
- $dc->selectRole($dcR, 'dc');
-
- # Create a course, using old-style top-level map and no
- # syllabus to start with
- my $course = Utils::Course->new($dcR, 'Navmap test course, delete on sight',
- "/res/$Data::testDomain/" .
- "$Data::authorName/test/all.problems.sequence",
- $Data::dcName,
- { firstres => 'blank' });
+ my $course = Utils::Course->setupCourse('all.problems.sequence');
# Make sure the course was created correctly before we get too far
$self->assert($course->{courseId});
# Create our guinea pig
- my $tester = Utils::User->new($Data::testDomain, $Data::testName, $Data::testPassword);
- $tester->delete();
- $tester->create($dcR);
- my $testerR = ApacheRequest->new({user => $tester});
+ my ($tester, $testerR) = Utils::getTestUser();
- # We've now created a course, given it the map we want, and
- # created a user for it. Now we need to walk through the roles,
+ # Now we need to walk through the roles,
# log the test user in, and confirm that the navmaps walks through
# the course map correctly in this simple case.
print "\nTesting basic navmap functionality...\n";
Index: modules/jerf/tests/utils_authorTest.pm
diff -u modules/jerf/tests/utils_authorTest.pm:1.3 modules/jerf/tests/utils_authorTest.pm:1.4
--- modules/jerf/tests/utils_authorTest.pm:1.3 Thu Jul 10 15:36:25 2003
+++ modules/jerf/tests/utils_authorTest.pm Mon Jul 28 15:53:43 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# testing the course and user objects w.r.t. authoring
#
-# $Id: utils_authorTest.pm,v 1.3 2003/07/10 19:36:25 bowersj2 Exp $
+# $Id: utils_authorTest.pm,v 1.4 2003/07/28 19:53:43 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -56,11 +56,10 @@
my $self = shift;
- my $nonAuthor = Utils::User->new($Data::testDomain, $Data::testName);
- $nonAuthor->create();
- $self->assert(!$nonAuthor->initializeResourceSpace());
+ my ($nonAuthor, $r) = Utils::getTestUser();
+ $self->assert(!$nonAuthor->initializeResourceSpace($r));
- my $author = Utils::User->new($Data::testDomain, $Data::authorName);
+ my $author = $Utils::author;
$self->assert($author->{exists}, "Account $author->{name} does not exist. ".
"This account needs to exist and have authoring privileges for ".
"domain $Data::testDomain for these tests to work.");
@@ -68,7 +67,7 @@
# $author is supposed to already exist
$self->assert(-e $author->getResourceSpaceDir(),
"$author does not seem to have a resource space set up.");
- $self->assert($author->initializeResourceSpace(),
+ $self->assert($author->initializeResourceSpace($Data::authorR),
"Failed to initialize resource space for $author->{name}");
my $resourceSpace = $author->getResourceSpaceDir() . 'test/';
$self->assert(-e $resourceSpace);
@@ -83,13 +82,9 @@
# This tests that publication of a simple HTML resource from the data
# directory, and a simple problem
- # Create the author and log in, choosing the author role
- my $user = Utils::User->new($Data::testDomain, $Data::authorName);
- my $r = ApacheRequest->new({user=>'user'});
- $user->login($r);
- $self->assert($user->selectRole($r, 'au'));
-
- $user->initializeResourceSpace();
+ my $user = $Utils::author;
+ my $r = $Utils::authorR;
+ $user->initializeResourceSpace($r);
my $testResource = $Data::HTMLResources[0];
$user->copyResource($testResource);
@@ -108,12 +103,9 @@
# and Data::multipartProblems.
# Create the author and log in, choosing the author role
- my $user = Utils::User->new($Data::testDomain, $Data::authorName);
- my $r = ApacheRequest->new({user=>'user'});
- $user->login($r);
- $self->assert($user->selectRole($r, 'au'));
-
- $user->initializeResourceSpace();
+ my $user = $Utils::author;
+ my $r = $Utils::authorR;
+ $user->initializeResourceSpace($r);
while ((my $type, my $source) = each %Data::typesToProblems) {
$user->copyResource($source);
Index: modules/jerf/tests/utils_courseTest.pm
diff -u modules/jerf/tests/utils_courseTest.pm:1.4 modules/jerf/tests/utils_courseTest.pm:1.5
--- modules/jerf/tests/utils_courseTest.pm:1.4 Mon Jul 7 11:41:34 2003
+++ modules/jerf/tests/utils_courseTest.pm Mon Jul 28 15:53:43 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# testing the course object
#
-# $Id: utils_courseTest.pm,v 1.4 2003/07/07 15:41:34 bowersj2 Exp $
+# $Id: utils_courseTest.pm,v 1.5 2003/07/28 19:53:43 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -55,13 +55,8 @@
sub test_basic_creation_and_deletion {
my $self = shift;
- # Test *basic* creation and deletion
- # Log a user in create the course
- my $user = Utils::User->new($Data::testDomain, $Data::dcName,
- $Data::dcPassword);
- my $r = ApacheRequest->new({user=>$user});
- $user->login($r);
- $user->selectRole($r, 'dc');
+ my $user = $Utils::dc;
+ my $r = $Utils::dcR;
# Now create a new course
my $course = Utils::Course->new($r, "Test Course, should never see this", '',
@@ -90,24 +85,11 @@
# 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');
+ my $user = $Utils::dc;
+ my $r = $Utils::dcR;
# 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();
- }
- $self->assert($targetUser->create($r));
-
+ my ($targetUser, $targetRequest) = Utils::getTestUser();
my $course = Utils::Course->new($r, "Test Course, should never see this", '',
$Data::dcName);
Index: modules/jerf/tests/utils_userTest.pm
diff -u modules/jerf/tests/utils_userTest.pm:1.3 modules/jerf/tests/utils_userTest.pm:1.4
--- modules/jerf/tests/utils_userTest.pm:1.3 Tue Jul 8 14:15:15 2003
+++ modules/jerf/tests/utils_userTest.pm Mon Jul 28 15:53:43 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# testing the user object
#
-# $Id: utils_userTest.pm,v 1.3 2003/07/08 18:15:15 bowersj2 Exp $
+# $Id: utils_userTest.pm,v 1.4 2003/07/28 19:53:43 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -43,16 +43,6 @@
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;
}
@@ -64,6 +54,14 @@
my $self = shift;
}
+sub test_DC_and_Author_Exist {
+ my $self = shift;
+ $self->assert($Utils::dc->{exists}, "Domain Coordinator doesn't "
+ . "exist.");
+ $self->assert($Utils::author->{exists}, "Domain Coordinator doesn't "
+ . "exist.");
+}
+
sub test_logon_works {
my $self = shift;
my $user = Utils::User->new($Data::testDomain, $Data::existsName,
@@ -98,12 +96,20 @@
$user->delete();
$user = Utils::User->new($Data::testDomain, $Data::testName, $Data::testPassword);
$self->assert(!$user->{exists});
- $user->create($self->{r});
+ $user->create();
$self->assert($user->{exists});
$user = Utils::User->new($Data::testDomain, $Data::testName, $Data::testPassword);
$self->assert($user->{exists});
$user->delete();
}
+sub test_test_user_retrieval {
+ my $self = shift;
+
+ my ($user, $r) = Utils::getTestUser();
+ $self->assert($user->{exists});
+ ($user, $r) = Utils::getTestUser(0);
+ $self->assert($user->{exists});
+}
1;
--bowersj21059422023--