A whole batch of Http test, and a pseudo Request test module to help.

Added accessors to Session/Http.pm, and wrote tests to back them all up.
This commit is contained in:
Colin Kuskie 2006-10-30 18:09:25 +00:00
parent 0b1e077f69
commit 75f159f71b
4 changed files with 483 additions and 9 deletions

View file

@ -12,6 +12,10 @@
Templates will still need to be manually updated.
- Help: Added pluggable docs for template plugins, and added a new tab
to the Help that lists template parser docs.
- Added accessors to Session/Http.pm to make testing easier.
- Test: Added t/lib/WebGUI/PseudoRequest, which is a mostly functional
Apache::Request object replacement. It doesn't do everything, but it
does enough to test Session/Http.pm, except for cookies.
7.1.3
- fix: SQLReport now returns error if can't find DatabaseLink

View file

@ -67,6 +67,19 @@ sub DESTROY {
#-------------------------------------------------------------------
=head2 getCacheControl ( )
Returns the cache control setting from this object.
=cut
sub getCacheControl {
my $self = shift;
return $self->{_http}{cacheControl};
}
#-------------------------------------------------------------------
=head2 getCookies ( )
@ -90,6 +103,19 @@ sub getCookies {
}
#-------------------------------------------------------------------
=head2 getLastModified ( )
Returns the stored epoch date when the page as last modified.
=cut
sub getLastModified {
my $self = shift;
return $self->{_http}{lastModified};
}
#-------------------------------------------------------------------
=head2 getMimeType ( )
@ -103,6 +129,33 @@ sub getMimeType {
return $self->{_http}{mimetype} || "text/html; charset=UTF-8";
}
#-------------------------------------------------------------------
=head2 getNoHeader ( )
Returns whether or not a HTTP header will be printed.
=cut
sub getNoHeader {
my $self = shift;
return $self->{_http}{noHeader};
}
#-------------------------------------------------------------------
=head2 getRedirectLocation ( )
Return the location that was set via setRedirect
=cut
sub getRedirectLocation {
my $self = shift;
return $self->{_http}{location};
}
#-------------------------------------------------------------------
=head2 getStatus ( ) {
@ -200,15 +253,15 @@ sub sendHeader {
return undef unless $request;
my $userId = $self->session->var->get("userId");
$self->{_http}{noHeader} = 1;
$self->setNoHeader(1);
my %params;
if ($self->isRedirect()) {
$request->headers_out->set(Location => $self->{_http}{location});
$request->headers_out->set(Location => $self->getRedirectLocation);
$request->status(301);
} else {
$request->content_type($self->{_http}{mimetype} || "text/html; charset=UTF-8");
my $date = ($userId eq "1") ? $datetime->epochToHttp($self->{_http}{lastModified}) : $datetime->epochToHttp;
my $cacheControl = $self->{_http}{cacheControl};
$request->content_type($self->getMimeType || "text/html; charset=UTF-8");
my $cacheControl = $self->getCacheControl;
my $date = ($userId eq "1") ? $datetime->epochToHttp($self->getLastModified) : $datetime->epochToHttp;
$request->headers_out->set('Last-Modified' => $date);
if ($cacheControl eq "none" || $self->session->setting->get("preventProxyCache") || ($cacheControl eq "" && $userId ne "1")) {
$request->headers_out->set("Cache-Control" => "private");
@ -222,8 +275,8 @@ sub sendHeader {
my $date = $datetime->epochToHttp(time() + $cacheControl);
$request->headers_out->set('Expires' => $date);
}
if ($self->{_http}{filename}) {
$request->headers_out->set('Content-Disposition' => qq!attachment; filename="$self->{_http}{filename}"!);
if ($self->getFilename) {
$request->headers_out->set('Content-Disposition' => qq!attachment; filename="!.$self->getFilename().'"');
}
$request->status($self->getStatus());
$request->status_line($self->getStatus().' '.$self->getStatusDescription());
@ -347,10 +400,29 @@ sub setFilename {
#-------------------------------------------------------------------
=head2 getFilename ( )
Returns the default filename for the document.
=cut
sub getFilename {
my $self = shift;
return $self->{_http}{filename};
}
#-------------------------------------------------------------------
=head2 setLastModified ( epoch )
=head3 epoch
The epoch date when the page was last modified.
=cut
sub setLastModified {

View file

@ -13,11 +13,16 @@ use strict;
use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
use WebGUI::PseudoRequest;
use WebGUI::Session;
use HTML::TokeParser;
use DateTime;
use DateTime::Format::Strptime;
use Test::More; # increment this value for each test you create
use Test::Deep;
my $num_tests = 14;
my $num_tests = 60;
plan tests => $num_tests;
@ -60,6 +65,7 @@ is($http->isRedirect, '', 'isRedirect: is not');
$http->setStatus('302');
is($http->isRedirect, 1, 'isRedirect: is too');
$http->setStatus('200');
####################################################
#
@ -68,10 +74,11 @@ is($http->isRedirect, 1, 'isRedirect: is too');
####################################################
$http->setMimeType('');
is($http->getMimeType, 'text/html', 'set/get MimeType: default is text/html');
is($http->getMimeType, 'text/html; charset=UTF-8', 'set/get MimeType: default is text/html');
$http->setMimeType('image/jpeg');
is($http->getMimeType, 'image/jpeg', 'set/get MimeType: set specific type and get it');
$http->setMimeType('');
####################################################
#
@ -86,6 +93,84 @@ is($http->getStreamedFile, undef, 'set/get StreamedFile: false values return und
$http->setStreamedFile('/home/streaming');
is($http->getStreamedFile, '/home/streaming', 'set/get StreamedFile: set specific location and get it');
$http->setStreamedFile('');
####################################################
#
# setFilename, getFilename
#
####################################################
$http->setFilename('foo.bin');
is($http->getFilename, 'foo.bin', 'set/get Filename: filename passed');
is($http->getMimeType(), 'application/octet-stream', 'set/get Filename: default mime type is octet/stream');
$http->setFilename('foo.txt','text/plain');
is($http->getFilename, 'foo.txt', 'set/get Filename: filename set');
is($http->getMimeType(), 'text/plain', 'set/get Filename: mime type set');
$http->setFilename('');
$http->setMimeType('');
####################################################
#
# setLastModified, getLastModified
#
####################################################
is($http->getLastModified, undef, 'getLastModified: default is undef');
$http->setLastModified(12);
is($http->getLastModified, 12, 'set/get LastModified: epoch date set');
$http->setLastModified(undef);
####################################################
#
# setCacheControl, getCacheControl
#
####################################################
is($http->getCacheControl, undef, 'getCacheControl: default is undef');
$http->setCacheControl("none");
is($http->getCacheControl, "none", 'set/get CacheControl: set to "none"');
$http->setCacheControl(7200);
is($http->getCacheControl, 7200, 'set/get CacheControl: set to 7200');
$http->setCacheControl(undef);
####################################################
#
# setRedirect, getRedirectLocation
#
####################################################
##Let's make a "request object" :)
my $request = WebGUI::PseudoRequest->new();
$session->{_request} = $request;
$session->request->uri('/here/later');
$http->setRedirect('/here/now');
is($http->getStatus, 302, 'setRedirect: sets HTTP status');
is($http->getStatusDescription, 'Redirect', 'setRedirect: sets HTTP status description');
is($http->getRedirectLocation, '/here/now', 'setRedirect: redirect location');
$session->style->useEmptyStyle(1);
my $styled = $session->style->generateAdditionalHeadTags();
my @metas = fetchMultipleMetas($styled);
my $expectedMetas = [
{
'http-equiv' => 'refresh',
'content' => '0; URL=/here/now'
},
];
cmp_bag(\@metas, $expectedMetas, 'setRedirect:sets meta tags in the style object');
$request->uri('/here/now');
$session->url->{_requestedUrl} = '';
is($http->setRedirect('/here/now'), undef, 'setRedirect: returns undef if returning to self and no params');
$request->setup_body({ param1 => 'value1' });
isnt($http->setRedirect('/here/now'), undef, 'setRedirect: does not return undef if returning to self but there are params');
####################################################
#
@ -93,10 +178,193 @@ is($http->getStreamedFile, '/home/streaming', 'set/get StreamedFile: set specifi
#
####################################################
##Clear request object for next two tests
$session->{_request} = undef;
is($http->getNoHeader, undef, 'getNoHeader: defaults to undef');
$http->setNoHeader(1);
is($http->getNoHeader, 1, 'get/set NoHeader: returns set value');
is($http->sendHeader, undef, 'sendHeader returns undef when setNoHeader is true');
$http->setNoHeader(0);
is($http->sendHeader, undef, 'sendHeader returns undef when no request object is available');
##Add blank request object
$request = WebGUI::PseudoRequest->new;
$session->{_request} = $request;
$session->setDbNotAvailable();
$http->sendHeader;
##returns minimal header based on setup from previous test
is($request->status, 302, 'sendHeader with dbNotAvailable: status transferred to request object');
is($request->status_line, '302 '.$http->getStatusDescription, 'sendHeader with dbNotAvailable: status_line set in request object');
is($request->content_type, 'text/html; charset=UTF-8', 'sendHeader with dbNotAvailable: content_type set');
is_deeply($request->headers_out->fetch, {'Cache-Control' => 'private'}, 'sendHeader with dbNotAvailable: cache header set');
is($request->no_cache, '1', 'sendHeader with dbNotAvailable: no_cache set true');
$session->{_dbNotAvailable} = 0;
##Clear request object to run a new set of requests
$request = WebGUI::PseudoRequest->new();
$session->{_request} = $request;
$http->setRedirect('/here/there');
$http->sendHeader;
is($request->status, 301, 'sendHeader as redirect: status set to 301');
is_deeply($request->headers_out->fetch, {'Location' => '/here/there'}, 'sendHeader as redirect: location set');
##Clear request object to run a new set of requests
$request = WebGUI::PseudoRequest->new();
$session->{_request} = $request;
$http->setStatus(200, 'Just spiffy');
$http->setMimeType('');
$http->setLastModified(1200);
$http->setNoHeader(0);
$http->sendHeader();
is($request->status, 200, 'sendHeader: status set');
is($request->status_line, '200 Just spiffy', 'sendHeader: status_line set');
is($request->content_type, 'text/html; charset=UTF-8', 'sendHeader: default mimetype');
is($request->no_cache, undef, 'sendHeader: no_cache undefined');
is_deeply($request->headers_out->fetch, {'Last-Modified' => $session->datetime->epochToHttp(1200)}, 'sendHeader: normal headers');
$http->setNoHeader(0);
$http->setFilename('image.png');
$http->sendHeader();
is_deeply(
$request->headers_out->fetch,
{
'Last-Modified' => $session->datetime->epochToHttp(1200),
'Content-Disposition' => q!attachment; filename="image.png"!,
},
'sendHeader: normal headers'
);
##Clear request object to run a new set of requests
$request = WebGUI::PseudoRequest->new();
$session->{_request} = $request;
$http->setFilename('');
$http->setNoHeader(0);
$session->user({userId => 3});
$http->sendHeader();
##Replace this with DateTime math to subtract the two dates, if we can
my $delta = deltaHttpTimes($session->datetime->epochToHttp(), $request->headers_out->fetch->{'Last-Modified'});
cmp_ok($delta->seconds, '<=', 1, 'sendHeader, user=root: Last-Modified uses current time if not visitor');
is($request->no_cache, 1, 'sendHeader, user=root: no_cache set to 1 since CacheControl is blank');
##Clear request object to run a new set of requests
$request = WebGUI::PseudoRequest->new();
$session->{_request} = $request;
$http->setNoHeader(0);
$http->setCacheControl(500);
$http->sendHeader();
is($request->headers_out->fetch->{'Cache-Control'}, 'private', 'sendHeaders, cacheControl=500, user=root: header Cache-Control="private"');
$delta = deltaHttpTimes($session->datetime->epochToHttp(500 + time), $request->headers_out->fetch->{'Expires'});
cmp_ok($delta->seconds, '<=', 1, 'sendHeaders, cacheControl=500, user=root: header Expires=now+500seconds');
is($request->no_cache, undef, 'sendHeader, cacheControl=500, user=root: no_cache set to undef');
##Clear request object to run a new set of requests
$request = WebGUI::PseudoRequest->new();
$session->{_request} = $request;
$http->setNoHeader(0);
$http->setCacheControl(500);
$session->user({userId=>1});
$http->sendHeader();
##Boolean test here
ok(! exists $request->headers_out->fetch->{'Cache-Control'}, 'sendHeaders, cacheControl=500, user=visitor: header Cache-Control does not exist');
$delta = deltaHttpTimes($session->datetime->epochToHttp(500 + time), $request->headers_out->fetch->{'Expires'});
cmp_ok($delta->seconds, '<=', 1, 'sendHeaders, cacheControl=500, user=visitor: header Expires=now+500seconds');
is($request->no_cache, undef, 'sendHeader, cacheControl=500, user=visitor: no_cache set to undef');
##Clear request object to run a new set of requests
$request = WebGUI::PseudoRequest->new();
$session->{_request} = $request;
$request->protocol('HTTP 1.0');
$http->setNoHeader(0);
$http->setCacheControl(500);
$http->sendHeader();
##Boolean test here
ok(! exists $request->headers_out->fetch->{'Cache-Control'}, 'sendHeaders, cacheControl=500, user=visitor, HTTP 1.0: header Cache-Control does not exist');
$delta = deltaHttpTimes($session->datetime->epochToHttp(500 + time), $request->headers_out->fetch->{'Expires'});
cmp_ok($delta->seconds, '<=', 1, 'sendHeaders, cacheControl=500, user=visitor, HTTP 1.0: header Expires=now+500seconds');
is($request->no_cache, undef, 'sendHeaders, cacheControl=500, user=visitor, HTTP 1.0:no_cache undefined');
##Clear request object to run a new set of requests
$request = WebGUI::PseudoRequest->new();
$session->{_request} = $request;
$request->protocol('HTTP 5.5');
$http->setNoHeader(0);
$http->setCacheControl(200);
$session->user({userId => 3});
$http->sendHeader();
##Boolean test here
ok(! exists $request->headers_out->fetch->{'Expires'}, 'sendHeaders, cacheControl=200, user=root, HTTP 5.5: header Expires does not exist');
is($request->headers_out->fetch->{'Cache-Control'}, "max-age=200, private", 'sendHeaders, cacheControl=200, user=root, HTTP 5.5: header Expires does not exist');
is($request->no_cache, undef, 'sendHeaders, cacheControl=200, user=visitor, HTTP 1.0: no_cache undefined');
##Clear request object to run a new set of requests
$request = WebGUI::PseudoRequest->new();
$session->{_request} = $request;
$request->protocol('HTTP 5.5');
$http->setNoHeader(0);
$http->setCacheControl(250);
$session->user({userId => 1});
$http->sendHeader();
##Boolean test here
ok(! exists $request->headers_out->fetch->{'Expires'}, 'sendHeaders, cacheControl=250, user=visitor, HTTP 5.5: header Expires does not exist');
is($request->headers_out->fetch->{'Cache-Control'}, "max-age=250", 'sendHeaders, cacheControl=250, user=visitor, HTTP 5.5: header Expires does not exist');
is($request->no_cache, undef, 'sendHeaders, cacheControl=250, user=visitor, HTTP 5.5: no_cache undefined');
##Clear request object to run a new set of requests
$request = WebGUI::PseudoRequest->new();
$session->{_request} = $request;
$request->protocol('HTTP 5.5');
$http->setNoHeader(0);
$http->setCacheControl(250);
$session->user({userId => 1});
$http->sendHeader();
##Boolean test here
ok(! exists $request->headers_out->fetch->{'Expires'}, 'sendHeaders, cacheControl=250, user=visitor, HTTP 5.5: header Expires does not exist');
is($request->headers_out->fetch->{'Cache-Control'}, "max-age=250", 'sendHeaders, cacheControl=250, user=visitor, HTTP 5.5: header Expires does not exist');
is($request->no_cache, undef, 'sendHeaders, cacheControl=250, user=visitor, HTTP 5.5: no_cache undefined');
####################################################
#
# Utility functions
#
####################################################
sub fetchMultipleMetas {
my ($text) = @_;
my $p = HTML::TokeParser->new(\$text);
my @metas = ();
while (my $token = $p->get_tag('meta')) {
my $params = $token->[1];
delete $params->{'/'}; ##delete unary slash from XHTML output
push @metas, $params;
}
return @metas;
}
sub deltaHttpTimes {
my ($http1, $http2) = @_;
my $httpParser = DateTime::Format::Strptime->new(pattern =>'%a, %d %b %Y %H:%M:%S', time_zone => 'GMT');
my $dt1 = $httpParser->parse_datetime($http1);
my $dt2 = $httpParser->parse_datetime($http2);
my $delta_time = $dt1-$dt2;
}
END {
}

View file

@ -0,0 +1,130 @@
package WebGUI::PseudoRequest;
package WebGUI::PseudoRequest::Headers;
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = { headers => {} };
bless $self, $class;
return $self;
}
sub set {
my $self = shift;
my $key = shift;
my $value = shift;
$self->{headers}->{$key} = $value;
}
sub fetch {
my $self = shift;
return $self->{headers};
}
package WebGUI::PseudoRequest;
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $headers = WebGUI::PseudoRequest::Headers->new();
my $self = {headers_out => $headers};
bless $self, $class;
return $self;
}
sub body {
my $self = shift;
my $value = shift;
return keys %{ $self->{body} } unless defined $value;
return $self->{body}->{$value};
}
sub setup_body {
my $self = shift;
my $value = shift;
$self->{body} = $value;
}
sub content_type {
my $self = shift;
my $value = shift;
if (defined $value) {
$self->{content_type} = $value;
}
return $self->{content_type};
}
sub headers_out {
my $self = shift;
return $self->{headers_out}; ##return object for method chaining
}
sub no_cache {
my $self = shift;
my $value = shift;
if (defined $value) {
$self->{no_cache} = $value;
}
return $self->{no_cache};
}
sub param {
my $self = shift;
my $value = shift;
return keys %{ $self->{param} } unless defined $value;
return $self->{param}->{$value};
}
sub setup_param {
my $self = shift;
my $value = shift;
$self->{param} = $value;
}
sub protocol {
my $self = shift;
my $value = shift;
if (defined $value) {
$self->{protocol} = $value;
}
return $self->{protocol};
}
sub status {
my $self = shift;
my $value = shift;
if (defined $value) {
$self->{status} = $value;
}
return $self->{status};
}
sub status_line {
my $self = shift;
my $value = shift;
if (defined $value) {
$self->{status_line} = $value;
}
return $self->{status_line};
}
sub uri {
my $self = shift;
my $value = shift;
if (defined $value) {
$self->{uri} = $value;
}
return $self->{uri};
}
sub user {
my $self = shift;
my $value = shift;
if (defined $value) {
$self->{user} = $value;
}
return $self->{user};
}
1;