[LON-CAPA-cvs] cvs: modules /jerf/tests ApacheRequest.pm ApacheRequestTest.pm Utils.pm
bowersj2
lon-capa-cvs@mail.lon-capa.org
Mon, 30 Jun 2003 20:08:07 -0000
This is a MIME encoded message
--bowersj21057003687
Content-Type: text/plain
bowersj2 Mon Jun 30 16:08:07 2003 EDT
Modified files:
/modules/jerf/tests ApacheRequest.pm ApacheRequestTest.pm Utils.pm
Log:
Can now create courses from outside of the web server.
--bowersj21057003687
Content-Type: text/plain
Content-Disposition: attachment; filename="bowersj2-20030630160807.txt"
Index: modules/jerf/tests/ApacheRequest.pm
diff -u modules/jerf/tests/ApacheRequest.pm:1.6 modules/jerf/tests/ApacheRequest.pm:1.7
--- modules/jerf/tests/ApacheRequest.pm:1.6 Mon Jun 30 10:48:42 2003
+++ modules/jerf/tests/ApacheRequest.pm Mon Jun 30 16:08:07 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Apache Request Simulator
#
-# $Id: ApacheRequest.pm,v 1.6 2003/06/30 14:48:42 bowersj2 Exp $
+# $Id: ApacheRequest.pm,v 1.7 2003/06/30 20:08:07 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -70,6 +70,15 @@
this request. (This copies the user's environment into the request environment,
with the 'user.' prefixes applied.)
+=item * I<filename>: A string that will be returned by the filename method.
+ Since we can't guess in advance what the filename will be, you need to
+ supply it if the handler will care. (For instance, lonacc does.)
+
+=item * I<handler_list>: An array reference full of strings representing other
+ handlers that should be executed before any main handler is executed. This
+ is frequently useful for lonacc, which does stuff that other handlers depend
+ on.
+
=back
=head2 Using the ApacheRequest Object to Simulate Execution.
@@ -88,6 +97,17 @@
Then call B<$r-E<gt>doHandler('Apache::lonmodule')>;
+=head2 Tricks and Tips
+
+The state of the request objects is pretty much captured by the {env}. If
+you want to use the state of an existing request, such as one representing a
+logged in user, you can pass that request's {env} parameter to the new request.
+The new request can then submit a form or modify other request parameters, and
+will automatically update the original request's environment since it was passed
+by reference.
+
+The testing framework uses this extensively.
+
=cut
package ApacheRequest;
@@ -95,7 +115,7 @@
use lib '.';
use lib '/home/httpd/lib/perl/';
-use Apache::Constants qw(:common :http);
+use Apache::Constants qw(:common :http :methods);
use Apache::lonnet; # For simulating $r->dir_config correctly
use Apache;
@@ -142,6 +162,17 @@
"SERVER_SIGNATURE" => "<i>Apache/1.3.27 Server at uhura.lite.msu.edu Port 80</i>",
"SERVER_SOFTWARE" => "Apache/1.3.27 (Unix) (Gentoo/Linux) mod_perl/1.27");
+# Map method types to name, update as needed.
+my %methodNames = (
+ Apache::Constants::M_GET => 'GET',
+ Apache::Constants::M_POST => 'POST'
+ );
+
+my %methodNumbers = (
+ GET => Apache::Constants::M_GET,
+ POST => Apache::Constants::M_POST
+ );
+
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
@@ -156,6 +187,9 @@
# set up document root to the perlvar lonDocRoot
$ENV{'DOCUMENT_ROOT'} = $Apache::lonnet::perlvar{'lonDocRoot'};
+ # By default, this is a GET
+ $self->{method} = Apache::Constants::M_GET;
+
# Handle args & post, if any
for my $input ('querystring', 'postcontent') {
if (defined($self->{$input})) {
@@ -166,6 +200,10 @@
}
$self->{$input} = join('&', @$args);
}
+ if ($input eq 'postcontent') {
+ # If we are posting data, set type to POST
+ $self->{method} = Apache::Constants::M_POST;
+ }
} # else, just leave the string along
if ($input eq 'querystring' && defined($self->{querystring})) {
@@ -181,8 +219,13 @@
$ENV{'REQUEST_URI'} = $self->{'uri'};
}
- # Prepare headers
- $self->{headers} = {};
+ # Prepare headers, if they weren't given to us
+ if (!defined($self->{headers})) {
+ $self->{headers} = {};
+ }
+
+ # Prepare headers_in for the one call in LON-CAPA that uses it.
+ $self->{headers_in} = ApacheRequest::Headers->new();
Apache->request($self);
@@ -383,6 +426,102 @@
=pod
+=item * I<filename>(): Returns the filename given in the constructor; normally
+ supposed to return the result of the URI translation phase. Does not support
+ setting it.
+
+=cut
+
+sub filename {
+ my $self = shift;
+ return $self->{filename};
+}
+
+=pod
+
+=item * I<read>($readbuffer, $buffersize): Ignores the buffersize and inserts
+ the postcontent into the readbuffer.
+
+=cut
+
+sub read {
+ my $self = shift;
+ $_[0] = $self->{postcontent};
+}
+
+=pod
+
+=item * I<method>($method): Works only with GET and POST; to make this work
+ with more, add the desired methods to the methodNames and methodNumbers
+ hashes. Note both this and I<method> actually set the same
+ variable in the request object, unlike real Apache request objects which
+ may keep them seperate.
+
+=cut
+
+sub method {
+ my $self = shift;
+ my $setting = shift;
+
+ if (defined($setting)) {
+ $self->{method} = $methodNumbers{$setting};
+ return;
+ } else {
+ return $methodNames{$self->{method}};
+ }
+}
+
+=pod
+
+=item * I<method_number>($method_number): Works only with M_GET and M_POST; to
+ make this work with more, add the desired methods to the methodNames and
+ methodNumbers hashes. Note both this and I<method> actually set the same
+ variable in the request object, unlike real Apache request objects which
+ may keep them seperate.
+
+=cut
+
+sub method_number {
+ my $self = shift;
+ my $setting = shift;
+
+ if (defined($setting)) {
+ $self->{method} = $setting;
+ } else {
+ return $self->{method};
+ }
+}
+
+=pod
+
+=item * I<headers_in>: Returns an object that can have the "unset" method called.
+ Does nothing, except prevent the one place in LON-CAPA this is used from crashing.
+
+=cut
+
+sub headers_in {
+ my $self = shift;
+ return $self->{headers_in};
+}
+
+=pod
+
+=item * I<no_cache>(): Does nothing.
+
+=cut
+
+sub no_cache { }
+
+=pod
+
+=item * I<header_out>(): Currently does nothing.
+
+=cut
+
+sub header_out { }
+
+=pod
+
=back
=cut
@@ -418,12 +557,24 @@
=item * I<doHandler>(handlerPackageName): Executes the handler indicated by the
handlerPackageName. Does a "use $handlerPackageName" and calls the handler
- on this instance of the ApacheRequest object.
+ on this instance of the ApacheRequest object. Executes any other handlers
+ in the $r->{handler_list} first (like access handlers); right now, just
+ ignores the output from those.
=cut
sub doHandler {
my $self = shift;
+ my $handlerPackageName = shift;
+
+ for my $handler (@{$self->{handler_list}}) {
+ $self->realDoHandler($handler);
+ }
+ return $self->realDoHandler($handlerPackageName);
+}
+
+sub realDoHandler {
+ my $self = shift;
(my $handlerPackageName) = @_;
eval "use $handlerPackageName;";
@@ -570,6 +721,22 @@
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
return $str;
}
+
+1;
+
+package ApacheRequest::Headers;
+
+# Undocumented, because it doesn't matter must; only one place in the entire
+# LON-CAPA system uses this, loncommon at the end of the cgi setting stuff.
+# This will allow that to call "unset" on "headers_in" without crashing.
+
+sub new {
+ my $class = shift;
+ my $self = {};
+ bless ($self, $class);
+}
+
+sub unset { }
1;
Index: modules/jerf/tests/ApacheRequestTest.pm
diff -u modules/jerf/tests/ApacheRequestTest.pm:1.5 modules/jerf/tests/ApacheRequestTest.pm:1.6
--- modules/jerf/tests/ApacheRequestTest.pm:1.5 Tue Jun 24 15:00:46 2003
+++ modules/jerf/tests/ApacheRequestTest.pm Mon Jun 30 16:08:07 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Apache Request Simulator Tester
#
-# $Id: ApacheRequestTest.pm,v 1.5 2003/06/24 19:00:46 bowersj2 Exp $
+# $Id: ApacheRequestTest.pm,v 1.6 2003/06/30 20:08:07 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -43,7 +43,7 @@
use base qw(Test::Unit::TestCase);
use strict;
use Data::Dumper; # for debugging, not always literally used
-use Apache::Constants qw(:common); # for checking handler return values
+use Apache::Constants qw(:common :http :methods); # for checking handler return values
# Since we're testing this, we need this in here
use ApacheRequest;
@@ -244,6 +244,76 @@
$self->assert(!defined($r->{env}->{'shouldnebeseen'}));
$self->assert($r->{env}->{'todd'} eq 'steve');
}
+
+sub test_cookie_setting_via_cgi_headers {
+ my $self = shift;
+
+ # Test that outputting a Set-cookie: header with cgi_headers works.
+ my $r = ApacheRequest->new();
+ $self->assert(!defined($r->header_in('CoOkIe')));
+ $r->send_cgi_header(<<HEADERS);
+Garbage: Sneeze
+Set-cookie: test-cookie
+Attack-Of-The-Killer-Clowns: X-Smooch.
+HEADERS
+
+ $self->assert($r->header_in('CoOkIe') eq 'test-cookie');
+}
+
+sub test_filename_works {
+ my $self = shift;
+
+ # Test that the filename works
+ my $r = ApacheRequest->new();
+ $self->assert($r->filename() eq '');
+ my $f = 'testfilename';
+ $r = ApacheRequest->new({filename => $f});
+ $self->assert($r->filename() eq $f);
+}
+
+sub test_read_works {
+ my $self = shift;
+
+ # Test that the read works, at least to our specifications
+ my $r = ApacheRequest->new();
+ my $buffer = 'garbage';
+ $r->read($buffer, $r->header_in("Content-length"));
+ $self->assert($buffer eq '');
+}
+
+sub test_method_works {
+ my $self = shift;
+
+ # Test that the method stuff works; by default, it's a GET,
+ # unless we sent postcontent in which case it's POST
+ my $r = ApacheRequest->new();
+ $self->assert($r->method eq 'GET');
+ $self->assert($r->method_number == M_GET);
+ $r = ApacheRequest->new({postcontent => "a=b"});
+ $self->assert($r->method eq 'POST');
+ $self->assert($r->method_number == M_POST);
+ $r->method("GET");
+ $self->assert($r->method eq 'GET');
+ $self->assert($r->method_number == M_GET);
+ $r->method_number(M_POST);
+ $self->assert($r->method eq 'POST');
+ $self->assert($r->method_number == M_POST);
+ $r->method_number(M_GET);
+ $self->assert($r->method eq 'GET');
+ $self->assert($r->method_number == M_GET);
+ $r->method("POST");
+ $self->assert($r->method eq 'POST');
+ $self->assert($r->method_number == M_POST);
+}
+
+sub test_headers_in {
+ my $self = shift;
+
+ # Test that we can call headers_in->unset without crashing.
+ my $r = ApacheRequest->new();
+ $r->headers_in->unset("Bleh.");
+}
+
1;
package SimpleTestHandler;
Index: modules/jerf/tests/Utils.pm
diff -u modules/jerf/tests/Utils.pm:1.2 modules/jerf/tests/Utils.pm:1.3
--- modules/jerf/tests/Utils.pm:1.2 Mon Jun 30 10:48:42 2003
+++ modules/jerf/tests/Utils.pm Mon Jun 30 16:08:07 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# testing utilities
#
-# $Id: Utils.pm,v 1.2 2003/06/30 14:48:42 bowersj2 Exp $
+# $Id: Utils.pm,v 1.3 2003/06/30 20:08:07 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -65,6 +65,7 @@
sub new {
my $class = shift;
+ $self = {};
$self->{domain} = shift;
$self->{name} = shift;
$self->{password} = shift;
@@ -226,6 +227,22 @@
$r->doHandler("Apache::lonacc");
}
+# FIXME: Document; selects the DC role for the user, if any
+# pass $r that has the user logged in.
+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");
+}
+
1;
package Utils::Course;
@@ -251,12 +268,54 @@
=over 4
-=item * I<new>(
+=item * I<new>($r, $courseTitle, $courseMap, $courseCoordinator): $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.
=back
=cut
+use Data;
+use ApacheRequest;
+sub new {
+ my $class = shift;
+ my $self = {};
+
+ $self->{request} = shift;
+ $self->{title} = shift;
+ $self->{courseMap} = shift;
+ if (!defined($self->{courseMap})) { $self->{courseMap} = ''; }
+ $self->{courseCoordinator} = shift;
+
+ my $postcontent = {};
+
+ # Set up the request to the course creation handler
+ $postcontent->{title} = $self->{title};
+ $postcontent->{course_home} = $Data::testServer;
+ $postcontent->{crsid} = ''; # course id, leave blank
+ $postcontent->{firstres} = 'syl';
+ $postcontent->{openall} = '1';
+ $postcontent->{setpolicy} = '1';
+ $postcontent->{setcontent} = '1';
+ $postcontent->{ccuname} = $self->{courseCoordinator};
+ $postcontent->{ccdomain} = $Data::testDomain;
+ $postcontent->{expireown} = '1';
+ $postcontent->{submit} = 'Open Course';
+ $postcontent->{phase} = 'two';
+
+ # Create a request object to handle the course creation.
+ my $r = ApacheRequest->new({env => $self->{request}->{env},
+ postcontent => $postcontent,
+ filename => '/home/httpd/html/adm/createcourse',
+ 'handler_list' => ["Apache::lonacc"],
+ headers => $self->{request}->{headers}});
+ $r->doHandler("Apache::loncreatecourse");
+
+ bless($self, $class);
+}
1;
--bowersj21057003687--