[LON-CAPA-cvs] cvs: modules /jerf/tests ApacheRequest.pm ApacheRequestTest.pm
bowersj2
lon-capa-cvs@mail.lon-capa.org
Tue, 24 Jun 2003 19:00:46 -0000
bowersj2 Tue Jun 24 15:00:46 2003 EDT
Modified files:
/modules/jerf/tests ApacheRequestTest.pm ApacheRequest.pm
Log:
* Add support for "send_cgi_header" to the Apache Request fake object.
* Rework how the Apache Request object deals with the environment, to
better support "logging in" concept. Correct tests to work with new
environment handling. (This will allow seperate Request objects to
be instantiated without stomping on each other's environments.)
Index: modules/jerf/tests/ApacheRequestTest.pm
diff -u modules/jerf/tests/ApacheRequestTest.pm:1.4 modules/jerf/tests/ApacheRequestTest.pm:1.5
--- modules/jerf/tests/ApacheRequestTest.pm:1.4 Fri May 30 16:07:52 2003
+++ modules/jerf/tests/ApacheRequestTest.pm Tue Jun 24 15:00:46 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Apache Request Simulator Tester
#
-# $Id: ApacheRequestTest.pm,v 1.4 2003/05/30 20:07:52 bowersj2 Exp $
+# $Id: ApacheRequestTest.pm,v 1.5 2003/06/24 19:00:46 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -126,7 +126,7 @@
my $params = { querystring => $querystring };
my $r = ApacheRequest->new($params);
$self->assert($r->args() eq 'a=b&c=d');
- $self->assert($ENV{QUERY_STRING} eq 'a=b&c=d');
+ $self->assert($r->{env}->{QUERY_STRING} eq 'a=b&c=d');
}
sub test_argument_hash_handling {
@@ -135,8 +135,8 @@
my $params = { querystring => $querystring };
my $r = ApacheRequest->new($params);
$self->assert($r->args() eq 'a=b&c=d' || $r->args() eq 'c=d&a=b');
- $self->assert($ENV{QUERY_STRING} eq 'a=b&c=d' ||
- $ENV{QUERY_STRING} eq 'c=d&a=b');
+ $self->assert($r->{env}->{QUERY_STRING} eq 'a=b&c=d' ||
+ $r->{env}->{QUERY_STRING} eq 'c=d&a=b');
# Check that arguments are escaped correctly
$r = ApacheRequest->new({querystring => { 'a&.' => ":,,"}});
@@ -218,9 +218,9 @@
my $self = shift;
my $r = ApacheRequest->new();
- $self->assert(defined($ENV{'QUERY_STRING'}));
+ $self->assert(defined($r->{env}->{'QUERY_STRING'}));
# A popular ENV variable from the shell, but not in the server
- $self->assert(!defined($ENV{'USER'}));
+ $self->assert(!defined($r->{env}->{'USER'}));
}
sub test_document_root_correct {
@@ -230,7 +230,7 @@
# of the setting.
my $self = shift;
my $r = ApacheRequest->new();
- $self->assert($ENV{'DOCUMENT_ROOT'} eq $Apache::lonnet::perlvar{'lonDocRoot'});
+ $self->assert($r->{env}->{'DOCUMENT_ROOT'} eq $Apache::lonnet::perlvar{'lonDocRoot'});
}
sub test_env_handled_right {
@@ -241,8 +241,8 @@
my $r = ApacheRequest->new({ env => { 'todd' => 'no',
'shouldntbeseen' => 'fe'}});
$r->doHandler("SimpleHandlerEnvChanger");
- $self->assert(!defined($ENV{'shouldnebeseen'}));
- $self->assert($ENV{'todd'} eq 'steve');
+ $self->assert(!defined($r->{env}->{'shouldnebeseen'}));
+ $self->assert($r->{env}->{'todd'} eq 'steve');
}
1;
Index: modules/jerf/tests/ApacheRequest.pm
diff -u modules/jerf/tests/ApacheRequest.pm:1.4 modules/jerf/tests/ApacheRequest.pm:1.5
--- modules/jerf/tests/ApacheRequest.pm:1.4 Fri May 30 16:07:52 2003
+++ modules/jerf/tests/ApacheRequest.pm Tue Jun 24 15:00:46 2003
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Apache Request Simulator
#
-# $Id: ApacheRequest.pm,v 1.4 2003/05/30 20:07:52 bowersj2 Exp $
+# $Id: ApacheRequest.pm,v 1.5 2003/06/24 19:00:46 bowersj2 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -64,7 +64,7 @@
=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.
+=item * I<env>: A hash containing a "temporary environment" for the request.
=back
@@ -143,17 +143,12 @@
my $class = ref($proto) || $proto;
my $self = shift; # the args array
if (!defined($self)) { $self = {}; }
-
- # Initial ENV overriding; totally trash the old env
- foreach (keys %ENV) {
- delete $ENV{$_};
- }
- foreach (keys %defaultENV) {
- $ENV{$_} = $defaultENV{$_};
- }
+ bless $self, $class;
$self->{OUTPUT} = [];
+ $self->loadEnv();
+
# set up document root to the perlvar lonDocRoot
$ENV{'DOCUMENT_ROOT'} = $Apache::lonnet::perlvar{'lonDocRoot'};
@@ -179,10 +174,10 @@
$ENV{'REQUEST_URI'} = $self->{'uri'};
}
- bless $self, $class;
-
Apache->request($self);
+ $self->unloadEnv();
+
return $self;
}
@@ -321,6 +316,27 @@
=pod
+=item * I<header_only>(): When this is called, returns the {header_only} member
+ of the request, which defaults to false.
+
+=cut
+
+sub header_only {
+ my $self = shift;
+ return $shift->{header_only};
+}
+
+=pod
+
+=item * I<send_cgi_header>(): Currently just discards arguments.
+
+=cut
+
+sub send_cgi_header {
+}
+
+=pod
+
=back
=cut
@@ -366,27 +382,32 @@
eval "use $handlerPackageName;";
- # Replace/augment the %ENV if necessary
- # We remember old values and put them back at the end of this call,
- # UNLESS the handler did something to change the %ENV, in which case
- # we preserve the changes
- my $oldenvvalues = {};
- if ($self->{env}) {
- for (keys %{$self->{env}}) {
- $oldenvvalues->{$_} = $ENV{$_};
- $ENV{$_} = $self->{env}->{$_};
- }
- }
+ $self->loadEnv();
$self->{return_value} = eval "${handlerPackageName}::handler(" . '$self);';
+ $self->unloadEnv();
# Replace the ENV
- for (keys (%{$self->{env}})) {
- if ($self->{env}->{$_} eq $ENV{$_}) {
- $ENV{$_} = $oldenvvalues->{$_};
- }
- }
die $@ if $@;
return;
+}
+
+sub loadEnv {
+ my $self = shift;
+ my %envcopy = %ENV;
+ $self->{oldenv} = \%envcopy;
+
+
+ %ENV = %defaultENV;
+ for (keys %{$self->{env}}) {
+ $ENV{$_} = $self->{env}->{$_};
+ }
+}
+
+sub unloadEnv {
+ my $self = shift;
+ my %envcopy = %ENV;
+ $self->{env} = \%envcopy;
+ %ENV = %{$self->{oldenv}};
}
=pod