[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--