[LON-CAPA-cvs] cvs: modules /jerf/tests Utils.pm utils_userTest.pm

[bowersj2]

This is a MIME encoded message

--bowersj21056482008
Content-Type: text/plain

bowersj2		Tue Jun 24 15:13:28 2003 EDT

  Added files:                 
    /modules/jerf/tests	Utils.pm utils_userTest.pm 
  Log:
  Code for manipulating users, and testing those manipulations.
  
  
--bowersj21056482008
Content-Type: text/plain
Content-Disposition: attachment; filename="bowersj2-20030624151328.txt"


Index: modules/jerf/tests/Utils.pm
+++ modules/jerf/tests/Utils.pm
# The LearningOnline Network with CAPA
# testing utilities
#
# $Id: Utils.pm,v 1.1 2003/06/24 19:13:27 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# (Testing: testing utilities

=pod

=head1 Testing Utilities for LON-CAPA

Certain functionality is necessary for correctly testing LON-CAPA with 
minimal dependence. These functions and object provide assistance with
programmatically creating users and courses, logging in, etc, and other 
such good stuff that's necessary to test the actual handlers in the course.

=cut

package Utils;

1;

package Utils::User;

use lib '.';
use lib '/home/httpd/lib/perl/';
use Apache::lonnet;
use Apache::loncreateuser;
use Apache::lonauth; # for logging on
use ApacheRequest;
use Data;

=pod

=head1 Utils::User - Utilities for manipulating users

A Util::User object represents a user account. It allows for creation, deletion,
logging in, and representing the user when getting roles added to it.

=cut

use Data::Dumper;
sub new {
    my $class = shift;

    $self->{domain} = shift;
    $self->{name} = shift;
    $self->{password} = shift;

    # Does this user already exist? If so, grab existing data
    my $query = "encrypt:currentauth:" . $self->{domain}
					 . ":" .
					     $self->{name};
    my $authtype = Apache::lonnet::reply($query, $Data::testServer);
    if ($authtype eq 'internal:') {
	$self->{exists} = 1;
	my %env = Apache::lonnet::dump('environment', $self->{domain},
				       $self->{name});
	for (keys (%env)) {
	    $self->{$_} = $env{$_};
	}
    } elsif ($authtype eq 'unknown_user') {
	$self->{exists} = 0;
    }

    bless ($self, $class);
}

=pod

=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
arguments, and a list reference containing strings representing the
domain-level roles to activate.

Note I've not yet checked what happens if you leave some of these
parameters blank; it might be worth hacking on this to use the old
parameters by default if no new ones are given.

Domain, username, and password are picked up from the original parameters given to
the user object.

The hash ref may contain the following parameters:

=over 4

=item * B<cfirst>: The first name

=item * B<cmiddle>: The middle name

=item * B<clast>: The last name

=item * B<cgen>: The generation

=item * B<cstid>: The student id (as in "A24......" at MSU)

=back

The list reference of domain-level roles to specify may contain the following: 
B<li> for librarian, B<dg> for domain guest, and B<au> for author.

=cut

sub create {
    my $self = shift;

    if ($self->{exists}) { return 0; }

    my $params = shift;
    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};

    for (@$desiredRoles) {
	$handlerEnv->{'form.act_' . $Data::testDomain . '_' . $_} = 'on';
    }

    for (keys %$params) {
	$handlerEnv->{'form.' . $_} = $params->{$_};
    }
    
    my $request = ApacheRequest->new({ uri => '/adm/createuser',
				       env => $handlerEnv });
    $request->doHandler('Apache::loncreateuser');

    # Check success on some rudimentary level
    my $query = "encrypt:currentauth:" . $self->{domain}
					 . ":" .
					     $self->{name};
    my $authtype = Apache::lonnet::reply($query, $Data::testServer);
    if ($authtype eq 'internal:') {
	return 1;
    } else {
	return 0;
    }
}

=pod

=head2 Deleting the user

LON-CAPA does not allow deletion of users from within the system. For testing
purposes, it is convenient to be able to control the entire environment, which
means that we really need to be able to wipe a user's slate clean every time.
Thus, you can delete a user with $user->delete(), which will actually delete
the user's info from lonUsers.

Note if the user was an author or internally authenticated their UNIX-system
level stuff is not touched; only the lonUsers directory is deleted. This is
best done with non-UNIX authenticated users, since they have no presence in
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.

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.

=cut

sub delete {
    my $self = shift;
    
    my $dirname = "/home/httpd/lonTabs/";
    $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 $dirname;
    #system("rm -rf $dirname");
}


# FIXME: Document
# Must pass request object
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, ''); };
    $r->execInEnv($code);
}

1;

Index: modules/jerf/tests/utils_userTest.pm
+++ modules/jerf/tests/utils_userTest.pm
# The LearningOnline Network with CAPA
# testing the user object
#
# $Id: utils_userTest.pm,v 1.1 2003/06/24 19:13:27 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# (Testing: testing the user object

use lib '.';
use lib '/home/httpd/lib/perl/';

package utils_userTest;

use base qw(Test::Unit::TestCase);
use strict;
use Data::Dumper;
use Apache::Constants qw(:common);
use ApacheRequest;

use Utils;
use Data;

sub new {
    my $self = shift()->SUPER::new(@_);
    return $self;
}

sub set_up {
    my $self = shift;
}

sub tear_down {
    my $self = shift;
}

sub test_logon_works {
    my $self = shift;
    my $user = Utils::User->new($Data::testDomain, $Data::testName, 
				$Data::testPassword);
    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);
    $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);

    $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');
    $self->assert(!$user->{exists});
    $self->assert($user->create({ 
	cfirst => 'Fiddle',
	cmiddle => 'the',
	clast => 'Faddle',
	cgen => 'the Last',
	cstid => 'A25053262',
    }));

    $user->delete();
    $user = Utils::User->new($Data::testDomain, 'fiddlefaddle', 'abcdefg');
    $self->assert(!$user->{exists});
}


1;

--bowersj21056482008--