[LON-CAPA-cvs] cvs: modules /jerf/tests ApacheRequest.pm README Utils.pm lonhelpTest.pm /jerf/tests/Apache File.pm
bowersj2
lon-capa-cvs@mail.lon-capa.org
Mon, 30 Jun 2003 14:48:42 -0000
This is a MIME encoded message
--bowersj21056984522
Content-Type: text/plain
bowersj2 Mon Jun 30 10:48:42 2003 EDT
Modified files:
/modules/jerf/tests ApacheRequest.pm README Utils.pm lonhelpTest.pm
/modules/jerf/tests/Apache File.pm
Log:
Looks like I've got the login working; I should be able to create a
course now.
--bowersj21056984522
Content-Type: text/plain
Content-Disposition: attachment; filename="bowersj2-20030630104842.txt"
Index: modules/jerf/tests/ApacheRequest.pm
diff -u modules/jerf/tests/ApacheRequest.pm:1.5 modules/jerf/tests/ApacheRequest.pm:1.6
--- modules/jerf/tests/ApacheRequest.pm:1.5 Tue Jun 24 15:00:46 2003
+++ modules/jerf/tests/ApacheRequest.pm Mon Jun 30 10:48:42 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Apache Request Simulator
#
-# $Id: ApacheRequest.pm,v 1.5 2003/06/24 19:00:46 bowersj2 Exp $
+# $Id: ApacheRequest.pm,v 1.6 2003/06/30 14:48:42 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -66,6 +66,10 @@
=item * I<env>: A hash containing a "temporary environment" for the request.
+=item * I<user>: A Utils::User object representing the user which is executing
+ this request. (This copies the user's environment into the request environment,
+ with the 'user.' prefixes applied.)
+
=back
=head2 Using the ApacheRequest Object to Simulate Execution.
@@ -145,7 +149,7 @@
if (!defined($self)) { $self = {}; }
bless $self, $class;
- $self->{OUTPUT} = [];
+ $self->resetRequest();
$self->loadEnv();
@@ -169,11 +173,17 @@
}
}
+ # Copy user's environment in, if any.
+ $self->updateUserEnvironment();
+
# Record uri
if (defined($self->{'uri'})) {
$ENV{'REQUEST_URI'} = $self->{'uri'};
}
+ # Prepare headers
+ $self->{headers} = {};
+
Apache->request($self);
$self->unloadEnv();
@@ -328,11 +338,47 @@
=pod
-=item * I<send_cgi_header>(): Currently just discards arguments.
+=item * I<send_cgi_header>(): Currently, only looks for Set-cookie: $cookie, and
+ sets the Cookie header.
=cut
sub send_cgi_header {
+ my $self = shift;
+ my $cgi = shift;
+
+ for (split m/\n/, $cgi) {
+ if ($_ =~ /Set-cookie: (.*)/) {
+ $self->header_in('Cookie', $1);
+ }
+ }
+}
+
+=pod
+
+=item * I<header_in>($header, $newval): Fully matches the behavior of the
+ header_in method of real requests, so can be used to populate headers.
+ Headers are not cleared out between requests if the object is used for
+ multiple requests, which is useful for the login cookie.
+
+=cut
+
+sub header_in {
+ my $self = shift;
+ if (scalar(@_) == 1) { # one argument, retreieve header value
+ my $header = lc shift;
+ return $self->{headers}->{$header};
+ }
+
+ # Two arguments: Set header value, case insensitive.
+ my $header = lc shift;
+ my $value = shift;
+
+ if (!defined($value)) {
+ delete $self->{headers}->{$header};
+ } else {
+ $self->{headers}->{$header} = $value;
+ }
}
=pod
@@ -391,6 +437,7 @@
return;
}
+# Private methods: Load and unload the environment.
sub loadEnv {
my $self = shift;
my %envcopy = %ENV;
@@ -410,6 +457,17 @@
%ENV = %{$self->{oldenv}};
}
+# Private method: Update the user's environment, if changed.
+# Assumes environment is loaded.
+sub updateUserEnvironment {
+ my $self = shift;
+ if (defined($self->{'user'})) {
+ for (keys %{$self->{'user'}->{env}}) {
+ $ENV{'user.' . $_} = $self->{'user'}->{env}->{$_};
+ }
+ }
+}
+
=pod
=item * I<getOutputString>(): Returns a string representing all of the displayed output
@@ -457,6 +515,39 @@
my $self = shift;
return defined($self->{TERMINATED}) && $self->{TERMINATED};
}
+
+=pod
+
+=item * I<resetRequest>(): Resets the request's output back to nothing, so the
+ request can be re-used on a later handler, preserving the environment.
+
+=cut
+
+sub resetRequest {
+ my $self = shift;
+ $self->{OUTPUT} = [];
+}
+
+=pod
+
+=item * I<execInEnv>(code): Executes the code in the request's environment and
+ saves the changes the code makes in the environment to the request. Useful
+ for things like logging in, where we bypass the handler but we really need
+ the request's environment fiddled with. Returns the (scalar) result of the
+ code called.
+
+=cut
+
+sub execInEnv {
+ my $self = shift;
+ my $code = shift;
+
+ $self->loadEnv();
+ my $result = &$code();
+ $self->unloadEnv();
+ return $result;
+}
+
=pod
=back
Index: modules/jerf/tests/README
diff -u modules/jerf/tests/README:1.1 modules/jerf/tests/README:1.2
--- modules/jerf/tests/README:1.1 Mon May 19 09:56:54 2003
+++ modules/jerf/tests/README Mon Jun 30 10:48:42 2003
@@ -1 +1,9 @@
-This is a place for the testing work I want to do to live.
+Note that all of these tests assume they are being run such that the
+working directory is this directory. They all do a "use lib '.';"
+frequently. So if you're trying to do these automatically, make
+sure you cd into this directory first.
+
+These tests must also be run as root or www, as they expect to be testing the
+.pm files contained in /home/httpd. Theoretically this could change but
+it's just not worth it, since even before the testing framework you
+still had to copy your code into /home/httpd/lib/perl/Apache.
Index: modules/jerf/tests/Utils.pm
diff -u modules/jerf/tests/Utils.pm:1.1 modules/jerf/tests/Utils.pm:1.2
--- modules/jerf/tests/Utils.pm:1.1 Tue Jun 24 15:13:27 2003
+++ modules/jerf/tests/Utils.pm Mon Jun 30 10:48:42 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# testing utilities
#
-# $Id: Utils.pm,v 1.1 2003/06/24 19:13:27 bowersj2 Exp $
+# $Id: Utils.pm,v 1.2 2003/06/30 14:48:42 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -78,9 +78,7 @@
$self->{exists} = 1;
my %env = Apache::lonnet::dump('environment', $self->{domain},
$self->{name});
- for (keys (%env)) {
- $self->{$_} = $env{$_};
- }
+ $self->{env} = \%env;
} elsif ($authtype eq 'unknown_user') {
$self->{exists} = 0;
}
@@ -207,12 +205,12 @@
$dirname .= substr($self->{name}, 2, 1) . '/';
$dirname .= $self->{name};
- print $dirname;
+ print "I was going to delete $dirname";
#system("rm -rf $dirname");
}
-# FIXME: Document
+# FIXME: Document. (Note: Takes care of the cookie)
# Must pass request object
sub login {
my $self = shift;
@@ -222,6 +220,43 @@
my $code = sub { Apache::lonauth::success($r, $self->{name}, $self->{domain},
$Data::testServer, ''); };
$r->execInEnv($code);
+
+ # Now we run lonacc to get the environment set up
+ $r->resetRequest();
+ $r->doHandler("Apache::lonacc");
}
+
+1;
+
+package Utils::Course;
+
+=pod
+
+=head1 Utils::Course - Utilities for manipulating courses
+
+A Util::Course object represents a course. It allows for creation, deletetion,
+assignment of roles w.r.t. the course, and standing in for the course for the
+rest of this infrastructure.
+
+Unlike users where you can specify a username & password and at least have
+a stub of a user object from which you can login, create, etc., it doesn't make
+any sense to do that with a course, since the ID is a random, unpredictable
+value. Thus, there are two constructors for course objects, the one that
+constructs a new course, and the one that attaches to an existing course
+via the course id.
+
+=head Constructing a New Course
+
+To construct a new course, call Utils::Course->new as follows:
+
+=over 4
+
+=item * I<new>(
+
+=back
+
+=cut
+
+
1;
Index: modules/jerf/tests/lonhelpTest.pm
diff -u modules/jerf/tests/lonhelpTest.pm:1.2 modules/jerf/tests/lonhelpTest.pm:1.3
--- modules/jerf/tests/lonhelpTest.pm:1.2 Thu May 29 16:23:54 2003
+++ modules/jerf/tests/lonhelpTest.pm Mon Jun 30 10:48:42 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# lonhelp Handler Tester
#
-# $Id: lonhelpTest.pm,v 1.2 2003/05/29 20:23:54 bowersj2 Exp $
+# $Id: lonhelpTest.pm,v 1.3 2003/06/30 14:48:42 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -168,29 +168,27 @@
$self->assert($errorMessage eq '', $errorMessage);
}
-# For unknown reasons, this test frequently blows up tth, but works on the web.
-# It's not worth tracking down, IMHO.
+# For unknown reasons, this test frequently blows up tth
+sub test_handler_renders_help_files {
+ my $self = shift;
-#sub test_handler_renders_help_files {
-# my $self = shift;
-#
-# # Run the handler on each file and validate that the handler renders it
-# # without errors
-# my $docRoot = $Apache::lonnet::perlvar{'lonDocRoot'};
-# my $helpRoot = $docRoot . '/adm/help/tex/';
-# for my $file (glob($helpRoot . "*.tex")) {
-# # Swap out the .tex for a .hlp extension
-# $file =~ s/tex$/hlp/;
-# # Grab just the filename
-# $file = substr($file, rindex($file, '/') + 1);
-# my $r = ApacheRequest->new({'uri' => "/adm/help/$file"});
-# $r->doHandler('Apache::lonhelp');
-# $self->assert($r->getReturnValue() == OK);
-# my $html = $r->getOutputString();
-# $self->assert(valid_html_code($html));
-# $self->assert(!$r->childTerminated(), "lontexconvert.pm died on $file");
-# }
-#}
+ # Run the handler on each file and validate that the handler renders it
+ # without errors
+ my $docRoot = $Apache::lonnet::perlvar{'lonDocRoot'};
+ my $helpRoot = $docRoot . '/adm/help/tex/';
+ for my $file (glob($helpRoot . "*.tex")) {
+ # Swap out the .tex for a .hlp extension
+ $file =~ s/tex$/hlp/;
+ # Grab just the filename
+ $file = substr($file, rindex($file, '/') + 1);
+ my $r = ApacheRequest->new({'uri' => "/adm/help/$file"});
+ $r->doHandler('Apache::lonhelp');
+ $self->assert($r->getReturnValue() == OK);
+ my $html = $r->getOutputString();
+ $self->assert(valid_html_code($html));
+ $self->assert(!$r->childTerminated(), "lontexconvert.pm died on $file");
+ }
+}
sub test_handler_correct_returns_not_found {
my $self = shift;
Index: modules/jerf/tests/Apache/File.pm
diff -u modules/jerf/tests/Apache/File.pm:1.1 modules/jerf/tests/Apache/File.pm:1.2
--- modules/jerf/tests/Apache/File.pm:1.1 Fri May 23 13:45:01 2003
+++ modules/jerf/tests/Apache/File.pm Mon Jun 30 10:48:42 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Navigate Maps Handler
#
-# $Id: File.pm,v 1.1 2003/05/23 17:45:01 bowersj2 Exp $
+# $Id: File.pm,v 1.2 2003/06/30 14:48:42 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -38,5 +38,21 @@
use IO::File;
@ISA=("IO::File");
+
+sub new {
+ my $class = shift;
+ return IO::File->new(@_);
+}
+
+#sub new {
+# my $class = shift;
+# $class = 'IO::File';
+
+# if (@_ == 1 && $_[0] !~ /^[><+|]/) {
+# push @_, 'r+';
+# }
+# my $self = $class->new(@_);
+# return $self;
+#}
1;
--bowersj21056984522--