[LON-CAPA-cvs] cvs: modules /jerf/tests ApacheRequest.pm
bowersj2
lon-capa-cvs@mail.lon-capa.org
Thu, 29 May 2003 20:21:39 -0000
bowersj2 Thu May 29 16:21:39 2003 EDT
Modified files:
/modules/jerf/tests ApacheRequest.pm
Log:
Handle content_type, uri, ENV, child termination.
Index: modules/jerf/tests/ApacheRequest.pm
diff -u modules/jerf/tests/ApacheRequest.pm:1.2 modules/jerf/tests/ApacheRequest.pm:1.3
--- modules/jerf/tests/ApacheRequest.pm:1.2 Fri May 23 14:10:45 2003
+++ modules/jerf/tests/ApacheRequest.pm Thu May 29 16:21:39 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
-# Navigate Maps Handler
+# Apache Request Simulator
#
-# $Id: ApacheRequest.pm,v 1.2 2003/05/23 18:10:45 bowersj2 Exp $
+# $Id: ApacheRequest.pm,v 1.3 2003/05/29 20:21:39 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -27,8 +27,6 @@
#
# (Testing Infrastructure: Apache Request Simulator
-use lib '.';
-
=pod
=head1 ApacheRequest: Fake an Apache Request object
@@ -36,13 +34,12 @@
For testing LON-CAPA it is convenient to execute the LON-CAPA code outside
of the context of an Apache server, which is difficult to make work
correctly. This object tries to match the interface of the Apache request
-object so that in combination with an %ENV setter, the LON-CAPA code thinks
-it's running inside of the web server, but we have enough control to
-test it.
+object so that the LON-CAPA code thinks it's running inside of the web server,
+but we have enough control to test it.
This will also serve as a demo/introduction for Unit Testing in Perl,
in conjunction with ApacheRequestTest.pm, demonstrating how to test.
-See ABOUT_LONCAPA_TESTING for more information.
+See About_LON-CAPA_Testing.html for more information.
This will get more functional as it is necessary.
@@ -64,6 +61,9 @@
=item * I<postcontent>: The posted content for the request, which may also
be passed as a string or a hash ref.
+=item * I<uri>: The uri of the request. This will be reflected in the ->uri()
+ value, and the ENV{'REQUEST_URI'} value.
+
=item * I<stuff>: Stuff.
=back
@@ -88,21 +88,75 @@
package ApacheRequest;
+use lib '.';
+use lib '/home/httpd/lib/perl/';
+
use Apache::Constants qw(:common :http);
+use Apache::lonnet; # For simulating $r->dir_config correctly
+use Apache;
# my constants
sub RFLUSH { return '*-*RFLUSH*-*RFLUSH*-*RFLUSH*-*'; }
sub HEADER { return '*-*HEADER*-*HEADER*-*HEADER*-*'; }
sub NOT_YET_RUN { return 'NOT_YET_RUN'; }
+# This is the default environment; the Request Object will empty out
+# the ENV inherited from the file system and then add everything from
+# here into it. This is intended to cover the NON-USER-SPECIFIC
+# values like SERVER_ROOT; user-specific stuff should use the user-
+# specific mechanisms.
+# These values may be overridden by specific arguments passed to the
+# constructor, for instance QUERY_STRING
+# There is some stuff in here specific to uhura.lite.msu.edu, but it
+# *shouldn't* matter; if it does, code it into the test cases correctly
+my %defaultENV = ( "AUTH_TYPE" => "Basic",
+ "DOCUMENT_ROOT" => "/home/httpd/html",
+ "GATEWAY_INTERFACE" => "CGI-Perl/1.1",
+ "HTTP_ACCEPT" => "text/xml,application/xml,application/xhtml+xml,tex".
+ "t/html;q=0.9,text/plain;q=0.8,video/x-mng,image/pn".
+ "g,image/jpeg,image/gif;q=0.2,*/*;q=0.1",
+ "HTTP_ACCEPT_CHARSET" => "ISO-8859-1,utf-8;q=0.7,*;q=0.7",
+ "HTTP_ACCEPT_ENCODING" => "gzip,deflate,compress;q=0.9",
+ "HTTP_ACCEPT_LANGUAGE" => "en-us,en;q=0.5",
+ "HTTP_CONNECTION" => "keep-alive",
+ "HTTP_HOST" => "generic.loncapa.org",
+ "HTTP_KEEP_ALIVE" => 300,
+ "HTTP_USER_AGENT" => "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.3) Gecko/20030519",
+ "MOD_PERL" => "mod_perl/1.27",
+ "PATH" => "/sbin:/bin:/usr/sbin:/usr/bin",
+ "QUERY_STRING" => "",
+ "REMOTE_ADDR" => "35.8.63.44",
+ "REMOTE_PORT" => 33419,
+ "REQUEST_METHOD" => "GET",
+ "REQUEST_URI" => '/',
+ "SCRIPT_FILENAME" => "/home/httpd/html/adm/test",
+ "SCRIPT_NAME" => "/home/test",
+ "SERVER_ADDR" => "35.8.63.44",
+ "SERVER_NAME" => "uhura.lite.msu.edu",
+ "SERVER_PORT" => 80,
+ "SERVER_PROTOCOL" => "HTTP/1.1",
+ "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");
+
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = shift; # the args array
if (!defined($self)) { $self = {}; }
+ # Initial ENV overriding; trash the old env
+ foreach (keys %ENV) {
+ delete $ENV{$_};
+ }
+ foreach (keys %defaultENV) {
+ $ENV{$_} = $defaultENV{$_};
+ }
+
$self->{OUTPUT} = [];
+ # set up document root to the perlvar lonDocRoot
+ $ENV{'DOCUMENT_ROOT'} = $Apache::lonnet::perlvar{'lonDocRoot'};
+
# Handle args & post, if any
for my $input ('querystring', 'postcontent') {
if (defined($self->{$input})) {
@@ -114,9 +168,21 @@
$self->{$input} = join('&', @$args);
}
} # else, just leave the string along
+
+ if ($input eq 'querystring' && defined($self->{querystring})) {
+ $ENV{QUERY_STRING} = $self->{querystring};
+ }
}
+
+ # Record uri
+ if (defined($self->{'uri'})) {
+ $ENV{'REQUEST_URI'} = $self->{'uri'};
+ }
bless $self, $class;
+
+ Apache->request($self);
+
return $self;
}
@@ -198,6 +264,63 @@
=pod
+=item * I<dir_config>($config_key): Returns the value for that config_key that was
+ set in /etc/httpd/conf/loncapa.conf.
+
+=cut
+
+sub dir_config {
+ my $self = shift;
+ my $config_key = shift;
+
+ return $Apache::lonnet::perlvar{$config_key};
+}
+
+=pod
+
+=item * I<uri>()
+
+=cut
+
+sub uri {
+ my $self = shift;
+ return $ENV{'REQUEST_URI'};
+}
+
+=pod
+
+=item * I<content_type>($content_type): If $content_type is defined, sets the
+ content-type to that, otherwise returns the $content_type. (Not sure if
+ the latter is normal behavior for the content-type method.
+
+=cut
+
+sub content_type {
+ my $self = shift;
+ my $content_type = shift;
+ if (defined($content_type)) {
+ $self->{'content-type'} = $content_type;
+ } else {
+ return $self->{'content_type'};
+ }
+}
+
+=pod
+
+=item * I<child_terminate>(): If this is called, later calls to childTerminated() will
+ return true, instead of false. Doesn't do anything else; I'd love to make it
+ so this actually stopped running the handler but it's probably not worth doing,
+ as things should generally not do anything after this call.
+
+=cut
+
+sub child_terminate {
+ my $self = shift;
+ $self->{TERMINATED} = 1;
+}
+
+=pod
+
=back
=cut
@@ -244,7 +367,7 @@
eval "use $handlerPackageName;";
$self->{return_value} = eval "${handlerPackageName}::handler(" . '$self);';
-
+ die $@ if $@;
return;
}
@@ -284,6 +407,17 @@
}
}
+=pod
+
+=item * I<childTerminated>(): Returns true if child_terminate() has been called
+ since this request was constructed, false otherwise.
+
+=cut
+
+sub childTerminated {
+ my $self = shift;
+ return defined($self->{TERMINATED}) && $self->{TERMINATED};
+}
=pod
=back